delphi-TTcpServer与TTcpClient

原作者: [db:作者] 来自: [db:来源] 收藏邀请

最简单的TTcpServer与TTcpClient通信实例-Delphi_海盗船长_新浪博客
http://blog.sina.com.cn/s/blog_5383794d0100nt9u.html

delphi TTcpClient TTcpServer分析 - 沧海一粟 - 博客频道 - CSDN.NET
http://blog.csdn.net/andrew57/article/details/8767308

用TTcpClient和TTcpServer进行文件的传输 - 好记性不如烂笔头 - 博客频道 - CSDN.NET
http://blog.csdn.net/onebigday/article/details/5425028

再说“用TTcpClient和TTcpServer进行文件的传输” - 好记性不如烂笔头 - 博客频道 - CSDN.NET
http://blog.csdn.net/onebigday/article/details/5612612

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdTCPConnection, IdTCPClient, Sockets, IdTCPServer, IdUDPServer, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient, StdCtrls;

type
  TFrmMain = class(TForm)
    TcpServer1: TTcpServer;
    TcpClient1: TTcpClient;
    Button1: TButton;
    Button2: TButton;
    Mserver: TMemo;
    MClient: TMemo;
    Edit1: TEdit;
    btn1: TButton;
    btn2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
    procedure btn1Click(Sender: TObject);
    procedure TcpClient1Receive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
    procedure btn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  
  //这个类实现TTcpClient接收TTcpserver回复的消息
  TClientReceiveThread = class(TThread)
    procedure Execute; override;
  end;

var
  FrmMain: TFrmMain;
  ClientReceiveThread: TClientReceiveThread;

implementation

{$R *.dfm}
procedure TClientReceiveThread.Execute;
begin
  with FrmMain do
  begin
    while TcpClient1.Connected do  //死循环!必须的!!!
      if not Terminated then
        MClient.Lines.Add(TcpClient1.Receiveln) //一条条读进来
       // TcpClient1.Receiveln
      else
        Break;
  end;
end;
procedure TFrmMain.Button1Click(Sender: TObject);
begin
  //连接服务器,如果成功创建客户端接收线程
  if TcpClient1.Connect and (not Assigned(ClientReceiveThread)) then
    ClientReceiveThread := TClientReceiveThread.Create(false);
end;

procedure TFrmMain.Button2Click(Sender: TObject);
begin
  TcpClient1.Sendln(Edit1.Text);
end;

//TcpServer1的OnAccept事件
procedure TFrmMain.TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
var
  s1, s2: string;
begin
  while ClientSocket.connected do  //死循环!必须的!!!    此函数貌似只触发一次，连接时
  begin
    s1 := ClientSocket.Receiveln;  //收  如果没有值不会返回来，相当于停在这里了； 阻塞
    MServer.Lines.Add('收到客户端的  ' + s1);
    //s2 := DateTimeToStr(Now);
    if ClientSocket.connected then
      ClientSocket.Sendln(DateTimeToStr(Now) + '服务端已经收到  ' + s1);  //发
    //Application.ProcessMessages; 此处没有必要
  end;
end;

procedure TFrmMain.btn1Click(Sender: TObject);
begin
  TcpClient1.Disconnect;
end;

procedure TFrmMain.TcpClient1Receive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer); //只有调用读操作时才会触发此函数
begin
   // MClient.Lines.Add('fdafdfda');
  //MClient.Lines.
  // MClient.Lines.Add(Buf);
   //MClient.SetTextBuf(Buf);
   //MClient.Lines.SetText(Buf);
   //MClient.GetTextBuf(Buf,DataLen);
end;

procedure TFrmMain.btn2Click(Sender: TObject);
begin
  ClientReceiveThread.Terminate;
end;

end.

object FrmMain: TFrmMain
  Left = 192
  Top = 131
  Width = 842
  Height = 480
  Caption = 'FrmMain'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 8
    Top = 56
    Width = 75
    Height = 25
    Caption = '创建线程'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 8
    Top = 96
    Width = 75
    Height = 25
    Caption = '发送信息'
    TabOrder = 1
    OnClick = Button2Click
  end
  object Mserver: TMemo
    Left = 16
    Top = 160
    Width = 385
    Height = 265
    Lines.Strings = (
      'Mserver')
    ScrollBars = ssBoth
    TabOrder = 2
  end
  object MClient: TMemo
    Left = 408
    Top = 160
    Width = 401
    Height = 273
    Lines.Strings = (
      'MClient')
    ScrollBars = ssBoth
    TabOrder = 3
  end
  object Edit1: TEdit
    Left = 96
    Top = 96
    Width = 169
    Height = 29
    TabOrder = 4
    Text = 'Edit1'
  end
  object btn1: TButton
    Left = 440
    Top = 88
    Width = 145
    Height = 25
    Caption = '停止客户端tcp'
    TabOrder = 5
    OnClick = btn1Click
  end
  object btn2: TButton
    Left = 440
    Top = 56
    Width = 145
    Height = 25
    Caption = '关闭线程'
    TabOrder = 6
    OnClick = btn2Click
  end
  object TcpServer1: TTcpServer
    Active = True
    LocalHost = '127.0.0.1'
    LocalPort = '2011'
    OnAccept = TcpServer1Accept
    Top = 8
  end
  object TcpClient1: TTcpClient
    Active = True
    RemoteHost = '127.0.0.1'
    RemotePort = '2011'
    OnReceive = TcpClient1Receive
    Left = 88
  end
end