精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>Delphi 网络编程>>在服务器上如何列出域中所有客户端的IP地址?

主题:在服务器上如何列出域中所有客户端的IP地址?
发信人: 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 
//************************************  

 

[关闭][返回]