如何获取局域网内的计算机名和IP地址

Question

procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
ErrCode : Integer;
NetRes : Array[0..1023] of TNetResource;
EnumHandle : Thandle;
EnumEntries : Dword;
BufferSize : Dword;
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[i].lpRemoteName='' then
         Exit
      else
         begin
         ComputerName:=Copy(NetRes[i].lpRemoteName,3,Length(NetRes[i].lpRemoteName)-2);
         listbox1.Items.Add('计算机名' + NetRes[i].lpRemoteName);
         end;
  end;
except
end;
end;

Answer 1

《在网络邻居中获取所有的工作组的计算机名及IP地址》功能的源码，如在网络邻居的TCP/IP属性中不设置（DNS，网关），运行绝对 OK ，如哪位仁兄需要的话，小做修改即可作为小工具使用。但如在网络邻居的TCP/IP属性中设置（DNS，网关）后，其运行速度变得奇慢，后发现问题出在函数gethostbyname上，在下请教各位，有何良方？unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls ,winsock;type
  TNetResourceArray = ^TNetResource;  //网络资源类型的数组
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    function GetIP(Sender: TObject; fcomputername:string) :string;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}                //函数GetServerList列举出整个网络中的工作组名称，返回值为TRUE表示执行成功，
Function GetServerList( var List : TStringList ) : Boolean; //参数List中返回服务器（工作组）的名称
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;  //不限资源数目
    GetMem(Buf, BufSize); //缓冲区大小设置为8K
    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); //WNetCloseEnum关闭一个列举句柄
    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 := 1024*16;    //缓冲区大小设置为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.GetIP(Sender: TObject; fcomputername:string) :string;
var
    WSAData: TWSAData;
    HostEnt: PHostEnt;
begin
    HostEnt := nil;
    WSAStartup(2, WSAData);
    HostEnt := gethostbyname(PChar(fComputerName));
    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 TForm1.Button1Click(Sender: TObject);
var
sl,s2:TstringList;
i,j,k:integer;
temp:string;
begin
  temp:='d:\computer.txt';
  memo1.lines.Clear;
  sl:=Tstringlist.create;
  s2:=Tstringlist.create;
  try
      if GetServerList(sl) then
      begin
      for i:=0 to sl.count-1 do
        begin
          memo1.lines.Add (sl.Strings[i]+':');
          try
            winexec(pchar('command.com /C net view /workgroup:'+sl.Strings[i]+' >'+temp),sw_hide);
          except
          end;
          k:=120;
          repeat;
            sleep(k);
            k:=k+40;
          until
            fileexists(temp);
          s2.LoadFromFile(temp);
          for j:=1 to s2.count-1 do
          begin
            if pos('：',s2.Strings[j]) >0 then
                memo1.lines.Add (s2.Strings[j]);
            if pos('\\',s2.Strings[j]) >0 then
                memo1.lines.Add (' '+copy(s2.Strings[j],1,15)+' IP: '+ GetIP(Sender,trim(copy(s2.Strings[j],3,20))));
            end;
      end;
      memo1.lines.Add('工作组个数：'+inttostr(sl.count));
      end
      else
      memo1.lines.Add('没有找到工作组！');
  except
  end;end;procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.lines.Clear;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  memo1.lines.SaveToFile('LKnet.spl');
  action:=cafree;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;procedure TForm1.FormShow(Sender: TObject);
begin
  IF fileexists('LKnet.spl')  then
    Memo1.Lines.LoadFromFile('LKnet.spl');
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if pos('工作组个数', memo1.Text) =0 then
    button1click(sender);
end;end.