取得工作组中所有计算机列表(50分)

  • 主题发起人 主题发起人 yifeibbs
  • 开始时间 开始时间
Y

yifeibbs

Unregistered / Unconfirmed
GUEST, unregistred user!
抄来一段代码，不能编译：
unit WORK;

interface

uses windows, Sysutils;

implementation

var
Computer : Array[1..500] of String[25];
ComputerCount : Integer;

procedure FindAllComputers(Workgroup : String);
Var
EnumHandle :THandle;
WorkgroupRS :TNetResource;
Buf:Array[1..500] of TNetResource;
BufSize : Integer;
Entries : Integer;
Result : cardinal;
begin
ComputerCount := 0;
Workgroup := Workgroup + #0;
FillChar(WorkgroupRS, SizeOf(WorkgroupRS) , 0);
With WorkgroupRS do begin
dwScope := 2;
dwType := 3;
dwDisplayType := 1;
dwUsage := 2;
lpRemoteName := @Workgroup[1];
end;
WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,0,@WorkgroupRS,EnumHandle );

Repeat
Entries:= 1;
BufSize:= SizeOf(Buf);
Result:=WNetEnumResource(EnumHandle,Entries,@Buf,BufSize);
-------------
If (Result = NO_ERROR) and (Entries = 1) then
begin
Inc(ComputerCount);
Computer[ComputerCount]:=StrPas(Buf[1].lpRemoteName);
end;
Until (Entries<>1) or (Result <> NO_ERROR);
WNetCloseEnum( EnumHandle );
end;

end.
编译时有两处错误：实参和变参不符。可是怎么该也没成功！
大概是数组地址问题
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TNetResourceArray=^TNetResource;
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Edit1: TEdit;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
Function GetUsers(GroupName:string;var List:TStringList):Boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
Function 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);
if Res<>NO_ERROR Then exit;
Count:=$FFFFFFFF;
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:=$FFFFFFFF;
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;
Function TForm1.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;

procedure TForm1.Button1Click(Sender: TObject);
var
sl:Tstringlist;
i:integer;
begin
memo1.Lines.Clear;
sl:=Tstringlist.create;
if getserverlist(sl) then
begin
for i:=0 to sl.count-1 do
memo1.Lines.Add(sl.Strings);
memo1.LineS.Add('总共找到'+inttostr(sl.Count)+'个工作组!');
end
else
memo1.Lines.Add('没有找到工作组');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
List:TstringList;
i:integer;
begin
try
List:=TstringList.Create;
if GetUsers(edit1.text,List) then
if List.count=0 then //工作组下没找到计算机
begin
memo2.Lines.Add (edit1.text+'工作组下没有计算机！');
end
else
memo2.Lines.Add (edit1.text+'下的所有计算机如下：');
for i:=0 to List.Count-1 do
begin
Memo2.lines.Add (List.strings);
end;
finally
List:=TstringList.Create; //如有异常则释放分配的资源
end;
end;

end.
 
type
PnetResourceArr = ^TNetResource;

implementation
procedure GetServerList(List:TStrings);
Type
{$H+}
PMyRec = ^MyRec;
MyRec = Record
dwScope : Integer;
dwType : Integer;
dwDisplayType : Integer;
dwUsage : Integer;
LocalName : String;
RemoteName : String;
Comment : String;
Provider : String;
End;
{H-}
Var
NetResource : TNetResource;
TempRec : PMyRec;
Buf : Pointer;
Count,
BufSize,
Res : DWORD;
lphEnum : THandle;
p : PNetResourceArr;
i,
j : SmallInt;
NetworkTypeList : TList;
begin
// Result := False;

NetworkTypeList := TList.Create;
List.BeginUpdate;
List.Clear;
GetMem(Buf, 8192);
Try
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
If Res <> 0 Then Raise Exception(Res);
Count := $FFFFFFFF;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then Exit;
If (Res <> 0) Then Raise Exception(Res);
P := PNetResourceArr(Buf);
For I := 0 To Count - 1 Do
Begin
New(TempRec);
TempRec^.dwScope := P^.dwScope;
TempRec^.dwType := P^.dwType ;
TempRec^.dwDisplayType := P^.dwDisplayType ;
TempRec^.dwUsage := P^.dwUsage ;
TempRec^.LocalName := StrPas(P^.lpLocalName);
TempRec^.RemoteName := StrPas(P^.lpRemoteName);
TempRec^.Comment := StrPas(P^.lpComment);
TempRec^.Provider := StrPas(P^.lpProvider);
NetworkTypeList.Add(TempRec);
Inc(P);
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 Then Raise Exception(Res);
For J := 0 To NetworkTypeList.Count-1 Do
Begin
TempRec := NetworkTypeList.Items[J];
NetResource := TNetResource(TempRec^);
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> 0 Then Raise Exception(Res);
While true Do
Begin
Count := $FFFFFFFF;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then Break;
If (Res <> 0) Then Raise Exception(Res);
P := PNetResourceArr(Buf);
For I := 0 To Count - 1 Do
Begin
List.Add(P^.lpRemoteName);
Inc(P);
End;
End;
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 Then Raise Exception(Res);
//Result := True;
Finally
FreeMem(Buf);
NetworkTypeList.Destroy;
End;
List.EndUpdate;
end;

