获取网上邻居所有计算机名，网上有很多，但都不能正常运行。

Question

unit Main;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  WinSock, StdCtrls, tools, ExtCtrls, Buttons, IniFiles, ComCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    edStart: TEdit;
    edEnd: TEdit;
    plMemo: TPanel;
    Panel3: TPanel;
    lbCount: TLabel;
    btnGetHostName: TButton;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    Label1: TLabel;
    lbUsedTime: TLabel;
    Memo1: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    btnPing: TButton;
    ProgressBar: TProgressBar;
    procedure btnGetHostNameClick(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnPingClick(Sender: TObject);
    procedure Memo1DblClick(Sender: TObject);
  private
    { Private declarations }
    sysDir: string;
    CountOfThreads: integer;
    IpStartLastSection,IpEndLastSection: integer;
    procedure MyMsgHasGetName(var msg: TMessage); message MYMSG_HASGETNAME;
    procedure MyMsgResultOfPing(var msg: TMessage); message MYMSG_RESULTOFPING;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
{$R *.DFM}procedure TForm1.btnGetHostNameClick(Sender: TObject);
var
  i: integer;
  IpHeader,sIP: string;
  //p: PHostEnt;
begin
  if GetIPHeader(edStart.Text) <> GetIPHeader(edEnd.Text) then
    showMessage(' Error ');
  IpHeader := GetIPHeader(edStart.Text);
  IpStartLastSection := GetIPLastSection(edStart.Text);
  IpEndLastSection := GetIPLastSection(edEnd.Text);
  if (IpStartLastSection = 0)or(IpEndLastSection = 0)
      or(IpStartLastSection > IpEndLastSection) then
    exit;  lbUsedTime.Caption := '0';
  timer1.Enabled := true;
  for i := IpStartLastSection to IpEndLastSection do
  begin
    sIP := IpHeader + inttostr(i);
    with TThreadGetComputerName.Create(handle,sIP,false) do;
      //FreeOnTerminate := true;
    inc(CountOfThreads);
  end;
end;procedure TForm1.MyMsgHasGetName(var msg: TMessage);
var
  sIP: string;
  p: PHostEnt;
  i: integer;
begin
  if msg.WParam <> 0 then
  begin
    sIP := string(pchar(msg.WParam));
    if length(sIP) < 20 then
      for i:=length(sIP) to 20 do
        sIP := sIP + ' ';
  end
  else exit;
  if msg.LParam <> 0 then
  begin
    p := PHostEnt(msg.LParam);
    Memo1.Lines.Add('IP: ' + sIP + '   Computer Name: ' + p^.h_name);
  end
  else
  begin
    Memo1.Lines.Add('IP: ' + sIP + '   Computer Name: ' + '=Unknown=');
  end;
  Application.ProcessMessages;
  dec(CountOfThreads);
  if CountOfThreads = 0 then Timer1.Enabled := false;
end;procedure TForm1.MyMsgResultOfPing(var msg: TMessage);
var
  ResultStr: string;
begin
  ResultStr := string(PChar(msg.lParam));
  Memo1.Lines.Add(ResultStr);
  dec(CountOfThreads);
  ProgressBar.Position := ProgressBar.Position + 1;
  Application.ProcessMessages;
  if CountOfThreads = 0 then Timer1.Enabled := false;
end;procedure TForm1.Memo1Change(Sender: TObject);
begin
  lbCount.Caption := inttostr(Memo1.Lines.Count);
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if CountOfThreads = 0 then
    timer1.Enabled := false
  else
    lbUsedTime.Caption := inttostr((strtoint(lbUsedTime.Caption))+1);
  Application.ProcessMessages;
end;procedure TForm1.FormCreate(Sender: TObject);
var
  IniFile: TIniFile;
  strStart,strEnd: string;
begin
  plMemo.Align := alClient;
  CountOfThreads := 0;
  SetLength(sysDir,255);
  GetSystemDirectory(pChar(sysDir),255);
  sysDir := PChar(sysDir);
  if (length(sysDir) = 0) then exit;
  if copy(sysDir,length(sysDir),1) <> '\' then
    sysDir := sysDir + '\';
  IniFile:=TIniFile.Create(sysDir + 'RSetup.ini');
  try
    strStart := IniFile.ReadString('RANGE','START','');
    strEnd := IniFile.ReadString('RANGE','END','');
    if (strStart <> '')and(strEnd <> '') then
    begin
      edStart.Text := strStart;
      edEnd.Text := strEnd;
    end;
  finally
    IniFile.Free;
  end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  IniFile: TIniFile;
begin
  if sysDir = '' then exit;
  IniFile:=TIniFile.Create(sysDir + 'RSetup.ini');
  try
    IniFile.WriteString('RANGE','START',edStart.Text);
    IniFile.WriteString('RANGE','END',edEnd.Text);
  finally
    IniFile.Free;
  end;
end;procedure TForm1.btnPingClick(Sender: TObject);
var
  i: integer;
  IpHeader,sIP: string;
  WSAData: TWSAData;
  hICMPdll: HMODULE;
  hICMP: THandle;
  IcmpCreateFile: TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho: TIcmpSendEcho;
begin
  if GetIPHeader(edStart.Text) <> GetIPHeader(edEnd.Text) then
    showMessage(' Error ');
  IpHeader := GetIPHeader(edStart.Text);
  IpStartLastSection := GetIPLastSection(edStart.Text);
  IpEndLastSection := GetIPLastSection(edEnd.Text);
  if (IpStartLastSection = 0)or(IpEndLastSection = 0)
      or(IpStartLastSection > IpEndLastSection) then
    exit;
  ProgressBar.Position := 0;
  ProgressBar.Max := IpEndLastSection - IpStartLastSection + 1;
  WSAStartup(2,WSAData);
  try
    hICMPdll := LoadLibrary('icmp.dll');
    @ICMPCreateFile := GetProcAddress(hICMPdll,'IcmpCreateFile');
    @ICMPCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
    @ICMPSendEcho := GetProcAddress(hICMPdll,'IcmpSendEcho');
    hICMP := IcmpCreateFile;
    Memo1.Lines.Add('---目的地址---        ------字节数-----返回时间(毫秒)');    lbUsedTime.Caption := '0';
    timer1.Enabled := true;
    for i := IpStartLastSection to IpEndLastSection do
    begin
      sIP := IpHeader + inttostr(i);
      with TThreadPing.Create(handle,sIP,true,
                          hICMP,
                          IcmpCreateFile,
                          IcmpCloseHandle,
                          IcmpSendEcho) do
      begin
        inc(CountOfThreads);
        Application.ProcessMessages;
        Resume;
      end;
      while(CountOfThreads > 20)and(Not Application.Terminated) do
        Application.ProcessMessages;
    end;
    while(CountOfThreads <> 0)and(Not Application.Terminated) do
      Application.ProcessMessages;
  finally
    WSACleanup;
  end;end;procedure TForm1.Memo1DblClick(Sender: TObject);
begin
  Memo1.Clear;
  Memo1Change(sender);
end;end.
unit tools;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  WinSock;
const
  MYMSG_HASGETNAME    =  WM_USER  +   111;
  MYMSG_RESULTOFPING  =  WM_USER  +   112;type
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed record
    TTL: byte;
    TOS: byte;
    Flags: byte;
    OptionsSize: byte;
    OptionsData: PChar;
  end;  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = Packed record
    Address: dword;
    Status: dword;
    RTT: dword;
    DataSize: word;
    Reserved: word;
    Data: pointer;
    Options: TIPOptionInformation;
  end;  TIcmpCreateFile = function: THandle; stdcall;
  TIcmpCloseHandle = function(IcmpHandle: THandle): boolean; stdcall;
  TIcmpSendEcho = function(Icmphandle: Thandle;
                           DestinationAddress: dword;
                           RequestData: pointer;
                           RequestSize: word;
                           RequestOptions: PIPOptionInformation;
                           ReplyBuffer: pointer;
                           ReplySize: dword;
                           Timeout: dword): dword; stdcall;
type
  TThreadGetComputerName = class(TThread)
  private
    fOwnerHandle: hWnd;
    fsIP: string;
  protected
    procedure Execute; override;
  public
    constructor Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean);
  end;  TThreadPing = class(TThread)
  private
    fOwnerHandle: hWnd;
    fsIP: string;
    fhICMP: THandle;
    fIcmpCreateFile: TIcmpCreateFile;
    fIcmpCloseHandle: TIcmpCloseHandle;
    fIcmpSendEcho: TIcmpSendEcho;
  protected
    procedure Execute; override;
  public
    constructor Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean;
                        hICMP: THandle;
                        IcmpCreateFile: TIcmpCreateFile;
                        IcmpCloseHandle: TIcmpCloseHandle;
                        IcmpSendEcho: TIcmpSendEcho);
  end;
