delphi简单的聊天室（两个人）

    点对点的TCP通信 只能俩个人

unit kehu;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Edit,IdGlobal, IdIPWatch, FMX.ScrollBox,
  FMX.Memo;
//一些用到的控件
type
  T客户端 = class(TForm)
    fasong: TEdit;
    bt: TButton;
    IdTCPClient1: TIdTCPClient;
    jieshou: TMemo;
    lianjie: TButton;
    procedure btClick(Sender: TObject);
    procedure lianjieClick(Sender: TObject);
  private
    { Private declarations }
    procedure js;
  public
    { Public declarations }
  end;

var
  客户端: T客户端;

implementation

{$R *.fmx}
//按钮的点击事件  发送消息给服务器
procedure T客户端.btClick(Sender: TObject);
var
   len : Integer;
   buf : array [0..100] of char;
   msg : TIdBytes;
begin
    if not IdTCPClient1.Connected then
    begin
        ShowMessage('无连接 等待服务器回应');
    end;
    if IdTCPClient1.Connected then
    begin
        //长度是两倍  可以发汉字 p
        len := Length(fasong.Text)*2;
        msg := RawToBytes(len,SizeOf(len));
        strcopy(buf, Pchar( fasong.Text));
        msg := msg+ RawToBytes(buf,len);
        IdTCPClient1.IOHandler.Write(msg,SizeOf(len)+len);
        fasong.Text := '';
        jieshou.Text := jieshou.Text + '我：'+ buf + #13#10;
    end;
end;
//一直在接收消息的线程
procedure T客户端.js;
var
  buf : array [0..100] of char;
  len : Integer;
  msg : TIdBytes;
begin
    while True do
    begin
      //清空数组
      //这个线程一直运行  不是像控件的事件一样 新开线程
      //所以buf用过之后需要清空 以防 读取上一次的残留数据 
      fillchar(buf, sizeof(buf), 0);
      //先读取包的长度 len
      IdTCPClient1.IOHandler.ReadBytes(msg,SizeOf(len));
      BytesToRaw(msg,len,SizeOf(len));

      //读取包中的数据 msg
      msg := nil;
      IdTCPClient1.IOHandler.ReadBytes(msg,len);
      //字节转到 buf
      BytesToRaw(msg,buf,len);
      jieshou.Text :=jieshou.Text +'服务器：' + buf + #13#10;
      msg := nil;
    end;
end;
//按钮的点击事件   连接服务器
procedure T客户端.lianjieClick(Sender: TObject);
begin
    //设置目的 ip和 port
    IdTCPClient1.Host := '127.0.0.1';
    IdTCPClient1.Port := 11111;
    TThread.CreateAnonymousThread(
     procedure
     begin
         IdTCPClient1.Connect;
         //创建一个监听数据的线程
         TThread.CreateAnonymousThread(js).start;
         lianjie.Text := '已连接';
     end
    ).start;
end;

end.

unit fuwu;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, FMX.Edit,
  FMX.Controls.Presentation, FMX.StdCtrls, IdContext,IdGlobal, FMX.ScrollBox,
  FMX.Memo;

type
  T服务器 = class(TForm)
    bt: TButton;
    fasong: TEdit;
    IdTCPServer1: TIdTCPServer;
    jieshou: TMemo;
    procedure FormShow(Sender: TObject);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure btClick(Sender: TObject);
  private
    { Private declarations }
    kehu : TIdContext;
  public
    { Public declarations }
  end;

var
  服务器: T服务器;

implementation

{$R *.fmx}
//一个按钮的点击事件 发送消息给客户端  如果多人连接 则发送给最新的客户端
procedure T服务器.btClick(Sender: TObject);
var
   len : Integer;
   buf : array [0..100] of char;
   msg : TIdBytes;
begin
    if kehu = nil then
    begin
      ShowMessage('无人连接');
    end
    else
    begin
        //长度是两倍  可以发汉字 p
        len := Length(fasong.Text)*2;
        msg := RawToBytes(len,SizeOf(len));
        strcopy(buf, Pchar( fasong.Text));
        msg := msg+ RawToBytes(buf,len);
        kehu.Connection.IOHandler.Write(msg,SizeOf(len)+len);
        fasong.Text := '';
        jieshou.Text := jieshou.Text + '我：'+ buf + #13#10;
    end;
end;

procedure T服务器.FormShow(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := 11111;
  IdTCPServer1.Active := true;
end;

//TCPServer 的事件 Execute 接收到客户端的连接和数据的时候会触发
procedure T服务器.IdTCPServer1Execute(AContext: TIdContext);
var
  buf : array [0..100] of char;
  len : Integer;
  msg : TIdBytes;
begin
    //数组的初始值是确定的  里面的值不规律 先清零
    //否则接收到数据  后面的值不为#0 则会多输出一些符号
    fillchar(buf, sizeof(buf), 0);
    kehu := AContext;
    //先读取包的长度 len
    AContext.Connection.IOHandler.ReadBytes(msg,SizeOf(len));
    BytesToRaw(msg,len,SizeOf(len));

    //读取包中的数据 msg
    msg := nil;
    AContext.Connection.IOHandler.ReadBytes(msg,len);
    //字节转到 buf
    BytesToRaw(msg,buf,len);
    jieshou.Text :=jieshou.Text +'客户端：' + buf + #13#10;
end;

end.