procedure GetUserList(fServer:string;List:TStrings);
Var
NetResource : TNetResource;
Buf : Pointer;
Count,
BufSize,
Res : DWord;
Ind : Integer;
lphEnum : THandle;
Temp : PNetResourceArr;
Begin


List.Clear;
GetMem(Buf, 8192);
Try
FillChar(NetResource, SizeOf(NetResource), 0);
NetResource.lpRemoteName := @fServer[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 <> 0 Then Exit;
While True Do
Begin
Count := $FFFFFFFF;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then Exit;
If (Res <> 0) then Exit;
Temp := PNetResourceArr(Buf);
For Ind := 0 to Count - 1 do
Begin
List.Add(Temp^.lpRemoteName + 2); { Add all the network usernames to List StringList }
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 Then Raise Exception(Res);
// Result := True;
Finally
FreeMem(Buf);
End;
End;

这程序是网上来的，我整理了一个，就变成现在这样了。
procedure oncreate;
begin GetServerList(Listbox1.Items);end;
procedure Listbox1.Onclick
begin
GetUserList(Listbox1.Items[Listbox1.ItemIndex],Listbox2.Items);
end;
**************************************
获得网上邻居列表的程序
程序如下：
var
i : Integer;
ErrCode : Integer;
NetRes : Array[0..1023] of TNetResource;
EnumHandle : Thandle;
EnumEntries : Dword;
BufferSize : Dword;
ComputerIP,ComputerName:String;
begin
//try
With NetRes[0] do begin
dwScope :=RESOURCE_GLOBALNET;
dwType :=RESOURCETYPE_ANY;
dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
dwUsage :=RESOURCEUSAGE_CONNECTABLE;
lpLocalName :=NIL;
lpRemoteName :=NIL;
lpComment :=NIL;
lpProvider :=NIL;
end;
{ get net root }
ErrCode:=WNetOpenEnum(
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER,
@NetRes[0],
EnumHandle
);

If ErrCode=NO_ERROR then begin
EnumEntries:=1;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
WNetCloseEnum(EnumHandle);
ErrCode:=WNetOpenEnum(
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
RESOURCEUSAGE_CONNECTABLE,
@NetRes[0],
EnumHandle
);
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(
EnumHandle,
EnumEntries,
@NetRes,
BufferSize
);

for i:=0 to 1023 do
if NetRes.lpRemoteName='' then Exit
else begin
ComputerName:=Copy(NetRes.lpRemoteName,3,Length(NetRes.lpRemoteName)-2);
ComputerIP:=GetIP(ComputerName);
ShowMessage('计算机名' + NetRes.lpRemoteName + chr(13)
+ '计算机说明:' + NetRes.lpComment + chr(13)
+ 'IP地址:' + ComputerIP);
end;
end;
*************
请问怎样获取所有能访问的网上邻居中的计算机名称列表？
通过Windows Shell API
用SHGetSpecialFolderLocation获得Neighborhood的PIDL，然后将一个IShellFolder接
口绑定到这个PIDL，再然后就可以用这个接口的EnumObjects函数枚举其中的对象了。
因我不会Delphi，所以不知道用Delphi应该具体如何做，下面一段C++代码列出了"我
的电脑"下的所有项目(我的计算机没有安装网络邻居，所以用这个代替，方法应该是
一样的)

#include <stdio.h>
#include <iostream.h>
#include <comdef.h>
#include <windows.h>
#include <shellapi.h>
#include <shlobj.h>
#include <shlguid.h>
#include <shlwapi.h>

void _inline error(){ cerr<<"ERROR!"<<endl; _exit(1); }

