unit UntSrv;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp;

type
  TFrmSrv = class(TForm)
    SrvSocket: TServerSocket;
    gp1: TGroupBox;
    MemClientLink: TMemo;
    gb2: TGroupBox;
    gb3: TGroupBox;
    MemSendMsg: TMemo;
    btnSend: TButton;
    gp4: TGroupBox;
    MemClientMsg: TMemo;
    SrvSocket2: TServerSocket;
    SrvSocket1: TServerSocket;
    procedure SrvSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure SrvSocketListen(Sender: TObject; Socket: TCustomWinSocket);
    procedure SrvSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SrvSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSendClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSrv: TFrmSrv;
  ClientHost:TList;
implementation

{$R *.dfm}
//監聽客戶端
procedure TFrmSrv.SrvSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ClientHost.Add(Socket);
  MemClientLink.Lines.Add(Socket.RemoteHost+':'+Socket.RemoteAddress);
end;

procedure TFrmSrv.FormCreate(Sender: TObject);
begin
  ClientHost:=TList.Create;
  MemClientLink.ReadOnly:=True;
end;
//程序在進行啟動連接時
procedure TFrmSrv.SrvSocketListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  MemClientLink.Lines.Add('Link...'+#13+Socket.RemoteHost+Socket.RemoteAddress);
end;
//接收客戶端信息
procedure TFrmSrv.SrvSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
Var
  Len : Word;
  Buf : Array of Char;
  Msg : String;
begin //當收到一次信息后,還會偵聽一次
  try
    Socket.ReceiveBuf(Len,2); //前兩個字節存放消息體內容長度
    if Len < 1 then Exit;
    SetLength(Buf,Len);
    Socket.ReceiveBuf(Buf[0],len);
    SetLength(Msg, len);
    Move(Buf[0], Msg[1], Len);
    MemClientMsg.Lines.Add(Socket.LocalHost+':'+Msg);
    MemClientMsg.Lines.Add(#13);
  except

  end;
end;
//釋放客戶端
procedure TFrmSrv.SrvSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ClientHost.Remove(Socket);
end;
//關閉窗體
procedure TFrmSrv.FormClose(Sender: TObject; var Action: TCloseAction);
Var
  I : Integer;
begin
  for i := 0 to ClientHost.Count-1 do ClientHost.Delete(i);
  FreeAndNil(ClientHost);
end;

procedure TFrmSrv.btnSendClick(Sender: TObject);
Var
  Len,I : Word;
  Buf : Array of Char;
  Msg : String;
begin
  if ClientHost.Count<=0 then
  begin
    MessageDlg('對不起，當前沒有一臺客戶端程序！',MtWarning,[Mbyes],0);
    Exit;    
  end;

  Msg:=Trim(MemSendMsg.Text);
  Len:=Length(Msg);
  SetLength(Buf,Len+2);   //設置buf長度,前兩個字節存放消息體內容長度
  Move(Len,Buf[0],2);     //把消息體內容長度放入前兩個字節
  Move(Msg[1],Buf[2],Len);//把消息體內容放入包中,從第三個字節開始存放
  for i := 0 to ClientHost.Count-1 do
  begin
    try
      TCustomWinSocket(ClientHost[i]).SendBuf(Buf[0],Len+2);
    except
      TCustomWinSocket(ClientHost[i]).Close;
      ClientHost.Remove(ClientHost[i]);
    end;
  end;
end;

end.