我想用线程搜索 局域 网内的计算机信息 (计算机名称,IP,工作组)存入数据库。在线程中我定义了 三个函数 (getserverlist //获取网内的工作组, getusers //获取工作组下的计算机名称 , nametoip //获取计算机IP)。
线程类代码如下:
unit Unit2;interfaceuses
Classes, windows , sysutils , WINSOCK ,ADODB;type
TNetResourceArray = ^TNetResource; //网络资源类型的数组
Tsearch = class(TThread)
GroupList , ComputerList :TstringList;
// dataset : Tadodataset;
private { Private declarations }
protected
//constructor create (tempdataset : Tadodataset);//createsuspended : boolean ;
procedure Execute; override;
procedure terminate;
Function GetServerList( var List : TStringList ) : Boolean;
Function GetUsers(GroupName:string;var List:TStringList):Boolean;
Function NameToIP (name:string):string;
end;implementation
uses unit1;procedure Tsearch.Execute;
var i , j ,NameLength : integer;
Name : string;
begin
{ Place thread code here }
GroupList := Tstringlist.Create;
computerList := TstringList.Create;// 如果搜索到工作组 则循环 搜索各个工作组下的计算机 if GetServerList( GroupList ) then
begin
for i := 0 to grouplist.Count - 1 do // 工作组循环
begin // 如果工作组GroupList.Strings[i] 内有计算机 则循环 搜索各个计算机的IP if GetUsers( GroupList.Strings[i] , computerList ) then //计算机则循环
begin
for j := 0 to computerlist.Count - 1 do
begin
NameLength := length(computerList.Strings[j]);
Name := copy( computerList.Strings[j] , 3 ,namelength );// 将搜索到的计算机信息存入 数据库 dataset.Append;
DataSet.FieldByName('PC_name').Value := name;// 用 函数 NameToIP 得到计算机IP
DataSet.FieldByName('IP').Value := NameToIP(Name);
DataSet.FieldByName('PC_group').Value := grouplist.Strings[i]; end;
end ;
end ;
end ;
end;procedure Tsearch.terminate;
begin
GroupList.free;
computerList.Free;
end ;// 搜索网内工作组
Function Tsearch.GetServerList( var List : TStringList ) : Boolean;
Var
NetResource : TNetResource;
Buf : Pointer;
Count,BufSize,Res : DWORD;
lphEnum : THandle;
p:TNetResourceArray;
i,j : SmallInt;
NetworkTypeList : TList;
Begin
Result := False;
NetworkTypeList := TList.Create;
List.Clear;
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
//获取整个网络中的文件资源的句柄,lphEnum为返回名柄
If Res <> NO_ERROR Then exit;
//执行失败,退出
//执行成功,开始获取整个网络中的网络类型信息
Count := $FFFFFFFF;
//不限资源数目
BufSize := 8192;
//缓冲区大小设置为8K
GetMem(Buf, BufSize);
//申请内存,用于获取工作组信息
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If ( Res = ERROR_NO_MORE_ITEMS )
//资源列举完毕
or (Res <> NO_ERROR )
//执行失败
Then Exit;
P := TNetResourceArray(Buf);
For I := 0 To Count - 1 Do
//记录各个网络类型的信息
Begin
NetworkTypeList.Add(p);
Inc(P);
End;
//WNetCloseEnum关闭一个列举句柄
Res:= WNetCloseEnum(lphEnum);
//关闭一次列举
If Res <> NO_ERROR Then exit;
For J := 0 To NetworkTypeList.Count-1 Do
//列出各个网络类型中的所有工作组名称
Begin
//列出一个网络类型中的所有工作组名称
NetResource := TNetResource(NetworkTypeList.Items[J]^);
//网络类型信息
//获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> NO_ERROR Then break;
//执行失败
While true Do
//列举一个网络类型的所有工作组的信息
Begin
Count := $FFFFFFFF;
//不限资源数目
BufSize := 8192;
//缓冲区大小设置为8K
GetMem(Buf, BufSize);
//申请内存,用于获取工作组信息,获取一个网络类型的文件资源信息,
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If ( Res = ERROR_NO_MORE_ITEMS )
//资源列举完毕
or (Res <> NO_ERROR)
//执行失败
then break;
P := TNetResourceArray(Buf);
For I := 0 To Count - 1 Do
//列举各个工作组的信息
Begin
List.Add( StrPAS( P^.lpRemoteName ));
//取得一个工作组的名称
Inc(P);
End;
End;
Res := WNetCloseEnum(lphEnum);
//关闭一次列举
If Res <> NO_ERROR Then break;
//执行失败
End;
Result := True;
FreeMem(Buf);
NetworkTypeList.Destroy;
End;
// 搜索工作组内的计算机
Function Tsearch.GetUsers(GroupName:string;var List:TStringList):Boolean;
Var
NetResource:TNetResource;
Buf : Pointer;
Count,BufSize,Res : DWord;
Ind : Integer;
lphEnum : THandle;
Temp:TNetResourceArray;
Begin
Result := False;
List.Clear;
FillChar(NetResource, SizeOf(NetResource), 0); //初始化网络层次信息
NetResource.lpRemoteName := @GroupName[1]; //指定工作组名称
NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
NetResource.dwScope := RESOURCETYPE_DISK; //列举文件资源信息
Res := WNetOpenEnum( RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> NO_ERROR Then Exit; //执行失败
While True Do //列举指定工作组的网络资源
Begin
Count := $FFFFFFFF; //不限资源数目
BufSize := 8192; //缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息,获取计算机名称
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then break;//资源列举完毕
If (Res <> NO_ERROR) then Exit;//执行失败
Temp := TNetResourceArray(Buf);
For Ind := 0 to Count - 1 do//列举工作组的计算机名称
Begin
List.Add(Temp^.lpRemoteName);
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
If Res <> NO_ERROR Then exit;//执行失败
Result:=True;
FreeMem(Buf);
end;
// name 查找 IP. (参数 string 为计算机名. 函数返回查找到的 IP 地址. )
Function Tsearch.nametoIP (name:string):string;
var
WSAData : TWSAData;
p : PHostEnt;
begin
WSAStartup(2, WSAData); //初始化Winsock DLL
p := GetHostByName(PChar(name)); //取主机信息 if p <> nil then
begin
with p^ do
result := Format('%d.%d.%d.%d',[Byte(h_addr^[0]),Byte(h_addr^[1]),Byte(h_addr^[2]),Byte (h_addr^[3])]); //格式化IP地址
end ;
// else
// showmessage('网络中未找到此计算机!');
WSACleanup;
end;end.
线程类代码如下:
unit Unit2;interfaceuses
Classes, windows , sysutils , WINSOCK ,ADODB;type
TNetResourceArray = ^TNetResource; //网络资源类型的数组
Tsearch = class(TThread)
GroupList , ComputerList :TstringList;
// dataset : Tadodataset;
private { Private declarations }
protected
//constructor create (tempdataset : Tadodataset);//createsuspended : boolean ;
procedure Execute; override;
procedure terminate;
Function GetServerList( var List : TStringList ) : Boolean;
Function GetUsers(GroupName:string;var List:TStringList):Boolean;
Function NameToIP (name:string):string;
end;implementation
uses unit1;procedure Tsearch.Execute;
var i , j ,NameLength : integer;
Name : string;
begin
{ Place thread code here }
GroupList := Tstringlist.Create;
computerList := TstringList.Create;// 如果搜索到工作组 则循环 搜索各个工作组下的计算机 if GetServerList( GroupList ) then
begin
for i := 0 to grouplist.Count - 1 do // 工作组循环
begin // 如果工作组GroupList.Strings[i] 内有计算机 则循环 搜索各个计算机的IP if GetUsers( GroupList.Strings[i] , computerList ) then //计算机则循环
begin
for j := 0 to computerlist.Count - 1 do
begin
NameLength := length(computerList.Strings[j]);
Name := copy( computerList.Strings[j] , 3 ,namelength );// 将搜索到的计算机信息存入 数据库 dataset.Append;
DataSet.FieldByName('PC_name').Value := name;// 用 函数 NameToIP 得到计算机IP
DataSet.FieldByName('IP').Value := NameToIP(Name);
DataSet.FieldByName('PC_group').Value := grouplist.Strings[i]; end;
end ;
end ;
end ;
end;procedure Tsearch.terminate;
begin
GroupList.free;
computerList.Free;
end ;// 搜索网内工作组
Function Tsearch.GetServerList( var List : TStringList ) : Boolean;
Var
NetResource : TNetResource;
Buf : Pointer;
Count,BufSize,Res : DWORD;
lphEnum : THandle;
p:TNetResourceArray;
i,j : SmallInt;
NetworkTypeList : TList;
Begin
Result := False;
NetworkTypeList := TList.Create;
List.Clear;
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
//获取整个网络中的文件资源的句柄,lphEnum为返回名柄
If Res <> NO_ERROR Then exit;
//执行失败,退出
//执行成功,开始获取整个网络中的网络类型信息
Count := $FFFFFFFF;
//不限资源数目
BufSize := 8192;
//缓冲区大小设置为8K
GetMem(Buf, BufSize);
//申请内存,用于获取工作组信息
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If ( Res = ERROR_NO_MORE_ITEMS )
//资源列举完毕
or (Res <> NO_ERROR )
//执行失败
Then Exit;
P := TNetResourceArray(Buf);
For I := 0 To Count - 1 Do
//记录各个网络类型的信息
Begin
NetworkTypeList.Add(p);
Inc(P);
End;
//WNetCloseEnum关闭一个列举句柄
Res:= WNetCloseEnum(lphEnum);
//关闭一次列举
If Res <> NO_ERROR Then exit;
For J := 0 To NetworkTypeList.Count-1 Do
//列出各个网络类型中的所有工作组名称
Begin
//列出一个网络类型中的所有工作组名称
NetResource := TNetResource(NetworkTypeList.Items[J]^);
//网络类型信息
//获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> NO_ERROR Then break;
//执行失败
While true Do
//列举一个网络类型的所有工作组的信息
Begin
Count := $FFFFFFFF;
//不限资源数目
BufSize := 8192;
//缓冲区大小设置为8K
GetMem(Buf, BufSize);
//申请内存,用于获取工作组信息,获取一个网络类型的文件资源信息,
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If ( Res = ERROR_NO_MORE_ITEMS )
//资源列举完毕
or (Res <> NO_ERROR)
//执行失败
then break;
P := TNetResourceArray(Buf);
For I := 0 To Count - 1 Do
//列举各个工作组的信息
Begin
List.Add( StrPAS( P^.lpRemoteName ));
//取得一个工作组的名称
Inc(P);
End;
End;
Res := WNetCloseEnum(lphEnum);
//关闭一次列举
If Res <> NO_ERROR Then break;
//执行失败
End;
Result := True;
FreeMem(Buf);
NetworkTypeList.Destroy;
End;
// 搜索工作组内的计算机
Function Tsearch.GetUsers(GroupName:string;var List:TStringList):Boolean;
Var
NetResource:TNetResource;
Buf : Pointer;
Count,BufSize,Res : DWord;
Ind : Integer;
lphEnum : THandle;
Temp:TNetResourceArray;
Begin
Result := False;
List.Clear;
FillChar(NetResource, SizeOf(NetResource), 0); //初始化网络层次信息
NetResource.lpRemoteName := @GroupName[1]; //指定工作组名称
NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
NetResource.dwScope := RESOURCETYPE_DISK; //列举文件资源信息
Res := WNetOpenEnum( RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> NO_ERROR Then Exit; //执行失败
While True Do //列举指定工作组的网络资源
Begin
Count := $FFFFFFFF; //不限资源数目
BufSize := 8192; //缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息,获取计算机名称
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then break;//资源列举完毕
If (Res <> NO_ERROR) then Exit;//执行失败
Temp := TNetResourceArray(Buf);
For Ind := 0 to Count - 1 do//列举工作组的计算机名称
Begin
List.Add(Temp^.lpRemoteName);
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
If Res <> NO_ERROR Then exit;//执行失败
Result:=True;
FreeMem(Buf);
end;
// name 查找 IP. (参数 string 为计算机名. 函数返回查找到的 IP 地址. )
Function Tsearch.nametoIP (name:string):string;
var
WSAData : TWSAData;
p : PHostEnt;
begin
WSAStartup(2, WSAData); //初始化Winsock DLL
p := GetHostByName(PChar(name)); //取主机信息 if p <> nil then
begin
with p^ do
result := Format('%d.%d.%d.%d',[Byte(h_addr^[0]),Byte(h_addr^[1]),Byte(h_addr^[2]),Byte (h_addr^[3])]); //格式化IP地址
end ;
// else
// showmessage('网络中未找到此计算机!');
WSACleanup;
end;end.
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, Grids, DBGrids, ADODB;type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADODataSet1: TADODataSet;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}
uses unit2;
var Search : Tsearch;procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
for i:= 0 to form1.ADODataSet1.RecordCount -1 do
adodataset1.Delete;
search := tsearch.Create(true);
search.dataset :=form1.ADODataSet1;
search.Resume ;
search.WaitFor
end;end.
你可以定义一个消息,当线程运行完发个消息给窗体