delphi之IOCP学习（一）
2024-08-31 19:59:20
困扰已久的网络通信（IOCP：完成端口），今天终于揭开她的神秘面纱了，之前百度N久还是未能理解IOCP，网络上好多博文都没有贴出源码，初学者很难正在理解IOCP并自己写出通信例子 ，经过努力，今天自己终于做出了简单的测试程序，下面贴出源码，水平有限，难免有错，希望不要误人子弟。
1、Svr主窗体
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
unit Umain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, UIOCPSvr;type TForm1 = class(TForm) Button1: TButton; mmoRev: TMemo; procedure Button1Click(Sender: TObject); private IOCPSvr: TIOCPSvr; { Private declarations } public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);begin IOCPSvr := TIOCPSvr.Create(Self); IOCPSvr.Host := '192.168.1.86'; IOCPSvr.Port := 8988; IOCPSvr.open;end;end. |
2、IOCP 服务端实现代码
1 unit UIOCPSvr;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, JwaWinsock2;
8
9 const
10 DATA_BUFSIZE = 1024;
11
12 type
13 LPVOID = Pointer;
14 {* 完成端口操作定义 *}
15 TIocpOperate = (ioNone, ioCon, ioRead, ioWrite, ioStream, ioExit);
16 PIocpRecord = ^TIocpRecord;
17 TIocpRecord = record
18 Overlapped: TOverlapped; //完成端口重叠结构
19 WsaBuf: TWsaBuf; //完成端口的缓冲区定义
20 IocpOperate: TIOCPOperate; //当前操作类型
21 end;
22
23 type
24 TThreadRev = class(TThread)
25 private
26 pData: Pointer;
27 protected
28 procedure Execute; override;
29 public
30 constructor Create(CreateSuspended: Boolean; adata: Pointer);
31 destructor Destroy; override;
32 end;
33
34
35 TThreadCon = class(TThread)
36 private
37 PSocket: TSocket;
38 lvIOPort: THandle;
39 protected
40 procedure Execute; override;
41 public
42 constructor Create(CreateSuspended: Boolean; var aSocket: TSocket; var aIOport: THandle);
43 destructor Destroy; override;
44 end;
45
46
47 TIOCPSvr = class(TComponent)
48 private
49 FHost: string;
50 FPort: Integer;
51 ThreadCon: TThreadCon;
52 ThreadRev: TThreadRev;
53 protected
54 public
55 constructor Create(AOwner: TComponent); override;
56 destructor Destroy; override;
57 procedure open;
58 published
59 property Port: Integer read FPort write FPort;
60 property Host: string read FHost write FHost;
61 end;
62
63
64 procedure SendData(astr: string; FSocket: TSocket); //发生数据
65 function PIocpAllocate(ALen: Cardinal): PIocpRecord; //分配内存
66 procedure PIocpRelease(var AValue: PIocpRecord); //释放内存
67
68 implementation
69
70 uses Umain;
71
72 function PIocpAllocate(ALen: Cardinal): PIocpRecord;
73 begin
74 New(Result);
75 Result.Overlapped.Internal := 0;
76 Result.Overlapped.InternalHigh := 0;
77 Result.Overlapped.Offset := 0;
78 Result.Overlapped.OffsetHigh := 0;
79 Result.Overlapped.hEvent := 0;
80 Result.IocpOperate := ioNone;
81 Result.WsaBuf.buf := GetMemory(ALen);
82 Result.WsaBuf.len := ALen;
83 end;
84
85
86 procedure PIocpRelease(var AValue: PIocpRecord);
87 begin
88 FreeMemory(AValue.WsaBuf.buf);
89 AValue.WsaBuf.buf := nil;
90 Dispose(AValue);
91 end;
92
93
94 procedure SendData(astr: string; FSocket: TSocket);
95 var
96 IocpRec: PIocpRecord;
97 iErrCode: Integer;
98 dSend, dFlag: DWORD;
99 FOutputBuf: TMemoryStream;
100 begin
101
102 FOutputBuf := TMemoryStream.Create;
103 FOutputBuf.WriteBuffer(astr[1], Length(astr));
104
105 New(IocpRec);
106 IocpRec.Overlapped.Internal := 0;
107 IocpRec.Overlapped.InternalHigh := 0;
108 IocpRec.Overlapped.Offset := 0;
109 IocpRec.Overlapped.OffsetHigh := 0;
110 IocpRec.Overlapped.hEvent := 0;
111 IocpRec.WsaBuf.buf := GetMemory(Length(astr));
112 IocpRec.WsaBuf.len := Length(astr);
113
114 IocpRec.IocpOperate := ioWrite;
115 System.Move(PAnsiChar(FOutputBuf.Memory)[0], IocpRec.WsaBuf.buf^, FOutputBuf.Size);
116 dFlag := 0;
117 if WSASend(FSocket, @IocpRec.WsaBuf, 1, dSend, dFlag, @IocpRec.Overlapped, nil) = SOCKET_ERROR then
118 begin
119 iErrCode := WSAGetLastError;
120 if iErrCode <> ERROR_IO_PENDING then
121 begin
122 // FIocpServer.DoError('WSASend', GetLastWsaErrorStr);
123 //ProcessNetError(iErrCode);
124 end;
125 end;
126 FreeAndNil(FOutputBuf);
127 end;
128
129
130 { TIOCPSvr }
131
132 constructor TIOCPSvr.Create(AOwner: TComponent);
133 begin
134 inherited;
135
136 end;
137
138 destructor TIOCPSvr.Destroy;
139 begin
140 ThreadCon.Terminate;
141 if ThreadCon.Suspended then
142 ThreadCon.Resume;
143
144 FreeAndNil(ThreadCon);
145 inherited;
146 end;
147
148 procedure TIOCPSvr.open;
149 var
150 WSData: TWSAData;
151 lvIOPort: THandle;
152 lvAddr: TSockAddr;
153 sSocket: TSocket;
154 begin
155
156 //加载初始化SOCKET。使用的是2.2版为了后面方便加入心跳。
157 WSAStartup($0202, WSData);
158
159 // 创建一个完成端口（内核对象），新建一个IOCP
160 lvIOPort := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
161
162 //创建一个工作线程，调试用
163 ThreadRev := TThreadRev.Create(False, Pointer(lvIOPort));
164
165 //创建一个套接字，将此套接字和一个端口绑定并监听此端口。
166 sSocket := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
167 if sSocket = SOCKET_ERROR then
168 begin
169 closesocket(sSocket);
170 WSACleanup();
171 end;
172 lvAddr.sin_family := AF_INET;
173 lvAddr.sin_port := htons(Port);
174 lvAddr.sin_addr.s_addr := htonl(INADDR_ANY);
175 if bind(sSocket, @lvAddr, sizeof(lvAddr)) = SOCKET_ERROR then
176 begin
177 closesocket(sSocket);
178 end;
179 listen(sSocket, 20);
180
181 //连接线程，当有客户端请求建立连接在该现场中处理
182 ThreadCon := TThreadCon.Create(False, sSocket, lvIOPort);
183
184 //下面循环进行循环获取客户端的请求。这注释部分放到 ThreadCon线程中处理了
185 // while (TRUE) do
186 // begin
187 // //当客户端有连接请求的时候，WSAAccept函数会新创建一个套接字cSocket。这个套接字就是和客户端通信的时候使用的套接字。
188 // cSocket := WSAAccept(sSocket, nil, nil, nil, 0);
189 //
190 // //判断cSocket套接字创建是否成功，如果不成功则退出。
191 // if (cSocket = SOCKET_ERROR) then
192 // begin
193 // closesocket(sSocket);
194 // exit;
195 // end;
196 //
197 // //将套接字、完成端口绑定在一起。
198 // lvPerIOPort := CreateIoCompletionPort(cSocket, lvIOPort, cSocket, 0);
199 // if (lvPerIOPort = 0) then
200 // begin
201 // Exit;
202 // end;
203 //
204 // //初始化数据包
205 // PerIoData := PIocpAllocate(DATA_BUFSIZE);
206 // PerIoData.IocpOperate := ioCon;
207 // //通知工作线程,有新的套接字连接<第三个参数>
208 // PostQueuedCompletionStatus(lvIOPort, 0, cSocket, POverlapped(PerIOData));
209 // end;
210
211 end;
212
213
214
215 { TThreadCon }
216
217 constructor TThreadCon.Create(CreateSuspended: Boolean; var aSocket: TSocket; var aIOport: THandle);
218 begin
219 inherited create(CreateSuspended);
220 PSocket := aSocket;
221 lvIOPort := aIOport;
222 end;
223
224 destructor TThreadCon.Destroy;
225 begin
226
227 inherited;
228 end;
229
230 procedure TThreadCon.Execute;
231 var
232 cSocket: TSocket;
233 lvPerIOPort: Integer;
234 PerIoData: PIocpRecord;
235 begin
236 inherited;
237 while not Terminated do
238 begin
239
240 //当客户端有连接请求的时候，WSAAccept函数会新创建一个套接字cSocket。这个套接字就是和客户端通信的时候使用的套接字。
241 cSocket := WSAAccept(PSocket, nil, nil, nil, 0);
242
243 //判断cSocket套接字创建是否成功，如果不成功则退出。
244 if (cSocket = SOCKET_ERROR) then
245 begin
246 closesocket(PSocket);
247 exit;
248 end;
249
250 //将套接字、完成端口绑定在一起。
251 lvPerIOPort := CreateIoCompletionPort(cSocket, lvIOPort, cSocket, 0);
252 if (lvPerIOPort = 0) then
253 begin
254 Exit;
255 end;
256
257 //初始化数据包
258 PerIoData := PIocpAllocate(DATA_BUFSIZE);
259 PerIoData.IocpOperate := ioCon;
260 //通知工作线程,有新的套接字连接<第三个参数>
261 PostQueuedCompletionStatus(lvIOPort, 0, cSocket, POverlapped(PerIOData));
262 end;
263
264 end;
265
266 { TThreadRev }
267
268 constructor TThreadRev.Create(CreateSuspended: Boolean; adata: Pointer);
269 begin
270 inherited Create(CreateSuspended);
271 pData := adata;
272 end;
273
274 destructor TThreadRev.Destroy;
275 begin
276
277 inherited;
278 end;
279
280 procedure TThreadRev.Execute;
281 var
282 CompletionPort: THANDLE;
283 BytesTransferred: Cardinal;
284 PerIoData: PIocpRecord;
285 cSocket: TSocket;
286 Flags: Cardinal;
287 lvResultStatus: BOOL;
288 temp: string;
289 begin
290 inherited;
291 CompletionPort := THandle(pData);
292
293 //得到创建线程是传递过来的IOCP
294 while not Terminated do
295 begin
296 //工作者线程会停止到GetQueuedCompletionStatus函数处，直到接受到数据为止
297 lvResultStatus := GetQueuedCompletionStatus(CompletionPort, BytesTransferred, cSocket, POverlapped(PerIoData), INFINITE);
298
299 {//CompletionPort：新建IOCP CreateIoCompletionPort()函数返回的端口 // BytesTransferred 收到数据的长度
300 // cSocket 个人理解就是通信sock句柄 //PerIoData 数据结构
301 //INFINITE 超时时间，这里是一直等待的意思，GetQueuedCompletionStatus 可以参考百度百科}
302
303 if (lvResultStatus = False) then
304 begin
305 //当客户端连接断开或者客户端调用closesocket函数的时候,函数GetQueuedCompletionStatus会返回错误。如果我们加入心跳后，在这里就可以来判断套接字是否依然在连接。
306 if cSocket <> 0 then
307 begin
308 closesocket(cSocket);
309 end;
310 if PerIoData <> nil then
311 begin
312 PIocpRelease(PerIoData);
313 end;
314 continue;
315 end;
316
317 if PerIoData = nil then
318 begin
319 closesocket(cSocket);
320 Break;
321 end
322 else if (PerIoData <> nil) then
323 begin
324
325 if PerIoData.IocpOperate = ioCon then //连接请求
326 begin
327
328 PIocpRelease(PerIoData);
329 end
330 else if PerIoData.IocpOperate = ioRead then
331 begin
332 ////可以在这里处理数据……
333 temp:= Copy(string(PerIoData.WsaBuf.buf),1,BytesTransferred); //获取接收到的数据 这里只处理了字符串
334 Form1.mmoRev.Lines.Add(format('收到客户端:%d 消息:%s',[cSocket,temp]));
335 // temp := 'hello world !' + #13#10; //indy TCP 需要#13#10 才能收到信息
336 SendData(temp, cSocket); //接受什么数据原样返回
337 PIocpRelease(PerIoData);//释放内存
338 end;
339 Flags := 0;
340 /////进入投递收取动作
341 PerIoData := PIocpAllocate(DATA_BUFSIZE);
342 PerIoData.IocpOperate := ioRead;
343
344 /////异步收取数据
345 WSARecv(cSocket, @PerIoData.WsaBuf, 1, PerIoData.WsaBuf.len, Flags, @PerIoData.Overlapped, nil);
346 if (WSAGetLastError() <> ERROR_IO_PENDING) then
347 begin
348 closesocket(cSocket);
349 if PerIoData <> nil then
350 begin
351 PIocpRelease(PerIoData);
352 end;
353 Continue;
354 end;
355 end;
356 end;
357
358 end;
359
360 end.
3、indy TCP 客户端
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection,
8 IdTCPClient, StdCtrls, Sockets;
9
10 type
11 TForm1 = class(TForm)
12 IdTCPClient1: TIdTCPClient;
13 btnCon: TButton;
14 mmo1: TMemo;
15 btnSend: TButton;
16 btnRev: TButton;
17 edtSend: TEdit;
18 edtHost: TEdit;
19 edtPort: TEdit;
20 procedure IdTCPClient1Connected(Sender: TObject);
21 procedure btnConClick(Sender: TObject);
22 procedure btnSendClick(Sender: TObject);
23 procedure btnRevClick(Sender: TObject);
24 private
25 { Private declarations }
26 public
27 { Public declarations }
28 end;
29
30 var
31 Form1: TForm1;
32
33 implementation
34
35 {$R *.dfm}
36
37 procedure TForm1.IdTCPClient1Connected(Sender: TObject);
38 begin
39 mmo1.Lines.Add('用户连接上');
40 end;
41
42 procedure TForm1.btnConClick(Sender: TObject);
43 begin
44
45 IdTCPClient1.Host:=edtHost.Text;
46 IdTCPClient1.Port:=StrToInt(edtPort.Text) ;
47 IdTCPClient1.Connect();
48 btnCon.Enabled:=False;
49 btnSend.Enabled:=True;
50 end;
51
52 procedure TForm1.btnSendClick(Sender: TObject);
53 begin
54 IdTCPClient1.WriteLn(edtSend.Text);
55 btnSend.Enabled:=False;
56 btnRev.Enabled:=True;
57 end;
58
59 procedure TForm1.btnRevClick(Sender: TObject);
60 begin
61 mmo1.Lines.Add( IdTCPClient1.ReadLn(#13#10,-1,-1));
62 btnRev.Enabled:=False;
63 btnSend.Enabled:=True;
64 end;
65
66 end.
Q群 Delphi Home 235236282，欢迎delphi 爱好者加入，一起学习、进步。
http://blog.csdn.net/u013051638/article/details/53336762
最新文章
- webapi文档描述-swagger
- UITabBarController 更改tabbariteam上的选中图片
- c# DllImport 找不到指定模块
- php使用ajax导出CSV或者EXCEl(thinkphp)方法
- Rectangle Intersection Test (with C#)
- leetcode 154. Find Minimum in Rotated Sorted Array II --------- java
- 一:AndEngine的小例子
- log4j定义某个类的日志级别
- [H5]range对象的clone方法
- css3+div画大风车
- codeforces645B
- Ubuntu下添加Samba用户名与密码
- 13-02 Java 数组高级算法，Arrays类
- Flink - ShipStrategyType
- windows删除文件或目录CMD命令
- 新飞电器的BI建设案例
- Jenkins自动化打包配置
- 使用Gzip压缩数据，加快页面访问速度
- libstdc++.so.6: version `GLIBCXX_3.4.21' not found
- 看看Spring的源码(二)——bean实例化
热门文章
- oracle高效分页存储过程（百万数据级）
- 《JavaScript高级程序设计》笔记——第一章到第三章
- js进阶课程 12-9 jquery的事件对象event的方法有哪些？
- js cookie可选参数（document.cookie='name=张三;expires='+day;）
- [RxJS] Multicast with a selector argument, as a sandbox
- 【机器学习实战】第2章 k-近邻算法（kNN）
- arcengine 开发经典帖 【强烈推荐仔细研读】
- 【u028】数列的整除性
- Google Guava官方教程
- DbVisualizer的使用