W
wh445306
Unregistered / Unconfirmed
GUEST, unregistred user!
多线程局域网扫描组件源码如下，，速度和效率确实不错。使用方法：保存为PAS文件然后安装,然后就可以使用，问题是：打开调用这个组件的应用程序只可以扫描一次，第二次再扫描就会提示数据没有发送完毕。必须重新打开程序才能再次扫描。百思不得其解。。完整代码如下:请高手支招：非常感谢!{********************************************************************} { LanScan: } { Author: dmzn dmzn@163.com 2005.5 } { Description: 多线程的局域网扫描组件 } {********************************************************************} unit LanScan; interface uses Windows, Messages, SysUtils, Forms, Classes, WinSock; const NBTPort = 137; //设定对端UDP端口号 UDPPort = 8327; //设定本端UDP端口号 WM_SOCK = WM_USER + $0001; //自定义windows消息 Over_IP = 'Over'; //组件退出时的标志 NbtstatPacket: array[0..49]of Byte =($0,$0,$0,$0,$0,$1,$0,$0,$0,$0, $0,$0,$20,$43,$4b,$41,$41,$41,$41, $41,$41,$41,$41,$41,$41,$41,$41,$41,$41, $41,$41,$41,$41,$41,$41,$41,$41,$41,$41, $41,$41,$41,$41,$41,$41,$0,$0,$21,$0,$1); type TNbt = class; TSendThread = class(TThread) private { Private declarations } FNbt : TNbt; FIP : string; //当前探测的IP地址 FEvent : THandle; //延迟事件句柄 protected { protected declarations } procedure SendData; //发送数据 procedure NilThread; //设置线程结束标识 procedure Execute; override; procedure SetEvents(const nIP: string); //取消延迟 public { public declarations } ID : integer; //线程实例标识 constructor Create(AOwner: TNbt); end; TOnBegin = procedure (const nIPNumber: integer) of object; TOnEnd = procedure (const nTotalScan: integer) of object; TOnProcess = procedure (const nHasDone: integer) of object; TOnStatus = procedure (const nMsg: string) of object; //扫描状态 TOnReceive = procedure (const nIP, nHostName, nUserName, nGroupName, nMacAddr: string) of object; TNBT = class(TComponent) private { Private declarations } FBusy : boolean; //正在扫描 FEndIP, //结束IP FBeginIP : string; //开始IP FTimeOut : integer; //超时间隔 FIPList : TStrings; //开始到结束 FLock : TRTLCriticalSection; //临界区变量 FData : array [0..49] of byte; //NbtstatPacket FHasDone : integer; //已扫描个数 FOnStatus : TOnStatus; //扫描状态 FOnReceive: TOnReceive; //数据解析 FOnBegin : TOnBegin; //扫描开始 FOnEnd : TOnEnd; //扫描结束 FOnProcess: TOnProcess; //扫描过程 FHandle : HWnd; //消息处理使用 FSock : TSocket; //套节字 FAddr : TSockAddr; FSockAddrIn : TSockAddrIn; FThreadNum : integer; //线程个数 FThreads : array of TSendThread; //扫描线程 protected { protected declarations } function GetIPList: boolean; procedure EnterCS; //进入临界区 procedure LeaveCS; //离开临界区 procedure SendData(const nIP:string); //发送数据 procedure ReadData(var nMessage: TMessage); //消息处理 procedure SetEvents(const nIP: string); //取消延迟 procedure SetThreadNum(const nNum: integer); procedure RecvNbMsg(nBuf: array of byte; nLen: integer; const nIP: string); public { public declarations } constructor Create(AOwner: TComponent); override; //创建 destructor Destroy; override; //销毁 procedure StartScan; //开始扫描 procedure StopScan; //停止扫描 procedure FreeThreads; //释放线程 procedure NilThread(const nID: integer); //设置线程结束标识 published { published declarations } property EndIP : string read FEndIP write FEndIP; property BeginIP : string read FBeginIP write FBeginIP; property TimeOut : integer read FTimeOut write FTimeOut; property ThreadNum: integer read FThreadNum write SetThreadNum; property OnStatus: TOnStatus read FOnStatus write FOnStatus; property OnReceive: TOnReceive read FOnReceive write FOnReceive; property OnEnd : TOnEnd read FOnEnd write FOnEnd; property OnBegin : TOnBegin read FOnBegin write FOnBegin; property OnProcess: TOnProcess read FOnProcess write FOnProcess; end; procedure Register; implementation procedure Register; begin RegisterComponents('MyUse', [TNBT]); end; //Name: IsLegalIP //Param: nIP,待测试IP //Return: 若nIP合法返回真 function IsLegalIP(const nIP: string): boolean; begin if inet_addr(pchar(nIP))=INADDR_NONE then Result := false else Result := True; end; {************************ TSendThread ************************} constructor TSendThread.Create(AOwner: TNbt); begin inherited Create(True); FNbt := AOwner; FreeOnTerminate := True; FEvent := CreateEvent(nil, True, False, nil); end; procedure TSendThread.SendData; begin FNbt.SendData(FIP); end; procedure TSendThread.NilThread; begin FNbt.NilThread(ID); end; procedure TSendThread.SetEvents(const nIP: string); begin if (nIP=FIP) or (nIP=Over_IP) then SetEvent(FEvent); end; procedure TSendThread.Execute; begin while not Terminated do begin FIP := ''; FNbt.EnterCS; if FNbt.FIPList.Count = 0 then begin FNbt.LeaveCS; Break; end; FIP := FNbt.FIPList[0]; FNbt.FIPList.Delete(0); FNbt.LeaveCS; Synchronize(SendData); WaitForSingleObject(FEvent, FNbt.FTimeOut); ResetEvent(FEvent); end; CloseHandle(FEvent); Synchronize(NilThread); end; {************************* TNBT ***************************} constructor TNBT.Create(AOwner: TComponent); begin inherited Create(AOwner); FTimeOut := 100; FBusy := False; FEndIP := '127.0.0.1'; FBeginIP := '127.0.0.1'; FThreadNum:= 3;end; destructor TNBT.Destroy; begin StopScan; inherited Destroy; end; procedure TNBT.EnterCS; begin EnterCriticalSection(FLock); end; procedure TNBT.LeaveCS; begin LeaveCriticalSection(FLock); end; procedure TNBT.SetThreadNum(const nNum: integer); begin if (nNum > 50) or (nNum < 1) then raise Exception.Create('线程个数最好在1-50之间'); FThreadNum := nNum; end; procedure TNBT.NilThread(const nID: integer); var i: integer; begin for i:= Low(FThreads) to High(FThreads) do if Assigned(FThreads) and (FThreads.ID = nID) then begin FThreads := nil; Break; end; for i:= Low(FThreads) to High(FThreads) do if Assigned(FThreads) then Exit; StopScan; end; procedure TNBT.FreeThreads; var i: integer; begin for i:= Low(FThreads) to High(FThreads) do begin if not Assigned(FThreads) then Continue; FThreads.Terminate; FThreads.SetEvents(Over_IP); end; SetLength(FThreads,0); end; procedure TNBT.StartScan; var i : integer; nWSAData: TWSAData; begin if FBusy then exit; FHasDone := 0; FIPList := TStringList.Create; if not GetIPList then begin FIPList.Free; Exit; end; FHandle := AllocateHWnd(ReadData); InitializeCriticalSection(FLock); if WSAStartup($101, nWSAData)=1 then Exception.Create('WinSock初始化失败'); FSock := Socket(AF_INET, SOCK_DGRAM, 0); if (FSock = INVALID_SOCKET) then begin CloseSocket(FSock); Exception.Create('Socket创建失败'); end; FAddr.sin_family := AF_INET; FAddr.sin_addr.S_addr := INADDR_ANY; FAddr.sin_port := htons(UDPPORT); if Bind(FSock, FAddr, sizeof(FAddr)) <> 0 then begin CloseSocket(FSock); Exception.Create('WinSock绑定失败'); end; WSAAsyncSelect(FSock, FHandle, WM_SOCK, FD_READ); FillChar(FSockAddrIn, SizeOf(FSockAddrIn), #0); FSockAddrIn.SIn_Family := AF_INET; FSockAddrIn.SIn_Port := htons(NBTPORT); for i:=0 to 49 do FData := NbtstatPacket; SetLength(FThreads, FThreadNum); for i:=Low(FThreads) to High(FThreads) do begin FThreads := TSendThread.Create(self); FThreads.ID := i; Fthreads.Resume; end; FBusy := True; if Assigned(FOnBegin) then FOnBegin(FIPList.Count); end; procedure TNBT.StopScan; begin if FBusy then begin FreeThreads; FIPList.Free; WSACleanup(); DeallocateHWnd(FHandle); DeleteCriticalSection(FLock); FBusy := False; end; if not (csDestroying in ComponentState) and Assigned(FOnEnd) then FOnEnd(FHasDone); end; function TNBT.GetIPList: boolean; var i: integer; nIP: string; nIP1,nIP2: dWord; begin Result := False; if not (IsLegalIP(FEndIP) and IsLegalIP(FBeginIP)) then exit; nIP1 := ntohl(inet_addr(pchar(FBeginIP))); nIP2 := ntohl(inet_addr(pchar(FEndIP))); for i := nIP1 to nIP2 do begin //去掉x.x.x.0或x.x.x.255的地址。 if (((i - 255) mod 256)=0)or((i mod 256)=0) then continue; nIP := inet_ntoa(in_addr(htonl(i))); FIPList.Add(nIP); end; Result := True; end; procedure TNBT.ReadData(var nMessage: TMessage); var nIP:string; nEvent: word; nLen1,nLen2: integer; nBuf: array [1..500] of byte; begin if nMessage.msg <> WM_SOCK then exit; nLen1 := SizeOf(FSockAddrIn); nEvent := WSAGetSelectEvent(nMessage.LParam); if nEvent = FD_READ then begin nLen2 := recvfrom(FSock, nBuf, sizeof(nBuf), 0, FSockAddrIn, nLen1); if nLen2 > 0 then begin with FSockAddrIn.sin_addr.S_un_b do nIP:=format('%d.%d.%d.%d',[ord(s_b1),ord(s_b2),ord(s_b3),ord(s_b4)]); RecvNbMsg(nBuf, nLen2, nIP); end; SetEvents(nIP); end; end; procedure TNBT.RecvNbMsg(nBuf: array of byte; nLen: integer; const nIP: string); var i,j,nPos,nCount: integer; sStr, nHostName, nUserName, nGroupName, nMacAddr: string; begin nCount := 0; for i:=1 to nlen do begin if((nBuf=$21) and (nBuf[i+1]=$00) and (nBuf[i+2]=$01)) then begin nCount := nBuf[i+9]; break; end; end; if nCount = 0 then exit; sStr := ''; nPos := i + 10; for i := nPos to (nPos + 18*nCount - 1) do begin if (((i - nPos) mod 18) =0) then begin for j:=0 to 14 do begin if Trim(Char(nBuf[i+j])) = '' then nBuf[i+j] := Ord(' '); sStr := sStr + Char(nBuf[i+j]); end; if (nBuf[i+16] and $80)=$80 then begin if nBuf[i+15]=$0 then nGroupName := Trim(sStr); end else begin if nBuf[i+15]=$3 then nUserName := Trim(sStr) else if nBuf[i+15]=$20 then nHostName := Trim(sStr); end; sStr :=''; end; end; for i:=0 to 5 do sStr := sStr + Format('%.2x.',[nBuf[i+nPos+18*nCount]]); Delete(sStr, Length(sStr), 1); nMacAddr := Trim(sStr); if Assigned(FOnReceive) then FOnReceive(nIP,nHostName,nUserName,nGroupName,nMacAddr); end; procedure TNBT.SendData(const nIP: string); var nLen : integer; begin FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(nIP)); nLen := SendTo(FSock, FData[0],50, 0, FSockAddrIn, sizeof(FSockAddrIn)); if Assigned(FOnStatus) then begin if nLen <> 50 then FOnStatus('数据没有发送完毕') else if nLen = SOCKET_ERROR then FOnStatus('WinSock错误,发送失败') else FOnStatus('正在扫描,主机: ' + nIP); end; Inc(FHasDone); if Assigned(FOnProcess) then FOnProcess(FHasDone); end; procedure TNBT.SetEvents(const nIP: string); var i: integer; begin for i:=Low(FThreads) to High(FThreads) do if Assigned(FThreads) then FThreads.SetEvents(nIP); end; end.