作者：俞伟 QQ：12400976 MSN：yu924@hotmail.com
DELPHI下面完成端口的资料很少，特别是代码资料，我在前期根据目前网络上的对DELPHI下IOCP分析资料进行了归纳和自己的修改应用，现在把代码帖出来，希望大家多交流学习。
unit uCommNetIOCP;
interface
uses
Windows, SysUtils, SyncObjs, Classes, uCommNetWinSock, uCommNetMessage;
const
DATA_BUFSIZE = 8192;
type
//单IO数据结构
LPVOID = Pointer;
LPPER_IO_OPERATION_DATA = ^ PER_IO_OPERATION_DATA ;
PER_IO_OPERATION_DATA = packed record
Overlapped: TOVERLAPPED;
DataBuf: TWSABUF;
Buffer: array [0..DATA_BUFSIZE] of CHAR;
BytesSEND: DWORD;
BytesRECV: DWORD;
end;
//单句柄数据结构
LPPER_HANDLE_DATA = ^ PER_HANDLE_DATA;
PER_HANDLE_DATA = packed record
Socket: TSocket;
end;
{------------------------- IOCP接口 -----------------------------------------}
ICommNetIOCP = interface
['{2DB60BD4-DA67-4BC5-8068-6892AA481903}']
function Init(AListenIPAddr: string; AListenPort, AMaxConnect: Integer): Boolean; stdcall;
function Start(AListenQueueCount: Integer = 200): Boolean; stdcall;
function RegisterMessageFilter(AMessageFilter: TCommNetMessageFilter): Boolean; stdcall;
procedure UnRegisterMessageFilter(AFilterName: string); stdcall;
procedure Stop; stdcall;
procedure Fini; stdcall;
procedure InvokeMessage(ASocket: Integer; ABuf: PChar; ABufLen: Integer); stdcall;
function SendDataWithHeadLen(const ASocket: TSocket; AData: array of Char; ADataLen: Integer): Boolean; stdcall;
function SendDataWithEndString(const ASocket: TSocket; AData: array of Char; ADataLen: Integer; const AEndStr: string = '%%%(EndSTR)%%%'): Boolean; stdcall;
end;
TCommNetIOCP = class(TInterfacedObject, ICommNetIOCP)
private
fWSAData: TWSAData;
fCompletionPort: THandle;
fListenIPAddr: string;
fListenPort: Integer;
fMaxConnect: Integer;
fListenSocket: Integer;
fListenQueueCount: Integer;
fListenAddr: TSockAddrIn;
fLocalSysInfo: TSystemInfo;
fAcceptThread: THandle;
fCSInvoke: TCriticalSection;
fIoCompletionPortWorkThreadArray: array of THandle;
fMessageFilterList: TThreadList;
function DoWSAStartup: Boolean;
procedure DoWSACleanup;
function DoCreateIoCompletionPort: Boolean;
function DoInitIoCompletionPortWorkThread: Boolean;
procedure DoFiniIoCompletionPortWorkThread;
procedure DoCloseIoCompletionPort;
function DoCreateListenSocket: Boolean;
procedure DoCloseListenSocket;
public
constructor Create;
destructor Destroy; override;
function Init(AListenIPAddr: string; AListenPort, AMaxConnect: Integer): Boolean; stdcall;
function Start(AListenQueueCount: Integer = 200): Boolean; stdcall;
function RegisterMessageFilter(AMessageFilter: TCommNetMessageFilter): Boolean; stdcall;
procedure UnRegisterMessageFilter(AFilterName: string); stdcall;
procedure Stop; stdcall;
procedure Fini; stdcall;
procedure InvokeLock;
procedure UnInvokeLock;
procedure InvokeMessage(ASocket: Integer; ABuf: PChar; ABufLen: Integer); stdcall;
function SendDataWithHeadLen(const ASocket: TSocket; AData: array of Char; ADataLen: Integer): Boolean; stdcall;
function SendDataWithEndString(const ASocket: TSocket; AData: array of Char; ADataLen: Integer; const AEndStr: string = '%%%(EndSTR)%%%'): Boolean; stdcall;
published
property ListenIPAddr: string read fListenIPAddr write fListenIPAddr;
property ListenPort: Integer read fListenPort write fListenPort default 2000;
property MaxConnect: Integer read fMaxConnect write fMaxConnect default 1000;
property ListenQueueCount: Integer read fListenQueueCount write fListenQueueCount default 200;
property CompletionPort: THandle read fCompletionPort;
property ListenSocket: Integer read fListenSocket;
end;
implementation
function AcceptLoopThread(ACommNetIOCP: Pointer): Integer; stdcall;
var
iListenSocket,
iAcceptSocket: Integer;
hCompletionPort: THandle;
PerHandleData: LPPER_HANDLE_DATA;
PerIoData: LPPER_IO_OPERATION_DATA;
RecvBytes: DWORD;
Flags: DWORD;
cniCommNetIOCP: TCommNetIOCP;
begin
Result := 0;
cniCommNetIOCP := TCommNetIOCP(ACommNetIOCP);
iListenSocket := cniCommNetIOCP.ListenSocket;
hCompletionPort := cniCommNetIOCP.CompletionPort;
while True do
begin
iAcceptSocket := WSAAccept(iListenSocket, nil, nil, nil, 0);
//当客户端有连接请求的时候，WSAAccept函数会新创建一个套接字iAcceptSocket。这个套接字就是和客户端通信的时候使用的套接字。
if (iAcceptSocket = SOCKET_ERROR) then
begin
closesocket(iListenSocket);
Exit;
end;
//判断Acceptsc套接字创建是否成功，如果不成功则退出。
PerHandleData := LPPER_HANDLE_DATA(GlobalAlloc(GPTR, SizeOf(PER_HANDLE_DATA)));
if PerHandleData = nil then
begin
Exit;
end;
PerHandleData.Socket := iAcceptSocket;
//创建一个“单句柄数据结构”将hAcceptSocket套接字绑定。
if (CreateIoCompletionPort(iAcceptSocket, hCompletionPort, DWORD(PerHandleData), 0) = 0) then
begin
Exit;
end;
//将套接字、完成端口和“单句柄数据结构”三者绑定在一起。
PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, SizeOf(PER_IO_OPERATION_DATA)));
if PerIoData = nil then
begin
Exit;
end;
ZeroMemory(@PerIoData.Overlapped, SizeOf(OVERLAPPED));
PerIoData.BytesSEND := 0;
PerIoData.BytesRECV := 0;
PerIoData.DataBuf.len := 1024;
PerIoData.DataBuf.buf := @PerIoData.Buffer;
Flags := 0;
//创建一个“单IO数据结构”其中将PerIoData.BytesSEND 和PerIoData.BytesRECV 均设置成0。说明此“单IO数据结构”是用来接受的。
if (WSARecv(iAcceptSocket, @(PerIoData.DataBuf), 1, @RecvBytes, @Flags, @(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
Exit;
end
end;
//用此“单IO数据结构”来接受Acceptsc套接字的数据。
end;
end;
function ServerWorkerThread(ACommNetIOCP: Pointer): Integer; stdcall;
var
hCompletionPort: THandle;
BytesTransferred: Cardinal;
PerHandleData: LPPER_HANDLE_DATA;
PerIoData: LPPER_IO_OPERATION_DATA;
TempSocket: Integer;
RecvBytes: DWORD;
Flags: DWORD;
cniCommNetIOCP: TCommNetIOCP;
begin
cniCommNetIOCP := TCommNetIOCP(ACommNetIOCP);
hCompletionPort := cniCommNetIOCP.CompletionPort;
//得到创建线程是传递过来的IOCP
while(TRUE) do
begin
//工作者线程会停止到GetQueuedCompletionStatus函数处，直到接受到数据为止
if (GetQueuedCompletionStatus(hCompletionPort, BytesTransferred, DWORD(PerHandleData), POverlapped(PerIoData), INFINITE) = False) then
begin
//当客户端连接断开或者客户端调用closesocket函数的时候,函数GetQueuedCompletionStatus会返回错误。如果我们加入心跳后，在这里就可以来判断套接字是否依然在连接。
if PerHandleData <> nil then
begin
closesocket(PerHandleData.Socket);
GlobalFree(DWORD(PerHandleData));
end;
if PerIoData <> nil then
begin
GlobalFree(DWORD(PerIoData));
end;
continue;
end;
if (BytesTransferred = 0) then
begin
//当客户端调用shutdown函数来从容断开的时候，我们可以在这里进行处理。
if PerHandleData <> nil then
begin
TempSocket := PerHandleData.Socket;
shutdown(PerHandleData.Socket,1);
closesocket(PerHandleData.Socket);
GlobalFree(DWORD(PerHandleData));
end;
if PerIoData <> nil then
begin
GlobalFree(DWORD(PerIoData));
end;
continue;
end;
//在上一篇中我们说到IOCP可以接受来自客户端的数据和自己发送出去的数据，两种数据的区别在于我们定义的结构成员BytesRECV和BytesSEND的值。所以下面我们来判断数据的来自方向。因为我们发送出去数据的时候我们设置了结构成员BytesSEND。所以如果BytesRECV=0同时BytesSEND=0那么此数据就是我们接受到的客户端数据。（这种区分方法不是唯一的，个人可以有自己的定义方法。只要可以区分开数据来源就可以。）
if (PerIoData.BytesRECV = 0) and (PerIoData.BytesSEND = 0) then
begin
PerIoData.BytesRECV := BytesTransferred;
PerIoData.BytesSEND := 0;
end
else
begin
PerIoData.BytesSEND := BytesTransferred;
PerIoData.BytesRECV := 0;
end;
//当是接受来自客户端的数据是，我们进行数据的处理。
if (PerIoData.BytesRECV > PerIoData.BytesSEND) then
begin
PerIoData.DataBuf.buf := PerIoData.Buffer + PerIoData.BytesSEND;
PerIoData.DataBuf.len := PerIoData.BytesRECV - PerIoData.BytesSEND;
//这时变量PerIoData.Buffer就是接受到的客户端数据。数据的长度是PerIoData.DataBuf.len 你可以对数据进行相关的处理了。
cniCommNetIOCP.InvokeLock;
try
cniCommNetIOCP.InvokeMessage(PerHandleData.Socket, PerIoData.Buffer, PerIoData.DataBuf.len);
finally
cniCommNetIOCP.UnInvokeLock;
end;
//当我们将数据处理完毕以后，应该将此套接字设置为结束状态，同时初始化和它绑定在一起的数据结构。
ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED));
PerIoData.BytesRECV := 0;
Flags := 0;
ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED));
PerIoData.DataBuf.len := DATA_BUFSIZE;
ZeroMemory(@PerIoData.Buffer,sizeof(@PerIoData.Buffer));
PerIoData.DataBuf.buf := @PerIoData.Buffer;
if (WSARecv(PerHandleData.Socket, @(PerIoData.DataBuf), 1, @RecvBytes, @Flags,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
if PerHandleData <> nil then
begin
TempSocket := PerHandleData.Socket;
closesocket(PerHandleData.Socket);
GlobalFree(DWORD(PerHandleData));
end;
if PerIoData <> nil then
begin
GlobalFree(DWORD(PerIoData));
end;
continue;
end;
end;
end
//当我们判断出来接受的数据是我们发送出去的数据的时候，在这里我们清空我们申请的内存空间
else
begin
GlobalFree(DWORD(PerIoData));
end;
end;
end;
{ TCommNetIOCP }
constructor TCommNetIOCP.Create;
begin
fMessageFilterList := TThreadList.Create;
fCSInvoke := TCriticalSection.Create;
end;
destructor TCommNetIOCP.Destroy;
begin
Fini;
if fCSInvoke <> nil then
begin
fCSInvoke.Free;
end;
if fMessageFilterList <> nil then
begin
fMessageFilterList.Clear;
fMessageFilterList.Free;
end;
inherited;
end;
procedure TCommNetIOCP.DoCloseIoCompletionPort;
begin
if fCompletionPort <> 0 then
begin
CloseHandle(fCompletionPort);
fCompletionPort := 0;
end;
end;
procedure TCommNetIOCP.DoCloseListenSocket;
begin
if fListenSocket > 0 then
begin
closesocket(fListenSocket);
fListenSocket := 0;
end;
end;
function TCommNetIOCP.DoCreateIoCompletionPort: Boolean;
begin
Result := False;
fCompletionPort := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
if fCompletionPort <> 0 then
Result := True;
end;
function TCommNetIOCP.DoCreateListenSocket: Boolean;
begin
Result := False;
fListenSocket := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
if fListenSocket = SOCKET_ERROR then
begin
closesocket(fListenSocket);
WSACleanup;
Exit;
end;
Result := True;
end;
procedure TCommNetIOCP.DoFiniIoCompletionPortWorkThread;
var
I: Integer;
begin
if Length(fIoCompletionPortWorkThreadArray) = 0 then Exit;
for I := 0 to Length(fIoCompletionPortWorkThreadArray) - 1 do
begin
if fIoCompletionPortWorkThreadArray[I] <> 0 then
begin
TerminateThread(fIoCompletionPortWorkThreadArray[I], 0);
fIoCompletionPortWorkThreadArray[I] := 0;
end;
end;
SetLength(fIoCompletionPortWorkThreadArray, 0);
end;
function TCommNetIOCP.DoInitIoCompletionPortWorkThread: Boolean;
var
I, J: Integer;
cThreadID: Cardinal;
begin
Result := False;
GetSystemInfo(fLocalSysInfo);
for I := 0 to fLocalSysInfo.dwNumberOfProcessors * 2 - 1 do
begin
SetLength(fIoCompletionPortWorkThreadArray, Length(fIoCompletionPortWorkThreadArray) + 1);
fIoCompletionPortWorkThreadArray[I] := CreateThread(nil, 0, @ServerWorkerThread, Pointer(Self), 0, cThreadID);
if fIoCompletionPortWorkThreadArray[I] = 0 then
begin
for J := 0 to Length(fIoCompletionPortWorkThreadArray) - 1 do
begin
TerminateThread(fIoCompletionPortWorkThreadArray[J], 0);
fIoCompletionPortWorkThreadArray[J] := 0;
end;
SetLength(fIoCompletionPortWorkThreadArray, 0);
Exit;
end;
end;
Result := True;
end;
procedure TCommNetIOCP.DoWSACleanup;
begin
WSACleanup;
end;
function TCommNetIOCP.DoWSAStartup: Boolean;
begin
Result := False;
if WSAStartUp($202, fWSAData) <> 0 then
begin
WSACleanup();
Exit;
end;
Result := True;
end;
procedure TCommNetIOCP.Fini;
begin
Stop;
DoCloseListenSocket;
DoFiniIoCompletionPortWorkThread;
DoCloseIoCompletionPort;
DoWSACleanup;
end;
function TCommNetIOCP.Init(AListenIPAddr: string; AListenPort, AMaxConnect: Integer): Boolean;
begin
Result := False;
ListenIPAddr := AListenIPAddr;
ListenPort := AListenPort;
MaxConnect := AMaxConnect;
if DoWSAStartup then
begin
//创建一个完成端口
if not DoCreateIoCompletionPort then Exit;
if not DoInitIoCompletionPortWorkThread then Exit;
//创建Listen Socket
if not DoCreateListenSocket then Exit;
//绑定地址
fListenAddr.sin_family := AF_INET;
fListenAddr.sin_port := htons(ListenPort);
fListenAddr.sin_addr.S_addr := inet_addr(PChar(ListenIPAddr));
if bind(fListenSocket, @fListenAddr, SizeOf(fListenAddr)) = SOCKET_ERROR then
begin
closesocket(fListenSocket);
WSACleanup;
Exit;
end;
Result := True;
end;
end;
procedure TCommNetIOCP.InvokeLock;
begin
if fCSInvoke <> nil then
begin
fCSInvoke.Enter;
end;
end;
procedure TCommNetIOCP.InvokeMessage(ASocket: Integer; ABuf: PChar;
ABufLen: Integer);
var
I: Integer;
FilterList: TList;
pmfhHandler: PCommNetMessageFilterHandler;
bAccept: Boolean;
begin
FilterList := fMessageFilterList.LockList;
try
for I := 0 to FilterList.Count - 1 do
begin
pmfhHandler := PCommNetMessageFilterHandler(FilterList.Items[I]);
if pmfhHandler <> nil then
begin
bAccept := False;
pmfhHandler^.MessageFilter.InvokeMessage(ASocket, ABuf, ABufLen, bAccept);
if bAccept then
begin
Break;
end;
end;
end;
finally
fMessageFilterList.UnlockList;
end;
end;
function TCommNetIOCP.RegisterMessageFilter(
AMessageFilter: TCommNetMessageFilter): Boolean;
var
pmfhHandler: PCommNetMessageFilterHandler;
begin
Result := False;
if AMessageFilter = nil then Exit;
New(pmfhHandler);
pmfhHandler^.MessageFilter := AMessageFilter;
fMessageFilterList.LockList;
fMessageFilterList.Add(pmfhHandler);
fMessageFilterList.UnlockList;
Result := True;
end;
function TCommNetIOCP.SendDataWithEndString(const ASocket: TSocket;
AData: array of Char; ADataLen: Integer; const AEndStr: string): Boolean;
var
PerIoData : LPPER_IO_OPERATION_DATA;
SendBytes,
RecvBytes : DWORD;
Flags : DWORD;
LenStr : string;
SendBuf : array [0..DATA_BUFSIZE] of Char;
iEndStrLen: Integer;
begin
try
//由于粘包的关系，所以在需要发送的数据前面加入４位这次发送数据的长度。（详见我的前一篇文章）
FillChar(SendBuf, SizeOf(SendBuf), #0);
iEndStrLen := Length(AEndStr);
StrMove(SendBuf + 0, AData, ADataLen);
CopyMemory(SendBuf + ADataLen, @AEndStr, iEndStrLen);
//在这里申请一个发送数据的"单IO数据结构"
PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, SizeOf(PER_IO_OPERATION_DATA)));
if (PerIoData = nil) then
begin
Result := False;
Exit;
end;
ZeroMemory(@PerIoData.Overlapped, sizeof(OVERLAPPED));
//设置发送标记
PerIoData.BytesRECV := 0;
PerIoData.DataBuf.len := ADataLen + iEndStrLen;
PerIoData.DataBuf.buf := @SendBuf;
PerIoData.BytesSEND := ADataLen + iEndStrLen;
Flags := 0;
//使用WSASend函数将数据发送
if (WSASend(ASocket, @(PerIoData.DataBuf), 1, @SendBytes, 0,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
Result := False;
Exit;
end;
end;
Result := True;
except
Result := False;
end;
end;
function TCommNetIOCP.SendDataWithHeadLen(const ASocket: TSocket; AData: array of Char;
ADataLen: Integer): Boolean;
var
PerIoData : LPPER_IO_OPERATION_DATA;
SendBytes,
RecvBytes : DWORD;
Flags : DWORD;
LenStr : string;
SendBuf : array [0..DATA_BUFSIZE] of Char;
begin
try
//由于粘包的关系，所以在需要发送的数据前面加入４位这次发送数据的长度。（详见我的前一篇文章）
FillChar(SendBuf, SizeOf(SendBuf), #0);
CopyMemory(SendBuf + 0, @ADataLen, 4);
StrMove(SendBuf + 4, AData, ADataLen);
//在这里申请一个发送数据的"单IO数据结构"
PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, SizeOf(PER_IO_OPERATION_DATA)));
if (PerIoData = nil) then
begin
Result := False;
Exit;
end;
ZeroMemory(@PerIoData.Overlapped, sizeof(OVERLAPPED));
//设置发送标记
PerIoData.BytesRECV := 0;
PerIoData.DataBuf.len := ADataLen + 4;
PerIoData.DataBuf.buf := @SendBuf;
PerIoData.BytesSEND := ADataLen + 4;
Flags := 0;
//使用WSASend函数将数据发送
if (WSASend(ASocket, @(PerIoData.DataBuf), 1, @SendBytes, 0,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
Result := False;
Exit;
end;
end;
Result := True;
except
Result := False;
end;
end;
function TCommNetIOCP.Start(AListenQueueCount: Integer): Boolean;
var
cThreadID: Cardinal;
begin
Result := False;
if fListenSocket > 0 then
begin
listen(fListenSocket, AListenQueueCount);
fAcceptThread := CreateThread(nil, 0, @AcceptLoopThread, Pointer(Self), 0, cThreadID);
if fAcceptThread = 0 then
begin
Exit;
end;
Result := True;
end;
end;
procedure TCommNetIOCP.Stop;
begin
if fAcceptThread <> 0 then
begin
TerminateThread(fAcceptThread, 0);
fAcceptThread := 0;
end;
end;
procedure TCommNetIOCP.UnInvokeLock;
begin
if fCSInvoke <> nil then
begin
fCSInvoke.Leave;
end;
end;
procedure TCommNetIOCP.UnRegisterMessageFilter(AFilterName: string);
var
I: Integer;
FilterList: TList;
pmfhHandler: PCommNetMessageFilterHandler;
begin
FilterList := fMessageFilterList.LockList;
try
for I := 0 to FilterList.Count - 1 do
begin
pmfhHandler := PCommNetMessageFilterHandler(FilterList.Items[I]);
if pmfhHandler <> nil then
begin
if SameText(AFilterName, pmfhHandler^.MessageFilter.FilterName) then
begin
FilterList.Delete(I);
Dispose(pmfhHandler);
Break;
end;
end;
end;
finally
fMessageFilterList.UnlockList;
end;
end;
end.
扫一扫
956
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
