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

📄 chatmain.pas

📁 DP协议使用端口号为不同的应用保留其各自的数据传输通道。数据发送一方(可以是客户端或服务器端)将UDP数据报通过源端口发送出去
💻 PAS
字号:
unit Chatmain;

interface

uses
  Classes, QControls, QStdCtrls, QExtCtrls, QButtons, QForms, Sockets;


type
  TForm1 = class(TForm)
    memRecv: TMemo;
    Panel1: TPanel;
    memSend: TMemo;
    Panel2: TPanel;
    btnSend: TButton;
    TcpClient1: TTcpClient;
    TcpServer1: TTcpServer;
    Panel3: TPanel;
    Label3: TLabel;
    edtLocalPort: TEdit;
    btnActivateServer: TButton;
    Label2: TLabel;
    edtRemotePort: TEdit;
    Edit1: TEdit;
    Label7: TLabel;
    Label1: TLabel;
    edtRemoteHost: TEdit;
    procedure btnSendClick(Sender: TObject);
    procedure TcpServer1Accept(sender: TObject;
      ClientSocket: TCustomIpClient);
    procedure btnActivateServerClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  // you must create your own thread to synch
  // writing to a gui component
  TClientDataThread = class(TThread)
  private
  public
    ListBuffer :TStringList;
    TargetList :TStrings;
    procedure synchAddDataToControl;
    constructor Create(CreateSuspended: Boolean);
    procedure Execute; override;
    procedure Terminate;
  end;

var
  Form1: TForm1;
  //DataThread: TClientDataThread;

implementation

{$R *.xfm}

//------------- TClientDataThread impl -----------------------------------------
constructor TClientDataThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := true;
  ListBuffer := TStringList.Create;
end;

procedure TClientDataThread.Terminate;
begin
  ListBuffer.Free;
  inherited;
end;

procedure TClientDataThread.Execute;
begin
  Synchronize(synchAddDataToControl);
end;

procedure TClientDataThread.synchAddDataToControl;
begin
 TargetList.AddStrings(ListBuffer);
end;
//------------- end TClientDataThread impl -------------------------------------


procedure TForm1.btnActivateServerClick(Sender: TObject);
begin
  TcpServer1.LocalPort := edtLocalPort.Text;
  TcpServer1.Active := True;
end;         

procedure TForm1.btnSendClick(Sender: TObject);
var

  s:string;
begin
  TcpClient1.RemoteHost := edtRemoteHost.Text;
  TcpClient1.RemotePort := edtRemotePort.Text;
  try
  s:=edit1.Text+'对我说:  ' ;
  if   memSend.Text='' then
   begin
   memrecv.Lines.Add('***********不能发送空消息!******************    ' ) ;
   exit;
   end;

    if TcpClient1.Connect then

         s:=s+    memSend.Text;
      TcpClient1.Sendln(s);

      memrecv.Lines.Add('I said:' ) ;
      memrecv.Lines.Add(memSend.Text);

       memsend.Clear;


  finally
    TcpClient1.Disconnect;
  end;
end;

procedure TForm1.TcpServer1Accept(sender: TObject;
  ClientSocket: TCustomIpClient);
var
  s: string;
  DataThread: TClientDataThread;
begin

  DataThread:= TClientDataThread.Create(true);

  DataThread.TargetList := memRecv.lines;


  s := ClientSocket.Receiveln;
  while s <> '' do
  begin
    DataThread.ListBuffer.Add(s);
    s := ClientSocket.Receiveln;
  end;

  DataThread.Resume;

end;

end.

⌨️ 快捷键说明

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