void main(int argc, char* argv[])
{
IMallocPtr pMalloc;
IShellFolderPtr pShellFolder,pFolder;
LPITEMIDLIST pidl;
IEnumIDListPtr pEnum;
HRESULT hr;
STRRET Name;
ULONG celtFetched;

SHGetMalloc(&amp;pMalloc);

if (!SUCCEEDED(SHGetDesktopFolder(&amp;pShellFolder)))
error();
if (!SUCCEEDED(SHGetSpecialFolderLocation(NULL,CSIDL_DRIVES,&amp;pidl)))
error();
pShellFolder->BindToObject(pidl,NULL,IID_IShellFolder,(LPVOID*)&amp;pFolder);

hr=pFolder->EnumObjects(NULL,SHCONTF_FOLDERS|SHCONTF_NONFOLDERS|
SHCONTF_INCLUDEHIDDEN,&amp;pEnum);

while ((hr = pEnum->Next (1, &amp;pidl, &amp;celtFetched)) != S_FALSE &amp;&amp;
celtFetched == 1)
{
hr = pFolder->GetDisplayNameOf (pidl, SHGDN_NORMAL , &amp;Name);
if (FAILED (hr))
{
error();
break;
}
printf("%s/n",Name.cStr);
}

if (!pidl)
pMalloc->Free(pidl);
}

**************
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ImgList, ExtCtrls, ToolWin;

type
TForm1 = class(TForm)
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
Panel1: TPanel;
ResourceTree: TTreeView;
Splitter1: TSplitter;
ResourceList: TListView;
Panel2: TPanel;
lbScope: TLabel;
lbType: TLabel;
lbDisplayType: TLabel;
lbUsage: TLabel;
lbLocalName: TLabel;
lbRemoteName: TLabel;
lbComment: TLabel;
lbProvider: TLabel;
ToolButton2: TToolButton;
procedure Button1Click(Sender: TObject);
procedure ResourceTreeChange(Sender: TObject; Node: TTreeNode);
procedure ToolButton2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function AddTreeItem(nr:NETRESOURCE;node:TTreeNode):TTreeNode;
function EnumNetWorkResource(lpnr:PNetResource;node:TTreeNode):Boolean;
procedure ConnectResource(pnr:PNetResource);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }
function GetLastErrorText:string;
var
dwSize:DWORD;
lpszTemp:LPSTR;
begin
dwSize:=512;
lpszTemp:=nil;
try
GetMem(lpszTemp,dwSize);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil,GetLastError,LANG_NEUTRAL,lpszTemp,dwSize,nil);
finally
Result:=StrPas(lpszTemp);
FreeMem(lpszTemp);
end;
end;

function TForm1.EnumNetWorkResource(lpnr:PNetResource;node:TTreeNode):Boolean;
var
nr:NetResource;
hEnum:THandle;
lpnrLocal: PNETRESOURCE;
cbBuffer:DWORD;
cEntries,dwEnumResult:DWORD;
i:Integer;
LocalNode:TTreeNode;
begin
Result:=False;
cbBuffer:=163840;
cEntries:=$ffffffff;
lpnrLocal:=nil;
if(WNetOpenEnum(RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
0,
lpnr,
hEnum)<>NO_ERROR)then
begin
ShowMessage('Open enum error,node='+lpnr^.lpRemoteName);
ShowMessage(GetLastErrorText);
Result:=False;
Exit;
end;
try
repeat
lpnrLocal:=PNetResource(GlobalAlloc(GPTR,cbBuffer));
dwEnumResult:=WNetEnumResource(hEnum,
cEntries,
lpnrLocal,
cbBuffer);
if(dwEnumResult=NO_ERROR)then
begin
for i:=0 to cEntries-1 do
begin
nr:=(PNetResource(PChar(lpnrLocal)+sizeOf(NetResource)*i))^;
LocalNode:=AddTreeItem(nr,node);
if(RESOURCEUSAGE_CONTAINER=
nr.dwUsage and RESOURCEUSAGE_CONTAINER)then
begin
if(not EnumNetWorkResource(@nr,LocalNode))then
begin
ShowMessage('Error enum,Parent='+lpnr^.lpRemoteName);
ShowMessage(GetLastErrorText);
end;
end;
end;
end;
until (dwEnumResult=ERROR_NO_MORE_ITEMS);
if(dwEnumResult=ERROR_NO_MORE_ITEMS)then
Result:=True;
Except
GlobalFree(Cardinal(lpnrLocal));
WNetCloseEnum(hEnum);
Raise;
end;
GlobalFree(Cardinal(lpnrLocal));
WNetCloseEnum(hEnum);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
EnumNetWorkResource(nil,ResourceTree.Items[0]);
end;

