delphi简单的聊天室(UDP广播)

来源:互联网 发布:帝国cms视频管理系统 编辑:程序博客网 时间:2024/05/29 07:05

 点对点的TCP通信 只能俩个人 用了UDP广播发送服务器的IP和端口号 然后客户端获取其IP和端口

unit kehu;interfaceuses  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,  IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient, FMX.StdCtrls, FMX.Edit,  FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, IdTCPConnection,  IdTCPClient,IdGlobal, IdUDPServer, IdSocketHandle;type  TKeHu_Form = class(TForm)    jieshou: TMemo;    fasong: TEdit;    bt: TButton;    IdTCPClient1: TIdTCPClient;    IdUDPServer1: TIdUDPServer;    procedure FormShow(Sender: TObject);    procedure TCP_js;    procedure btClick(Sender: TObject);    procedure IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;      const AData: TIdBytes; ABinding: TIdSocketHandle);  private    { Private declarations }  public    { Public declarations }  end;var  KeHu_Form: TKeHu_Form;implementation{$R *.fmx}procedure TKeHu_Form.btClick(Sender: TObject);var   len : Integer;     buf : array [0..100] of char;     msg : TIdBytes; begin    if not IdTCPClient1.Connected then    begin      if IdTCPClient1.Port = 0 then      begin        ShowMessage('还没有连接上哟!再等待一会儿');      end;    end    //连接上了  发消息 msg    else    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 TKeHu_Form.FormShow(Sender: TObject);begin    //tcp    IdTCPClient1.Port := 0;    //udp    IdUDPServer1.DefaultPort := 11112;    IdUDPServer1.Active := true;end;procedure TKeHu_Form.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;  const AData: TIdBytes; ABinding: TIdSocketHandle);begin    IdTCPClient1.Host := ABinding.PeerIP;    IdTCPClient1.Port := StrToInt(BytesToString(AData));        //接受到了 就 连接 TCP    IdTCPClient1.Connect;    TThread.CreateAnonymousThread(TCP_js).start;    //关闭接受  不这样会卡死 false    TThread.CreateAnonymousThread(    procedure     begin      IdUDPServer1.Active := false;    end    ).Start;end;//TCP  js msgprocedure TKeHu_Form.TCP_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;  end.
unit fuwu;interfaceuses  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,  IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, FMX.StdCtrls, FMX.Edit,  FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, IdCustomTCPServer,  IdTCPServer, IdContext,IdGlobal, IdIPWatch, IdUDPClient;type  TFuWu_form = class(TForm)    jieshou: TMemo;    fasong: TEdit;    bt: TButton;    IdTCPServer1: TIdTCPServer;    IdIPWatch1: TIdIPWatch;    IdUDPClient1: TIdUDPClient;    procedure FormShow(Sender: TObject);    procedure fs;    procedure IdTCPServer1Execute(AContext: TIdContext);    procedure btClick(Sender: TObject);  private    { Private declarations }    kehu : TIdContext;  public    { Public declarations }  end;var  FuWu_form: TFuWu_form;implementation{$R *.fmx}procedure TFuWu_form.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 TFuWu_form.FormShow(Sender: TObject);begin    //设置 UDPserver    IdUDPClient1.BoundIP := IdIPWatch1.LocalIP;    //记得开广播使能 要不然无法发送 广播 true    IdUDPClient1.BroadcastEnabled := true;    IdUDPClient1.Active := true;    TThread.CreateAnonymousThread(fs).Start;    //设置TCPserver    IdTCPServer1.DefaultPort := 11111;    IdTCPServer1.Active := true;    //连接    kehu := nil;end;//一直不停的发送广播 fsprocedure TFuWu_form.fs;begin   while True do   begin      //发送 ip and port      IdUDPClient1.Send('255.255.255.255',11112,'11111');      TThread.Sleep(2000);      //如果连接上了就不需要广播了      if Assigned(kehu) then      begin        break;      end;   end;end;procedure TFuWu_form.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.
总结

1.发广播的时候广播使能要开

2.发送一般用client 接收一般用server 方便