Delphi中Indy10的IdTcpClient和IdTcpServer数据通信

羊奶發表於 2021-5-13 17:26:00

Delphi中Indy10的IdTcpClient和IdTcpServer数据通信

---------例子是XE的----
只是本人测试的，仅供学习！代码很乱！
 
在一个程序中测试 IdTcpClient和IdTcpServer有点坑，
测试的时候最好写Client和Server两个程序测试
 
--------------------
 
-------------------------Unit开始
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdContext, StdCtrls, IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,IdGlobal, IdIOHandler, IdIOHandlerStream, IdIntercept, IdIOHandlerSocket, IdIOHandlerStack, ExtCtrls, IdAntiFreezeBase, IdAntiFreeze;
type TMData = record id:Integer; Name:Array of Char; Age:Byte; UpdateTime:double; end; TForm1 = class(TForm) IdTCPServer1: TIdTCPServer; Button1: TButton; Button2: TButton; Button3: TButton; Memo1: TMemo; IdTCPClient1: TIdTCPClient; Button4: TButton; Button5: TButton; Timer1: TTimer; Edit1: TEdit; Button6: TButton; IdAntiFreeze1: TIdAntiFreeze; Edit2: TEdit; procedure Button1Click(Sender: TObject); procedure IdTCPServer1Execute(AContext: TIdContext); procedure FormShow(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure IdTCPServer1Connect(AContext: TIdContext); procedure Button5Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure IdTCPClient1Connected(Sender: TObject); procedure Button6Click(Sender: TObject); private ClientIPList:TList; { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation uses IdSchedulerOfThread; {$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); var SendD: TMData; begin if not IdTCPClient1.Connectedthen IdTCPClient1.Connect; SendD.ID := 10; StrPCopy(SendD.Name,'Delphi 您好'); SendD.age := 18; SendD.UpdateTime := Now; IdTCPClient1.IOHandler.DefStringEncoding:=TEncoding.ASCII;//TEncoding.ASCII;//TEncoding.Unicode; IdTCPClient1.IOHandler.Write(#100); //提前发送一个标识符，用于区分数据 IdTCPClient1.IOHandler.Write(RawToBytes(SendD, SizeOf(SendD)));
end;
procedure TForm1.Button4Click(Sender: TObject); var MyIdTCPConnection:TIdTCPConnection; vIOHandler:TIdIOHandler; vv:TIdContext; begin try //MyIdTCPConnection:=TIdTCPConnection.Create(nil); //vIOHandler:=TIdIOHandler.Create(nil); //MyIdTCPConnection.IOHandler :=vIOHandler; // //ShowMessage(TIdContext(ClientIPList.Items).Connection.Name+','+TIdContext(ClientIPList.Items).binding.peerIp);
 //ShowMessage(IntToStr(TIdTCPConnection(ClientIPList.Items).IOHandler.Port)+',,'+TIdTCPConnection(ClientIPList.Items).IOHandler.Host); //MyIdTCPConnection.IOHandler.Port:=5050; //MyIdTCPConnection.IOHandler.Host:='192.168.1.50'; //MyIdTCPConnection.IOHandler.DefStringEncoding:=TEncoding.ASCII;//TEncoding.ASCII;//TEncoding.Unicode; //MyIdTCPConnection.Socket.Binding.SetPeer('192.168.1.50',5050); //MyIdTCPConnection.Socket.Open ; //MyIdTCPConnection.IOHandler.Open; //MyIdTCPConnection.IOHandler.Write('Qaaam'); //ShowMessage(TIdTCPConnection(ClientIPList.Items)); //TIdContext(ClientIPList.Items).Connection.IOHandler.Write('AAAA'); //TIdTCPConnection(ClientIPList.Items).IOHandler.Write(#10,TIdTextEncoding.ASCII); //TIdTCPConnection(ClientIPList.Items).IOHandler.Writeln('QAAAAN',TIdTextEncoding.ASCII); //---------------------------- //ShowMessage(IntToStr(TIdYarnOfThread(TIdContext(ClientIPList.Items).Yarn).Thread.ThreadID)); //if TIdYarnOfThread(TIdContext(ClientIPList.Items).Yarn).Thread.Suspendedthen //TIdYarnOfThread(TIdContext(ClientIPList.Items).Yarn).Thread.Resume; ////vv:=TIdContext(ClientIPList.Items); //TIdContext(ClientIPList.Items).Connection.IOHandler.CheckForDisconnect(True, True); ////vv.Connection.IOHandler.DefStringEncoding := TIdTextEncoding.ASCII; //TIdContext(ClientIPList.Items).Connection.IOHandler.Write('QAAAAN',TIdTextEncoding.ASCII); ////ifvv.Connection.IOHandler.Openedthen ////ShowMessage('已连接'); ////vv.Connection.Socket.Write('200: 数据接收成功！'); //啊啊啊啊啊啊啊啊，气死人了！测试了这么多，以为代码有问题！！！！在同一个进程中这玩意有问题， //建立客户端服务器两个程序的时候，这样的代码可以！妈耶！不知道什么情况！！！ vv:=TIdContext(IdTCPServer1.Contexts.LockList.Items); vv.Connection.IOHandler.Write('QAAAAN');
 //------------------------------ //TIdTCPConnection(ClientIPList.Items).SendCmd('888') ; finally //FreeAndNil(MyIdTCPConnection); //FreeAndNil(vIOHandler); IdTCPServer1.Contexts.UnlockList; end; end;
procedure TForm1.Button5Click(Sender: TObject); begin Timer1.Enabled:=not Timer1.Enabled ; if Timer1.Enabled then Button5.Caption:='不显示' else Button5.Caption:='显示'; //ShowMessage(IdTCPClient1.Intercept.ReadString(IdTCPClient1.IOHandler.InputBuffer.Size,TIdTextEncoding.UTF8 )); //ShowMessage(IdTCPClient1.IOHandler.ReadString(IdTCPClient1.IOHandler.InputBuffer.Size,) ); end;
procedure TForm1.Button6Click(Sender: TObject); begin //IdTCPClient1.IOHandler.Write(#10); if not IdTCPClient1.Connectedthen IdTCPClient1.Connect; IdTCPClient1.IOHandler.DefStringEncoding:=TEncoding.ASCII;//TEncoding.ASCII;//TEncoding.Unicode; //IdTCPClient1.IOHandler.Write(#0); //提前发送一个标识符，用于区分数据 IdTCPClient1.IOHandler.Write('BAAAAC',TIdTextEncoding.ASCII); end;
procedure TForm1.FormDestroy(Sender: TObject); begin FreeAndNil(ClientIPList); end;
procedure TForm1.FormShow(Sender: TObject); begin ClientIPList:=TList.Create; IdTCPServer1.Active:=True;
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject); begin //ShowMessage('连接客户端'); end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext); begin
if Length(AContext.Binding.PeerIP)>5 then//AContext.Connection.Socket.Binding.PeerIP; ClientIPList.Add(AContext); //TIdYarnOfThread(acontext.Yarn).Thread.ThreadID;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); var RData:TMData; buf:TIdBytes; sCmd:Char; sList:TStrings; I:Integer; ListCount:Integer; ss:string; begin //ACONTEXT.Connection.IOHandler.WriteLn('Recive Message!'); //AContext.Connection {sCmd := AContext.Connection.IOHandler.ReadChar;//先读取Char结构数据 if sCmd = #100 then//接收结构体 begin AContext.Connection.IOHandler.ReadBytes(buf,SizeOf(RData)); BytesToRaw(buf, RData, SizeOf(RData)); with Memo1.lines do begin Add('IP:'+AContext.Connection.Socket.Binding.PeerIP); Add('ID:'+Inttostr(RData.Id)); Add('Name:'+StrPas(RData.Name)); Add('Age:'+Inttostr(RData.age)); Add('UpdateTime:'+DateTimeToStr(RData.UpdateTime)); end; end //TCPClient.IOHandler.DefStringEncoding:=TEncoding.ASCII; else } //sCmd := AContext.Connection.IOHandler.ReadChar ; ss:=AContext.Connection.IOHandler.Readstring(AContext.Connection.IOHandler.InputBuffer.Size,TIdTextEncoding.ASCII ); if ss<>'' then begin Memo1.Lines.Add(ss); //AContext.Connection.IOHandler.InputBuffer.Size, AContext.Connection.IOHandler.Write('88888888888',TIdTextEncoding.ASCII ); end;
 end;
procedure TForm1.Timer1Timer(Sender: TObject); var ss:string; begin ss:=IdTCPClient1.IOHandler.ReadString(IdTCPClient1.IOHandler.InputBuffer.Size); Edit2.Text:=ss; if ss<>'' then Edit1.Text:=ss
 //IdTCPClient1.IOHandler.InputBuffer.Clear; end;
end.
-------------------------------------- Delphi XE IdTCPClient1 和 IdTCPServer1 数据的发送与接收（indy10）_136.lahttps://www.136.la/shida/show-131002.html -------------------------------------------------------------------------------------
1、IdTCPClient1 端发送数据
1.1 发送结构体：
//定义结构体 TMData = record id:Integer; Name:Array of Char; Age:Byte; UpdateTime:double; end;
//发送 procedure TForm2.Button2Click(Sender: TObject); var SendD: TMData; begin SendD.ID := 10; StrPCopy(SendD.Name, ‘Delphi 您好‘); SendData.age := 18; SendD.UpdateTime := Now; IdTCPClient1.IOHandler.Write(#100); //提前发送一个标识符，用于区分数据 IdTCPClient1.IOHandler.Write(RawToBytes(SendD, SizeOf(SendD))); end; 1.2 发送TStrings类型
procedure TForm2.Button3Click(Sender: TObject); var sList:TStrings; I:Integer; begin sList := TStringList.Create; for I :=0to 50 do begin sList.Add(‘数据Test‘ + IntToStr(i)); end; IdTCPClient1.IOHandler.Write(#200);　　 IdTCPClient1.IOHandler.Write(sList.Count); IdTCPClient1.IOHandler.Write(ToBytes(sList.Text,TIdTextEncoding.UTF8)); end; 1.3 发送一行字符串数据
procedure TForm2.Button4Click(Sender: TObject); begin IdTCPClient1.IOHandler.Write(#10); IdTCPClient1.IOHandler.Write(‘Delphi测试‘,TIdTextEncoding.UTF8); end; 　　
2、IdTCPServer端接收数据：
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); var RData:TMData; buf:TIdBytes; sCmd:Char; sList:TStrings; I:Integer; ListCount:Integer; begin sCmd := AContext.Connection.IOHandler.ReadChar;//先读取Char结构数据 if sCmd = #100 then//接收结构体 begin AContext.Connection.IOHandler.ReadBytes(buf,SizeOf(RData)); BytesToRaw(buf, RData, SizeOf(RData)); with Memo1.lines do begin Add(‘ID:‘+Inttostr(RData.Id)); Add(‘Name:‘+StrPas(RData.Name)); Add(‘Age:‘+Inttostr(ReadData.age)); Add(‘UpdateTime:‘+DateTimeToStr(RData.UpdateTime)); end; end else if sCmd = #200 then//接收 TStrings begin ListCount := AContext.Connection.IOHandler.ReadLongInt;//ReadLongInt sList := TStringList.Create; try AContext.Connection.IOHandler.ReadStrings(sList,ListCount,TIdTextEncoding.UTF8); for I :=0to sList.Count-1 dobegin Memo1.Lines.Add(sList.Strings); end; finally sList.Free; end; end else if sCmd = #10 then begin Memo1.Lines.Add(AContext.Connection.IOHandler.ReadString(AContext.Connection.IOHandler.InputBuffer.Size,TIdTextEncoding.UTF8) ); end else AContext.Connection.IOHandler.InputBuffer.Clear;　　//清除 end;
 
--------------------------Unit结束
 
----------------Form开始
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 383 ClientWidth = 870 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnDestroy = FormDestroy OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 32 Top = 272 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 184 Top = 296 Width = 75 Height = 25 Caption = 'Button2' TabOrder = 1 end object Button3: TButton Left = 312 Top = 296 Width = 75 Height = 25 Caption = 'Button3' TabOrder = 2 end object Memo1: TMemo Left = 536 Top = 8 Width = 313 Height = 313 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 Lines.Strings = ( 'Memo1') TabOrder = 3 end object Button4: TButton Left = 536 Top = 350 Width = 75 Height = 25 Caption = 'Button4' TabOrder = 4 OnClick = Button4Click end object Button5: TButton Left = 288 Top = 350 Width = 75 Height = 25 Caption = 'Button5' TabOrder = 5 OnClick = Button5Click end object Edit1: TEdit Left = 184 Top = 328 Width = 321 Height = 21 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 TabOrder = 6 Text = 'Edit1' end object Button6: TButton Left = 32 Top = 304 Width = 75 Height = 25 Caption = 'Button6' TabOrder = 7 OnClick = Button6Click end object Edit2: TEdit Left = 369 Top = 354 Width = 96 Height = 21 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 TabOrder = 8 Text = 'Edit1' end object IdTCPServer1: TIdTCPServer Bindings = < item IP = '192.168.1.50' Port = 5050 end> DefaultPort = 0 OnConnect = IdTCPServer1Connect OnExecute = IdTCPServer1Execute Left = 288 Top = 48 end object IdTCPClient1: TIdTCPClient OnConnected = IdTCPClient1Connected ConnectTimeout = 1000 Host = '192.168.1.50' IPVersion = Id_IPv4 Port = 5050 ReadTimeout = 2000 Left = 104 Top = 40 end object Timer1: TTimer Enabled = False Interval = 100 OnTimer = Timer1Timer Left = 248 Top = 352 end object IdAntiFreeze1: TIdAntiFreeze Left = 88 Top = 104 end end
 
------------------Form结束
-----------------------------------------------------------------------杂七杂八的小笔记------开始----------
-1----杂七杂八----开始
<div class="cnblogs_code"><img id="code_img_closed_b6762386-e452-49ad-9283-76012ed3c177" class="code_img_closed lazyload" data-src="http://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif"><img id="code_img_opened_b6762386-e452-49ad-9283-76012ed3c177" class="code_img_opened lazyload" style="display: none" data-src="http://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif">
<div id="cnblogs_code_open_b6762386-e452-49ad-9283-76012ed3c177" class="cnblogs_code_hide">
<pre> 1 unit Unit1;
 2
 3 interface
 4
 5 uses
 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7 Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls,
 8 StdCtrls;
 9
10 type
11 TFrmMainFiasSimulate = class(TForm)
12 IdTCP_Issue: TIdTCPClient;
13 IdTCP_PMS: TIdTCPClient;
14 Panel_Issue: TPanel;
15 Panel_PMS: TPanel;
16 GroupBox1: TGroupBox;
17 Memo1: TMemo;
18 Edit_IssueMessage: TEdit;
19 Button_SendMessage: TButton;
20 Edit_IssueIP: TEdit;
21 Edit_IssuePort: TEdit;
22 GroupBox2: TGroupBox;
23 Memo2: TMemo;
24 Edit2: TEdit;
25 Button1: TButton;
26 Edit_PMSIP: TEdit;
27 Edit_PMSPort: TEdit;
28 Button_Connect: TButton;
29 Button_DisConnect: TButton;
30 Timer_Issue: TTimer;
31 procedure Button_ConnectClick(Sender: TObject);
32 procedure Button_DisConnectClick(Sender: TObject);
33 procedure Button_SendMessageClick(Sender: TObject);
34 procedure Timer_IssueTimer(Sender: TObject);
35 private
36 { Private declarations }
37 public
38 { Public declarations }
39 end;
40
41 var
42 FrmMainFiasSimulate: TFrmMainFiasSimulate;
43
44 implementation
45
46 {$R *.dfm}
47
48 procedure TFrmMainFiasSimulate.Button_ConnectClick(Sender: TObject);
49 begin
50 IdTCP_Issue.Host:=Edit_IssueIP.Text;
51 IdTCP_Issue.Port:=StrToInt(Edit_IssuePort.Text);
52 IdTCP_Issue.Connect;
53 IdTCP_Issue.IOHandler.DefStringEncoding:=TEncoding.Unicode;//TEncoding.ASCII
54 end;
55
56 procedure TFrmMainFiasSimulate.Button_DisConnectClick(Sender: TObject);
57 begin
58 //IdTCP_Issue.Socket.Close;//IdTCP_Issue.Socket.InputBuffer.Clear;
59 IdTCP_Issue.DisConnect;
60 IdTCP_Issue.Socket.InputBuffer.Clear;//IdTCP_Issue.Socket.Close;
61 //IdTCP_Issue.Socket.CheckForDataOnSource()
62 end;
63
64 procedure TFrmMainFiasSimulate.Button_SendMessageClick(Sender: TObject);
65 begin
66 IdTCP_Issue.IOHandler.DefStringEncoding:=TEncoding.Unicode;//TEncoding.ASCII;//TEncoding.Unicode;
67 //IdTCP_Issue.IOHandler.Write(#1);
68 IdTCP_Issue.IOHandler.Write(Edit_IssueMessage.Text );
69 end;
70
71 procedure TFrmMainFiasSimulate.Timer_IssueTimer(Sender: TObject);
72 var
73 vs:string;
74 begin
75 try
76 if not IdTCP_Issue.Connectedthen
77 Exit;
78 vs:=IdTCP_Issue.IOHandler.ReadString(IdTCP_Issue.IOHandler.InputBuffer.Size ,TEncoding.Unicode);//有中文还是用 TEncoding.Unicode
79 //vs:=IdTCP_Issue.IOHandler.ReadString(IdTCP_Issue.IOHandler.InputBuffer.Size ,TEncoding.ASCII);
80 if vs<>'' then
81 Memo1.Lines.Add(vs) ;
82 except
83 //IdTCP_Issue.Socket.Close;
84 try
85 IdTCP_Issue.DisConnect;
86 IdTCP_Issue.Socket.InputBuffer.Clear ; //IdTCP_Issue.Socket.Close这里这么写不行
87 IdTCP_Issue.Connect;
88 except
89
90 end;
91
92 end;
93
94
95 end;
96
97 end.</pre>
</div>
View Code</div>
-1----杂七杂八----结束
--2----杂七杂八----开始
<div class="cnblogs_code"><img id="code_img_closed_2490beb8-ed6d-424e-a7fe-0ffeb8f8a2ff" class="code_img_closed lazyload" data-src="http://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif"><img id="code_img_opened_2490beb8-ed6d-424e-a7fe-0ffeb8f8a2ff" class="code_img_opened lazyload" style="display: none" data-src="http://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif">
<div id="cnblogs_code_open_2490beb8-ed6d-424e-a7fe-0ffeb8f8a2ff" class="cnblogs_code_hide">
<pre> 1 unit Unit1;
 2
 3 interface
 4
 5 uses
 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7 Dialogs, IdContext, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
 8 IdTCPServer;
 9
10 type
11 TFrmMainIssueCard = class(TForm)
12 IdTCPServer1: TIdTCPServer;
13 Memo1: TMemo;
14 Button1_StartService: TButton;
15 Button2_Stop: TButton;
16 Edit_IP: TEdit;
17 Edit_Port: TEdit;
18 procedure IdTCPServer1Execute(AContext: TIdContext);
19 procedure IdTCPServer1Connect(AContext: TIdContext);
20 procedure FormShow(Sender: TObject);
21 procedure Button1_StartServiceClick(Sender: TObject);
22 procedure Button2_StopClick(Sender: TObject);
23 private
24 { Private declarations }
25 public
26 { Public declarations }
27 end;
28
29 var
30 FrmMainIssueCard: TFrmMainIssueCard;
31
32 implementation
33
34 uses
35 IdGlobal,IdSocketHandle;
36
37 {$R *.dfm}
38
39 procedure TFrmMainIssueCard.Button1_StartServiceClick(Sender: TObject);
40 var
41 vIdSocket:TIdSocketHandle;
42 begin
43 IdTCPServer1.Bindings.Clear;
44 vIdSocket:=IdTCPServer1.Bindings.Add;
45 //vIdSocket.IP:=Edit_IP.Text;
46 vIdSocket.Port:=StrToInt(Edit_Port.Text);
47 IdTCPServer1.Active:=True;
48 end;
49
50 procedure TFrmMainIssueCard.Button2_StopClick(Sender: TObject);
51 begin
52 IdTCPServer1.Active:=False;
53 end;
54
55 procedure TFrmMainIssueCard.FormShow(Sender: TObject);
56 begin
57 Memo1.Lines.Clear;
58 end;
59
60 procedure TFrmMainIssueCard.IdTCPServer1Connect(AContext: TIdContext);
61 begin
62 if Length(AContext.Binding.PeerIP)>5 then//AContext.Connection.Socket.Binding.PeerIP;
63 begin
64 AContext.Connection.IOHandler.DefStringEncoding:=TIdTextEncoding.Unicode;
65 Memo1.Lines.Add('用户连接IP：'+AContext.Binding.PeerIP);
66 AContext.Binding.Send('连接成功！',TIdTextEncoding.Unicode); //TIdTextEncoding.ASCII
67 end;
68
69 end;
70
71 procedure TFrmMainIssueCard.IdTCPServer1Execute(AContext: TIdContext);
72 var
73 sCmd:Char;
74 vs:string;
75 begin
76 //sCmd := AContext.Connection.IOHandler.ReadChar; //先读取Char结构数据
77 //if sCmd =#1 then
78
79 begin
80 vs:=AContext.Connection.IOHandler.Readstring(AContext.Connection.IOHandler.InputBuffer.Size,TIdTextEncoding.Unicode ); //TIdTextEncoding.Unicode
81 if vs<>'' then
82 begin
83 Memo1.Lines.Add(AContext.Connection.Socket.Binding.PeerIP+'-----此次会话开始--------');
84 Memo1.Lines.Add(vs); //AContext.Connection.IOHandler.InputBuffer.Size,
85 AContext.Connection.IOHandler.Write('您的消息服务器接收成功！',TIdTextEncoding.Unicode );
86 Memo1.Lines.Add(AContext.Connection.Socket.Binding.PeerIP+'-----此次会话结束--------');
87 end;
88 end;
89
90 end;
91
92 end.</pre>
</div>
View Code</div>
 
--2----杂七杂八----结束
 
 
-----------------------------------------------------------------------杂七杂八的小笔记------结束----------
  
来源：https://www.cnblogs.com/dmqhjp/p/14765447.html

頁: [1]

琼殿技术论坛's Archiver

Delphi中Indy10的IdTcpClient和IdTcpServer数据通信