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

http://blog.csdn.net/u013051638/article/details/53336762

delphi之IOCP学习（一）的更多相关文章

delphi操作xml学习笔记之一入门必读
Delphi 对XML的支持---TXMLDocument类 Delphi7 支持对XML文档的操作,可以通过TXMLDocument类来实现对XML文档的读写.可以利用TXMLDocum ...
谁说delphi没有IOCP库，delphi新的IOCP类库，开源中: DIOCP组件JSON流模块说明
单元:JSonStream.pas 简介:本单元实现流和json对象的相互转换,其中有一些保留的key. 依赖:superobject 保留key: __result.errCode 返回的错误编 ...
谁说delphi没有IOCP库，delphi新的IOCP类库，开源中
DIOCP Demo说明下载地址 https://code.google.com/p/diocp/ 特地为DIOCP开设了一个群:320641073,欢迎学习的IOCP的童鞋进入讨论. 核心作者: ...
Delphi下IOCP开源框架：DIOCP 成功应用案例分享
首先说明,该项目不是本人的项目,本文转自盒子. 该项目使用的DIOCP版本为1.0,目前diocp为3.5 以下是盒子的原文 ------------------------------------- ...
delphi xe2 opencv 学习
安装环境 delphi xe2 + opencv opencv 从下面的地方下载 https://github.com/Laex/Delphi-OpenCV然后按照此网站的说明一项以项的安装 ...
Delphi COM编程学习笔记（1）
释放接口对象,既不是调用MyObj.Free,也不是MyObj.Release;破坏对象的正确方法是将它们设置为nil:MyInterface := nil; 一个接口不能离开实现它的对象而独立存活. ...
DELPHI语法基础学习笔记-Windows 句柄、回调函数、函数重载等（Delphi中很少需要直接使用句柄，因为句柄藏在窗体、位图及其他Delphi 对象的内部）
函数重载重载的思想很简单:编译器允许你用同一名字定义多个函数或过程,只要它们所带的参数不同.实际上,编译器是通过检测参数来确定需要调用的例程.下面是从VCL 的数学单元(Math Unit)中摘录的一 ...
Delphi Bpl包学习
对于BPL包,我个人理解是:就是一种封装方式,和DLL,EXE类似,把代码放到包(package)里面保存而已. 一.先说说如何创建BPL包 1. 打开delphi IDE(delphi7 为例) ...
delphi高手突破学习笔记之面向对象类和对象的本质
知识点1:堆和栈每个应用程序可以获得的内存空间分为两种:堆(heap)和栈(stack). 堆又称为“自由存储区”,其中的内存空间的分配与释放是必须由程序员来控制的.例如,用GetMem函数获取了一 ...

随机推荐

LA 3602 - DNA Consensus String 枚举
原题地址:https://icpcarchive.ecs.baylor.edu/index.php?option=com_onlinejudge&Itemid=8&page=show_ ...
9.7 Binder系统_c++实现_编写程序
参考文件:frameworks\av\include\media\IMediaPlayerService.h (IMediaPlayerService,BnMediaPlayerService)fra ...
[Node] Setup an Nginx Proxy for a Node.js App
Learn how to setup an Nginx proxy server that sits in front of a Node.js app. You can use a proxy to ...
全端project师必备技能汇总
首先,看一张前端知识结构图: (原文: ithomer) 图片的形式具有诸多的不便.缺失源图的我们.无法为此图贡献些什么,随着时间的迁移,也许有些技术点会发生改变.所以有了这个GitHub项目.我们 ...
利用a标签导出csv文件
原文简书原文:https://www.jianshu.com/p/a8687610cda3 大纲 1.需求分析 2.通过a标签实现文件导出 3.实现方式 1.需求分析导出文件,使用最多的方式还是服 ...
P2P网络借贷系统-核心功能-用户投标-业务讲解
用户投标是P2P网络借贷系统的核心功能,相对比较复杂,为了更好地梳理业务和技术实现思路,特地详细总结分析下. 输入:用户id-uid,标的id-lid,投标金额-amount 1.根据lid,获得贷款 ...
Lucene学习总结之八：Lucene的查询语法，JavaCC及QueryParser 2014-06-25 14:25 722人阅读评论(1) 收藏
一.Lucene的查询语法 Lucene所支持的查询语法可见http://lucene.apache.org/java/3_0_1/queryparsersyntax.html (1) 语法关键字 + ...
【搜索引擎Jediael开发4】V0.01完整代码分类： H_HISTORY 2014-05-21 21:35 470人阅读评论(0) 收藏
截止目前,已完成如下功能: 1.指定某个地址,使用HttpClient下载该网页至本地文件 2.使用HtmlParser解释第1步下载的网页,抽取其中包含的链接信息 3.下载第2步的所有链接指向的网页 ...
忙里偷闲( ˇˍˇ )闲里偷学【C语言篇】——（9）链表
我们至少可以通过两种结构来存储数据数组 1.需要一整块连续的存储空间,内存中可能没有 2.插入元素,删除元素效率极低. 3.查找数据快链表 1.查找效率低 2.不需要一块连续的内存空间 3.插入删 ...
mysql zip文件安装
bin目录下执行mysqld -install再执行mysqld --initialize-insecure 启动服务:net start mysql

delphi之IOCP学习（一）

delphi之IOCP学习（一）的更多相关文章

随机推荐

热门专题