发信人: teleme(PassWord)
整理人: teleme(2001-04-25 12:21:15), 站内信件
|
以下是我以前写得一个在服务器上如何列出域中所有客户端的IP地址的例子，现在里面的内容就包含了你需要的东西。
如果网上机器太多的时候要运行半天，我也找不到原因，你看看吧
//***************************以下存成unit1.pas*************
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,winsock;
type
TNetResourceArray = ^TNetResource; //网络资源类型的数组
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Function GetUsers(GroupName:string;var List:TStringList):Boolean;
//得到指定工作组的成员
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function DeleName(ComName:string):string;
begin
DeleName:=copy(ComName,3,length(ComName)-2);
end;
function GetCompueterIp(sComputerName:string):string;
var
WSAData: TWSAData;
HostEnt: PHostEnt;
sIP: string;
begin
//函数返回指定计算机的IP地址，如果不成功返回空
WSAStartup(2, WSAData);
HostEnt := gethostbyname(PChar(sComputerName));
if HostEnt <> nil then
begin
with HostEnt^ do
sIP := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
end;
WSACleanup;
GetCompueterIp:=sIP;
end;
//函数GetServerList列举出整个网络中的工作组名称，返回值为TRUE表示执行成功，
//参数List中返回服务器（工作组）的名称
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);
//获取整个网络中的文件资源的句柄，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 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;
alllist,List:TstringList;
i,k:integer;
begin
List:=TstringList.Create;
AllList:=TstringList.Create;
memo1.lines.Clear;
sl:=Tstringlist.create;
if GetServerList(sl) then
begin
for i:=0 to sl.count-1 do //
begin
list.Clear ;
if GetUsers(sl.Strings[i],List) then
begin
for k:=0 to List.Count -1 do
alllist.Add(DeleName(List.Strings[k]));
end;
end;
for i:=0 to alllist.Count -1 do
memo1.lines.Add(alllist.Strings[i]+'的IP是'+GetCompueterIp(alllist.Strings[i]));
end
else
memo1.lines.Add('没有找到工作组！');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.lines.Clear;
end;
end.
//****************************以下存成unit1.dfm*****************
object Form1: TForm1
Left = 281
Top = 104
Width = 311
Height = 375
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 113
Top = 304
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 303
Height = 297
Align = alTop
Caption = 'Panel1'
TabOrder = 1
object Memo1: TMemo
Left = 8
Top = 8
Width = 289
Height = 281
Lines.Strings = (
'Memo1')
ScrollBars = ssVertical
TabOrder = 0
end
end
end
//************************************
|
|