function GetIPHeader(sIP: string): string;
function GetIPLastSection(sIP: string): byte;
function wpGetUserNameByIP(sIP: string): PHostEnt;function winPing(sIP: string;
                  hICMP: THandle;
                  IcmpCreateFile: TIcmpCreateFile;
                  IcmpCloseHandle: TIcmpCloseHandle;
                  IcmpSendEcho: TIcmpSendEcho): string;implementationfunction GetIPHeader(sIP: string): string;
var
  tmpIp: string;
begin
  result := '';
  tmpIp := sIP;
  while copy(tmpIp,length(tmpIp),1) <> '.' do
    delete(tmpIp,length(tmpIp),1);
  result := tmpIp;
end;function GetIPLastSection(sIP: string): byte;
var
  tmpIp: string;
  resultStr: string;
begin
  resultStr := '';
  tmpIp := sIP;
  while copy(tmpIp,length(tmpIp),1) <> '.' do
  begin
    resultStr := copy(tmpIp,length(tmpIp),1) + resultStr;
    delete(tmpIp,length(tmpIp),1);
  end;
  if StrToInt(resultStr) > 255 then
    result := 0
  else
    result := StrToInt(resultStr);
end;function wpGetUserNameByIP(sIP: string): PHostEnt;
var
  WSAData: TWSAData;
  p: PHostEnt;
  InetAddr: dword;
