delphi之IOCP學習（一）

時間 2019-11-13

標籤 delphi iocp 學習欄目 Delphi 简体版

原文原文鏈接

困擾已久的網絡通訊（IOCP：完成端口），今天終於揭開她的神祕面紗了，以前百度N久仍是未能理解IOCP，網絡上好多博文都沒有貼出源碼，初學者很難正在理解IOCP並本身寫出通訊例子，通過努力，今天本身終於作出了簡單的測試程序，下面貼出源碼，水平有限，不免有錯，但願不要誤人子弟。網絡

一、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.

　　二、IOCP 服務端實現代碼app

  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.

三、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.