function TForm1.AddTreeItem(nr: NETRESOURCE; node: TTreeNode): TTreeNode;
var
pnr:PNetResource;
begin
GetMem(pnr,SizeOf(NetResource));
pnr^:=nr;
Result:=ResourceTree.Items.AddChildObject(node,nr.lpRemoteName,pnr);
if(nr.dwUsage=RESOURCEUSAGE_CONTAINER)then
Result.ImageIndex:=0
else Result.ImageIndex:=1;
end;

procedure TForm1.ResourceTreeChange(Sender: TObject; Node: TTreeNode);
var
pnr:PNetResource;
begin
pnr:=PNetResource(Node.Data);
if(pnr=nil)then Exit;
case pnr^.dwScope of
RESOURCE_CONNECTED:
lbScope.Caption:='Connetted';
RESOURCE_GLOBALNET:
lbScope.Caption:='GlobalNet';
RESOURCE_REMEMBERED:
lbScope.Caption:='Remembered';
else
lbScope.Caption:='else scope:'+IntToStr(pnr^.dwScope);
end;



case pnr^.dwType of
RESOURCETYPE_DISK:
lbType.Caption:='Disk';
RESOURCETYPE_PRINT:
lbType.Caption:='Printer';
else
lbType.Caption:=IntToStr(pnr^.dwType);
end;

case pnr^.dwDisplayType of
RESOURCEDISPLAYTYPE_DOMAIN:
lbDisplayType.Caption:='Domain';
RESOURCEDISPLAYTYPE_GENERIC:
lbDisplayType.Caption:='Generic';
RESOURCEDISPLAYTYPE_SERVER:
lbDisplayType.Caption:='Server';
RESOURCEDISPLAYTYPE_SHARE:
lbDisplayType.Caption:='Shared';
else
lbDisplayType.Caption:='else type:'+IntToStr(pnr^.dwDisplayType);
end;

case pnr^.dwUsage of
RESOURCEUSAGE_CONTAINER:
lbUsage.Caption:='Container';
RESOURCEUSAGE_CONNECTABLE:
lbUsage.Caption:='Connectable';
else
lbUsage.Caption:='else Usage:'+IntToStr(pnr^.dwUsage);
end;

lbLocalName.Caption:=pnr^.lpLocalName;
lbRemoteName.Caption:=pnr^.lpRemoteName;
lbComment.Caption:=pnr^.lpComment;
lbProvider.Caption:=pnr^.lpProvider;

//ConnectResource(pnr);
end;

procedure TForm1.ConnectResource(pnr: PNetResource);
begin
if((pnr^.dwUsage and RESOURCEUSAGE_CONNECTABLE)
=RESOURCEUSAGE_CONNECTABLE)then
begin
{ if(WNetAddConnection2(pnr^,PChar(''),'wuwei',0)<>NO_ERROR)then
ShowMessage(GetLastErrorText);}
if(WNetAddConnection(pnr^.lpRemoteName,'','h:')<>NO_ERROR)then
ShowMessage(GetLastErrorText);
end;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
var
p:PNetResource;
begin
p:=PNetResource(ResourceTree.Selected.Data);
ConnectResource(p);
end;

end.

*******
查询局域网中NT服务器的计算机名
You should use API function

NET_API_STATUS NetServerEnum(
LPWSTR servername,
DWORD level,
LPBYTE *bufptr,
DWORD prefmaxlen,
LPDWORD entriesread,
LPDWORD totalentries,
DWORD servertype,
LPWSTR domain,
LPDWORD resume_handle
);
 
yifeibbs 老兄：
你的代码参数定义的有问题。如下：

Var
>>> Buf:Array[1..500] of TNetResource;
>>> BufSize : Integer; ------------------>改为 BufSize : DWORD;
>>> Entries : Integer; ------------------>改为 BufSize : DWORD;

这样编译通过，不会有任何问题了！ [:)]
 
多谢各位老兄，前面两个代码太长，对老菜来说难以。。。看懂！
不过，我以后会继续研究的。
谢谢各位
 
您必须登录或注册才可回复。

Similar threads

I
取得Win95/98的网络邻居中的工作组及计算机名
回复
0
查看
615
import
I
I
搜索共享资源
回复
0
查看
589
import
I
I
在Delphi程序中获取网络资源信息
回复
0
查看
766
import
I
I
网络函数大公开
回复
0
查看
836
import
I
I
获取打印机的打印任务列表
回复
0
查看
2K
import
I
后退
顶部