begin
  WSAStartup(2,WSAData);
  InetAddr := inet_addr(PChar(sIP));
  try
    try
      p := GetHostByAddr(@InetAddr,length(sIP),PF_Inet);
    finally
      WSACleanup;
    end;
  except
    ShowMessage('Can not Get the COMPUTER NAME which IP = ' + sIP +', Abort');
  end;
  result := p;
end;function winPing(sIP: string;
                  hICMP: THandle;
                  IcmpCreateFile: TIcmpCreateFile;
                  IcmpCloseHandle: TIcmpCloseHandle;
                  IcmpSendEcho: TIcmpSendEcho): string;
var
  IPOpt: TIPOptionInformation; //the option information which send with echo packet
  FIPAddress: dword;
  pReqData,pRevData: PChar;
  pIPE: PIcmpEchoReply;        //ICMP Echo reply cache
  FSize: dword;
  MyString: string;
  FTimeOut: dword;
  BufferSize: dword;
  i: integer;
begin
  Result := PChar(sIP) + 'No acknowledgement';
  if sIP = '' then exit;
  FIPAddress := inet_addr(pchar(sIP));
  FSize := 40;
  BufferSize := SizeOf(TICMPEchoReply) + FSize;
  GetMem(pRevData,FSize);
  GetMem(pIPE,BufferSize);
  FillChar(pIPE^,SizeOf(pIPE^),0);
  pIPE^.Data := pRevData;
  MyString := '------Hello,This is My Echo-------';
  pReqData := PChar(MyString);
  FillChar(IPOpt,Sizeof(IPOpt),0);
  IPOpt.TTL := 64;
  FTimeout := 4000;
  IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),
               @IPOpt,pIPE,BufferSize,FTimeout);
  try
    try
      if length(sIP) < 20 then
        for i:=length(sIP) to 20 do
          sIP := sIP + ' ';
        Result := sIP + 'No acknowledgement';
      if pIPE^.Options.TTL <> 0 then
        if pReqData^ = pIPE^.Options.OptionsData^ then
        begin
          Result := sIP + '--------'
                        +IntToStr(pIPE^.DataSize)
                        + '----------------'
                        + inttostr(pIPE^.RTT);
        end;
    except
      Result := sIP + '     No answer ';
    end;
  finally
    FreeMem(pRevData);
    FreeMem(pIPE);
  end;
end;constructor TThreadGetComputerName.Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean);
begin
  fsIP := sIP;
  fOwnerHandle := OwnerHandle;
  inherited Create(CreateSuspended);
  Self.FreeOnTerminate := true;
end;procedure TThreadGetComputerName.Execute;
var
  p: PHostEnt;
  sIP: string;
begin
  sIP := fsIP;
  p := wpGetUserNameByIP(sIP);
  SendMessage(fOwnerHandle,MYMSG_HASGETNAME,integer(@sIP[1]),integer(p));
end;constructor TThreadPing.Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean;
                                hICMP: THandle;
                                IcmpCreateFile: TIcmpCreateFile;
                                IcmpCloseHandle: TIcmpCloseHandle;
                                IcmpSendEcho: TIcmpSendEcho);
begin
  fsIP := sIP;
  fOwnerHandle := OwnerHandle;
  fhICMP := hICMP;
  fIcmpCreateFile := IcmpCreateFile;
  fIcmpCloseHandle := IcmpCloseHandle;
  fIcmpSendEcho := IcmpSendEcho;
  inherited Create(CreateSuspended);
  Self.FreeOnTerminate := true;
end;procedure TThreadPing.Execute;
var
  sIP,ResultStr: string;
begin
  sIP := fsIP;
  ResultStr := winPing(sIP,
                        fhICMP,
                        fIcmpCreateFile,
                        fIcmpCloseHandle,
                        fIcmpSendEcho);
  SendMessage(fOwnerHandle,MYMSG_RESULTOFPING,integer(@sIP[1]),
              integer(@ResultStr[1]));
end;end.
可用的程序，两个单元

Answer 1

借花献佛，我已经测试过，没问题。//列举出整个网络中的工作组名称，返回值为TRUE表示执行成功，
//参数List中返回服务器（工作组）的名称
Function 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;    //获取整个网络中的文件资源的句柄，lphEnum为返回名柄
    Res := WNetOpenEnum( RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,Nil,lphEnum);
    If Res <> NO_ERROR Then exit;//Raise Exception(Res);//执行失败    //获取整个网络中的网络类型信息
    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;
//列举出指定工作组GroupName中的计算机名称，返回值为TRUE表示执行成功，
//参数List中返回计算机名称
Function 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 := $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
        //获取工作组的计算机名称，+2表示删除"\\"，如\\wangfajun=>wangfajun
        List.Add(Temp^.lpRemoteName + 2);
        Inc(Temp);
        End;
    End;    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    If Res <> NO_ERROR Then exit;//执行失败    Result := True;
    FreeMem(Buf);
End;