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

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.

————————————————

原文链接：https://blog.csdn.net/qq_38204686/article/details/78235765