socket的局域网通信问题，如何自动获得在线用户列表（即聊天应用程序已打开处于监听的的用户），要求响应速度较快。

Question

在本公司网中用以下查找在线用户不知可否。
unit aa;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls, CheckLst;type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ClientSocket1: TClientSocket;
    Timer1: TTimer;
    Timer2: TTimer;
    CheckListBox1: TCheckListBox;
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
 i:integer;
implementation{$R *.dfm}
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
socket.SendText('a');
end;procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
errorcode:=0;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if i<=100 then
  begin
    clientsocket1.Close;
    clientsocket1.Address:='192.168.245.'+inttostr(i);
    clientsocket1.Active:=true;
    i:=i+1;
  end
  else
  timer1.Enabled:=false;
end;procedure TForm1.FormActivate(Sender: TObject);
begin
i:=1;
end;procedure TForm1.Timer2Timer(Sender: TObject);
begin
if timer1.Enabled=false then
begin
i:=1;
timer1.Enabled:=true;
end;
end;procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var i:integer;
begin
if checklistbox1.Count>=1 then
begin
showmessage(checklistbox1.Items.Strings[i]);
  for i:=0 to checklistbox1.Count-1 do
  begin
     if trim(checklistbox1.Items.Strings[i])<>trim(serversocket1.Socket.Connections[0].RemoteHost) then
   checklistbox1.Items.Add(serversocket1.Socket.Connections[0].RemoteHost );
  end;
end
else
 checklistbox1.Items.Add(serversocket1.Socket.Connections[0].RemoteHost );
end;
end.

Answer 1

在本公司网中用以下查找在线用户不知可否。
unit aa;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls, CheckLst;type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ClientSocket1: TClientSocket;
    Timer1: TTimer;
    Timer2: TTimer;
    CheckListBox1: TCheckListBox;
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
 i:integer;
implementation{$R *.dfm}
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
socket.SendText('a');
end;procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
errorcode:=0;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if i<=100 then
  begin
    clientsocket1.Close;
    clientsocket1.Address:='192.168.245.'+inttostr(i);
    clientsocket1.Active:=true;
    i:=i+1;
  end
  else
  timer1.Enabled:=false;
end;procedure TForm1.FormActivate(Sender: TObject);
begin
i:=1;
end;procedure TForm1.Timer2Timer(Sender: TObject);
begin
if timer1.Enabled=false then
begin
i:=1;
timer1.Enabled:=true;
end;
end;procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var i:integer;
begin
if checklistbox1.Count>=1 then
begin
showmessage(checklistbox1.Items.Strings[i]);
  for i:=0 to checklistbox1.Count-1 do
  begin
     if trim(checklistbox1.Items.Strings[i])<>trim(serversocket1.Socket.Connections[0].RemoteHost) then
   checklistbox1.Items.Add(serversocket1.Socket.Connections[0].RemoteHost );
  end;
end
else
 checklistbox1.Items.Add(serversocket1.Socket.Connections[0].RemoteHost );
end;
end.

Answer 2

刚写了一个这样的程序用NMUDP控件广播，只要在局域网中运行该程序就会看到在该局域网中所有运行该程序的计算机名称及IP源码如下unit uSearch;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NMUDP, StdCtrls, WinSock;type
  TfmMain = class(TForm)
    NMUDP: TNMUDP;
    mmList: TMemo;
    Label1: TLabel;
    procedure NMUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure BroadCast(StrMsg, strIP: string);
    procedure DeleteWhereIP(StrIP: string);
    function MyComputerName: string;
    function GetLocalIP: string;
    function ExistsIP(StrIP: string): boolean;
  public
    { Public declarations }
    StrBIP: string;
  end;var
  fmMain: TfmMain;implementation{$R *.dfm}{ TForm1 }procedure TfmMain.BroadCast(StrMsg, strIP: string);
var
  mms: TMemoryStream;
