delphi-TTcpServer与TTcpClient

最简单的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 =

  Top =

  Width =

  Height =

  Caption = 'FrmMain'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch =

  TextHeight =

  object Button1: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = '创建线程'

    TabOrder =

    OnClick = Button1Click

  end

  object Button2: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = '发送信息'

    TabOrder =

    OnClick = Button2Click

  end

  object Mserver: TMemo

    Left =

    Top =

    Width =

    Height =

    Lines.Strings = (

      'Mserver')

    ScrollBars = ssBoth

    TabOrder =

  end

  object MClient: TMemo

    Left =

    Top =

    Width =

    Height =

    Lines.Strings = (

      'MClient')

    ScrollBars = ssBoth

    TabOrder =

  end

  object Edit1: TEdit

    Left =

    Top =

    Width =

    Height =

    TabOrder =

    Text = 'Edit1'

  end

  object btn1: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = '停止客户端tcp'

    TabOrder =

    OnClick = btn1Click

  end

  object btn2: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = '关闭线程'

    TabOrder =

    OnClick = btn2Click

  end

  object TcpServer1: TTcpServer

    Active = True

    LocalHost = '127.0.0.1'

    LocalPort = ''

    OnAccept = TcpServer1Accept

    Top =

  end

  object TcpClient1: TTcpClient

    Active = True

    RemoteHost = '127.0.0.1'

    RemotePort = ''

    OnReceive = TcpClient1Receive

    Left =

  end

end

窗体代码

巴特西

delphi-TTcpServer与TTcpClient

最新文章

热门文章