⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 u_srv.~pas

📁 通讯聊天 通讯聊天 通讯聊天
💻 ~PAS
字号:
unit U_Srv;

interface

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

type
  TForm1 = class(TForm)
    ServerSocket: TServerSocket;
    btnSend: TButton;
    MemCliLink: TMemo;
    Label1: TLabel;
    MemSendMsg: TMemo;
    MemCliMsg: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    Panel1: TPanel;
    Memo1: TMemo;
    //Button1: TButton;
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure ServerSocketListen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure MemCliLinkChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  SockPool:TList;

implementation

{$R *.dfm}

procedure TForm1.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  SockPool.Add(Socket);
  MemCliLink.Lines.Add('Client Connected:'+Socket.RemoteAddress);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SockPool:=TList.Create;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
  i,len:word;
  msg:string;
  buf:array of char;
begin
   msg:=Trim(MemSendMsg.Text);
   len:=length(msg);
   setlength(buf,len+2); //设置buf长度 //前两个字节存放消息体内容长度
   Move(len, buf[0], 2) ; //把消息体内容长度放入前两个字节
   Move(msg[1], buf[2], len);  //把消息体内容放入包中  从第三个字节开始存放
   if SockPool.Count < 1 then Exit;
   for i:=0 to  SockPool.Count -1 do
   try
     TCustomWinSocket(SockPool[i]).SendBuf(buf[0], len+2);
   except
     TCustomWinSocket(SockPool[i]).Close;
     SockPool.Remove(SockPool[i]);
   end;
end;

procedure TForm1.ServerSocketListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  MemCliLink.Lines.Add('Listen:'+Socket.RemoteAddress);
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  SockPool.Remove(Socket);
end;

procedure TForm1.MemCliLinkChange(Sender: TObject);
begin
//  ShowMessage(ServerSocket1.Socket.);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
Var
  i:Integer;
begin
  For i:=SockPool.Count-1 DownTO 0 do
    SockPool.Delete(i);
  FreeAndNil(SockPool);  
end;

procedure TForm1.ServerSocketClientRead(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);
    //if msg='' then Exit;
    MemCliMsg.Lines.Add(Socket.LocalHost+':'+Msg);
    len :=0;
  except

  end;  
end;
{var
  len:word;
  buf:array of char;
  msg:string;
begin
  try
    msg := Socket.ReceiveText;
    Memo3.Lines.Add(msg);
  except
    //异常处理
  end;
end;}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -