type
TMainThread = class(TThread)
procedure Execute; override;
function GetServerList(var List: TStringList): Boolean;
procedure EnumLocalUsersAndGroups;
end;//主線程 type
TTestThread = class(TThread)
private
Id:Integer;
procedure test;
function NameToIp(Name: string): String;
function GetUsers(GroupName: string; var List: TStringList): Boolean;
protected
procedure Execute; override;
public
constructor create(suspended:boolean;i:integer);
end;
procedure TTestThread.Execute;
begin
Synchronize(test);
end;
constructor TTestThread.create(suspended: Boolean; i: Integer);
begin
id:=i;
inherited create(suspended);
end;
function TTestThread.GetUsers(GroupName: string; var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;
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 := $000003E8;
BufSize := 8192;
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 + 2);
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum);
if Res <> NO_ERROR then Exit;
Result := True;
FreeMem(Buf);
End;
function TTestThread.NameToIp(Name: string): String;
var
WSAData : TWSADATA;
HostEnt : PHOSTENT;
begin
result :='';
WSAStartup(2,WSAData);
HostEnt:=GetHostByName(PChar(Name));
if HostEnt <> nil then
begin
with HostEnt^ do
result :=Format('%d.%d.%d.%d',[Byte(h_addr^[0]),Byte(h_addr^[1])
,Byte(h_addr^[2]),Byte(h_addr^[3])]);
end;
WSaCleanup;
end;
procedure TTestThread.test;
var UserLst: TStringList;
AIndex:Integer;
begin
GetUsers(Frm_Mainfrm.TreeView1.Items[0].Item[id].Text , UserLst);
if UserLst.Count<>0 then
begin
for AIndex:=0 to UserLst.Count-1 do
begin
Frm_Mainfrm.TreeView1.Items.AddChild(Frm_Mainfrm.TreeView1.Items[0].Item [id] ,UserLst.Strings[AIndex]); end;
end;
UserLst.Clear;
end;function TMainThread.GetServerList(var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;
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);
if Res <> NO_ERROR then Exit;
Count := $000003E8;
BufSize := 8192;
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;
Res := WNetCloseEnum(lphEnum);
if Res <> NO_ERROR then exit;
for J := 0 to NetworkTypeList.Count - 1 do
begin
NetResource := TNetResource(NetworkTypeList.Items[J]^);
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
if Res <> NO_ERROR Then break;
While true Do
Begin
Count := $000003E8;
BufSize := 8192;
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;procedure TMainthread.EnumLocalUsersAndGroups; //查局域網內所有的工作組並建樹
var
ServerLst: TStringList;
Index: Integer;
vNode :TTReeNode;
obj:array of TTestThread;
begin
ServerLst := TStringList.Create;
Frm_Mainfrm.TreeView1.Items.Clear;
Screen.Cursor:=crHourGlass;
vNode:=Frm_Mainfrm.treeview1.Items.Add(nil,'工作組');
if ( GetServerList(ServerLst) = True) then
begin
setlength(obj,ServerLst.Count);
for Index := 0 to ServerLst.Count - 1 do
begin
Frm_Mainfrm.TreeView1.Items.AddChild(vNode,ServerLst.Strings[Index]);
TTestThread.create(False,Index );
end;
end;Screen.Cursor:=crDefault;
end;
procedure TmainThread.Execute;
begin
EnumLocalUsersAndGroups
end; procedure TFrm_Mainfrm.FormCreate(Sender: TObject);
begin
TMainThread.Create(False);//創建主線程
end;為什麼執行這段代碼出錯??
TMainThread = class(TThread)
procedure Execute; override;
function GetServerList(var List: TStringList): Boolean;
procedure EnumLocalUsersAndGroups;
end;//主線程 type
TTestThread = class(TThread)
private
Id:Integer;
procedure test;
function NameToIp(Name: string): String;
function GetUsers(GroupName: string; var List: TStringList): Boolean;
protected
procedure Execute; override;
public
constructor create(suspended:boolean;i:integer);
end;
procedure TTestThread.Execute;
begin
Synchronize(test);
end;
constructor TTestThread.create(suspended: Boolean; i: Integer);
begin
id:=i;
inherited create(suspended);
end;
function TTestThread.GetUsers(GroupName: string; var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;
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 := $000003E8;
BufSize := 8192;
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 + 2);
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum);
if Res <> NO_ERROR then Exit;
Result := True;
FreeMem(Buf);
End;
function TTestThread.NameToIp(Name: string): String;
var
WSAData : TWSADATA;
HostEnt : PHOSTENT;
begin
result :='';
WSAStartup(2,WSAData);
HostEnt:=GetHostByName(PChar(Name));
if HostEnt <> nil then
begin
with HostEnt^ do
result :=Format('%d.%d.%d.%d',[Byte(h_addr^[0]),Byte(h_addr^[1])
,Byte(h_addr^[2]),Byte(h_addr^[3])]);
end;
WSaCleanup;
end;
procedure TTestThread.test;
var UserLst: TStringList;
AIndex:Integer;
begin
GetUsers(Frm_Mainfrm.TreeView1.Items[0].Item[id].Text , UserLst);
if UserLst.Count<>0 then
begin
for AIndex:=0 to UserLst.Count-1 do
begin
Frm_Mainfrm.TreeView1.Items.AddChild(Frm_Mainfrm.TreeView1.Items[0].Item [id] ,UserLst.Strings[AIndex]); end;
end;
UserLst.Clear;
end;function TMainThread.GetServerList(var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;
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);
if Res <> NO_ERROR then Exit;
Count := $000003E8;
BufSize := 8192;
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;
Res := WNetCloseEnum(lphEnum);
if Res <> NO_ERROR then exit;
for J := 0 to NetworkTypeList.Count - 1 do
begin
NetResource := TNetResource(NetworkTypeList.Items[J]^);
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
if Res <> NO_ERROR Then break;
While true Do
Begin
Count := $000003E8;
BufSize := 8192;
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;procedure TMainthread.EnumLocalUsersAndGroups; //查局域網內所有的工作組並建樹
var
ServerLst: TStringList;
Index: Integer;
vNode :TTReeNode;
obj:array of TTestThread;
begin
ServerLst := TStringList.Create;
Frm_Mainfrm.TreeView1.Items.Clear;
Screen.Cursor:=crHourGlass;
vNode:=Frm_Mainfrm.treeview1.Items.Add(nil,'工作組');
if ( GetServerList(ServerLst) = True) then
begin
setlength(obj,ServerLst.Count);
for Index := 0 to ServerLst.Count - 1 do
begin
Frm_Mainfrm.TreeView1.Items.AddChild(vNode,ServerLst.Strings[Index]);
TTestThread.create(False,Index );
end;
end;Screen.Cursor:=crDefault;
end;
procedure TmainThread.Execute;
begin
EnumLocalUsersAndGroups
end; procedure TFrm_Mainfrm.FormCreate(Sender: TObject);
begin
TMainThread.Create(False);//創建主線程
end;為什麼執行這段代碼出錯??
解决方案 »
- 求图片转pdf的实现原理,500分。最好是delphi的代码
- 请教:如何在一个Form中hint 一些字?
- 除以小数取余数
- 如何刷新memo中的数据?
- 50分求INDY中的IDHTTP实现代理,在线等
- 如何创建程序的快捷方式,并将其放入系统的启动文件夹中?
- 怎样改变动态创建teechart(series)的轴标记的style?
- 重新画dbgrid
- 请参与 【征求多用户操作的完美解决办法!分不够可以在开帖子!(300分)】一贴的同志近来接分!!
- D5中TNMPOP3收取邮件时如何显示中文?
- 关于数据和数据之间的空格~~~~~~~~~
- 我想打印窗体该怎样做。我窗体 上面有很多控件 ,其中有lable 和edit 他们构成一个表格 ,然后按照这个表格打印出来
A:TMainThread;
然后在
A :=TMainThread.Create(False);