delphi-TTcpServer与TTcpClient

时间:2021-08-01 19:36:54

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

窗体代码