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函数获取了一 ...

随机推荐

Linux定时器的使用（三种方法）
使用定时器的目的无非是为了周期性的执行某一任务,或者是到了一个指定时间去执行某一个任务.要达到这一目的,一般有两个常见的比较有效的方法.一个是用linux内部的三个定时器,另一个是用sleep, us ...
(转）c++ 中的using namespace std是什么意思，什么时候用
使用std命名空间 98年以后的c++语言提供一个全局的命名空间namespace,可以避免导致全局命名冲突问题.举一个实例,请注意以下两个头文件: // one.hchar func(char);c ...
IOS手势事件
一, iPhone中处理触摸事件的操作,在3.2之前是主要使用的是由UIResponder而来的如下4种方式 - (void)touchesBegan:(NSSet *)touches withEve ...
[Nuxt] Build a Vue.js Form then use Vuex Actions to Post to an API in Nuxt
The default behavior of submitting an HTML form is to reload the page. You can use the Vue.js @submi ...
js cookie介绍和实例（用于自动登录，记住用户名等）
js cookie介绍和实例(用于自动登录,记住用户名等) 一.总结 1.cookie在客户端:因为js是最初是用来在客户端和服务器端进行通信使用的,所以客户端比如js可以操作cookie正常 2.c ...
三、链路追踪系统 zipkin
一.构建项目用到的依赖直接看pom.xml的注释吧 <?xml version="1.0" encoding="UTF-8"?> <proj ...
Swift3.0为视图添加旋转动画_CABasicAnimation
Swift2.3: //创建旋转动画 let anim = CABasicAnimation(keyPath: "transform.rotation") //旋转角度 anim. ...
CTR深度学习
深度学习在 CTR 中应用一. Wide&&Deep 模型首先给出Wide && Deep [1] 网络结构: 本质上是线性模型(左边部分, Wide model) ...
php 时间戳转为多少分钟前小时前天前
function mdate($time = NULL) { $text = ''; $time = $time === NULL || $time > time() ? time() : in ...
html5+js压缩图片上传
最近在折腾移动站的开发,涉及到了一个手机里面上传图片.于是经过N久的折腾,找到一个插件,用法如下: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ...

delphi之IOCP学习（一）

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

随机推荐

热门专题