delphi之IOCP学习（一）

delphi之IOCP学习（一）

   困扰已久的网络通信（IOCP：完成端口），今天终于揭开她的神秘面纱了，之前百度N久还是未能理解IOCP，网络上好多博文都没有贴出源码，初学者很难正在理解IOCP并自己写出通信例子 ，经过努力，今天自己终于做出了简单的测试程序，下面贴出源码，水平有限，难免有错，希望不要误人子弟。

1、Svr主窗体

unit Umain;

interface

uses
  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 爱好者加入，一起学习、进步。