begin
  with NMUDP do
  begin
    ReportLevel := Status_Basic;
    if strIP = '' then
      RemoteHost := StrBIP
    else
      RemoteHost := StrIP;
    RemotePort := 6767;
    mms := TMemoryStream.Create;
    try
      mms.Write(StrMsg[1], Length(StrMsg));
      NMUDP.SendStream(mms);
    finally
      mms.Free;
    end;
  end;
end;procedure TfmMain.DeleteWhereIP(StrIP: string);
var
  i: integer;
begin
  for i := 0 to mmList.Lines.Count - 1 do
  begin
    if Copy(mmList.Lines.Strings[i], 4, Pos(';', mmList.Lines.Strings[i]) - 4) = StrIP then
    begin
      mmList.Lines.Delete(i);
      Break;
    end;
  end;
end;procedure TfmMain.NMUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
var
  mms: TMemoryStream;
  StrCName, StrTemp: String;
begin
  mms := TMemoryStream.Create;
  try
    NMUDP.ReadStream(mms);
    mms.Position :=0;
    SetLength(StrCName, NumberBytes);
    mms.Read(StrCName[1], NumberBytes);
    StrTemp := Copy(StrCName, 1, 1);
    if StrTemp = '0' then
    begin
      if (GetLocalIP <> FromIP) and (not ExistsIP(FromIP)) then
        BroadCast('0' + MyComputerName, FromIP);
      if not ExistsIP(FromIP) then
        mmList.Lines.Add('IP:' + FromIP + '; Computer Name: ' + Copy(StrCName, 2, Length(StrCName) - 1));
    end else
      DeleteWhereIP(FromIP);
  finally
    mms.Free;
  end;
end;procedure TfmMain.FormShow(Sender: TObject);
begin
  BroadCast('0' + MyComputerName, '');//0代表启动
end;procedure TfmMain.FormClick(Sender: TObject);
var
  a: array[0..MAX_COMPUTERNAME_LENGTH]of  Char;
  n: dword;
begin
  n := MAX_COMPUTERNAME_LENGTH;
  a := 'a';
  GetComputerName(a, n);
  mmList.Lines.Add(a)
end;function TfmMain.MyComputerName: string;
var
  CName: array[0..MAX_COMPUTERNAME_LENGTH]of  Char;
  n: DWORD;
begin
  n := MAX_COMPUTERNAME_LENGTH;
  GetComputerName(CName, n);
  Result := CName;
end;procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BroadCast('1' + MyComputerName, '');//1代表关闭
end;function TfmMain.GetLocalIP: string;
var
  wVersionRequested: WORD;
  wsaData: TWSAData;
  p: PHostEnt;
  s: array[0..128] of Char;
begin
  wVersionRequested := MAKEWORD(1, 1);
  WSAStartup(wVersionRequested, wsaData);
  try
    GetHostName(@s, 128);
    p := GetHostByName(@s);
   {Get the IpAddress}
    Result := StrPas(iNet_ntoa(PInAddr(p^.h_addr_list^)^));
  finally
    WSACleanup
  end
end;function TfmMain.ExistsIP(StrIP: string): boolean;
var
  i: integer;
begin
  Result := False;
  for i := 0 to mmList.Lines.Count - 1 do
  begin
    if Copy(mmList.Lines.Strings[i], 4, Pos(';', mmList.Lines.Strings[i]) - 4) = StrIP then
    begin
      Result := True;
      Break;
    end;
  end;
end;procedure TfmMain.FormCreate(Sender: TObject);
var
  StrTemp: string;
  i: integer;
begin
  StrTemp := GetLocalIP;
  for i := 0 to 2 do
  begin
    StrBIP := StrBIP+ Copy(StrTemp, 1, Pos('.', StrTemp) - 1) + '.' ;
    Delete(StrTemp, 1, Pos('.', StrTemp));
  end;
  StrBIP := StrBIP + '255';
end;end.