高性能的 socket 通讯服务器（完成端口模型--IOCP）

很多人费尽心思，都没有找到一个完美的 I/O CP 例程，甚至跟人于误解，先将本人编写的例程公布出来，希望对那些苦苦寻觅的人带来收获。本例程可以作为初学者的学习之用，亦可以作为大型服务程序的通讯模块。其处理速度可以说，优化到了极点。如果理解了本例程的精髓，加上一个高效的通讯协议，你完全可以用它来构建一个高性能的通讯服务器。在公布代码前，先谈谈I/O CP。对I/O CP的函数不多做说明了，网上很多，都一样。在此本人仅说一些技术上要注意的问题。一、如何管理内存1、IO数据缓冲管理动态分配内存，是一种灵活的方式。但对于系统资源浪费是巨大的。因此本人采用的是预先分配服务器最大需要的内存，用链表来管理。任何时候分配交还都不需要遍历，仅需要互斥而已。更巧妙的是，将IO发送信息和内存块有机的结合在一起，减少了链表的管理工作。//IO操作标志TIOFlag = (IO_ACCEPT, IO_READ, IO_WRITE);//IO操作信息PIOInfo =^ TIOInfo;TIOInfo = packed recordOverlapped: TOverlapped; //重叠结构DataBuf: TWSABUF; //IO数据信息Socket: TSocket;Flag: TIOFlag;TickCountSend: DWord;Next: PIOInfo;Prior: PIOInfo;end;PUNode =^ TUNode;TUNode = recordNext: Pointer;end;PIOMem =^ TIOMem;TIOMem = packed recordIOInfo: TIOInfo;Data: array[1..IO_MEM_SIZE] of Byte;//申请内存的时候，返回的是Data的地址end;2、链路数据管理采用双向链表结构，减少删除节点时遍历消耗的时间//每个连接的信息PLink =^ TLink;TLink = recordSocket: TSocket;RemoteIP: string[30];RemotePort: DWord;//最后收到数据时的系统节拍TickCountActive: DWord;//处理该连接的当前线程的信息Worker: PWorker;Data: Pointer; //应用层可以设置这个成员，当OnReceive的时候，就不要每次遍历每个连接对应的数据区了Section: TRTLCriticalSection;Next: PLink;Prior: PLink;end;二、如何管理线程每个工作线程创建的时候，调用：OnWorkerThreadCreateEvt，该函数可以返回这个线程对应的信息，比如为该线程创建的数据库连接控件或对应的类等，在OnReceive的可以从Link的Worker访问该成员Worker^.Data。//工作线程信息PWorker =^ TWorker;TWorker = recordID: THandle;CompletionPort: THandle;Data: Pointer; //调用OnWorkerThreadCreateEvt返回的值//用于反应工作情况的数据TickCountLong,TickCountActive: DWord;ExecCount: Integer;//线程完成后设置Finished: THandle;Next: PWorker;end;同理，服务线程也是具有一样的特点。相见源码。关于线程同步，一直是众多程序头疼的问题。在本例程中，尽量避免了过多的互斥，并有效地防止了死锁现象。用RTLCriticalSection，稍微不注意，就会造成死锁的灾难。哪怕是两行代码的差别，对多线程而言都是灾难的。在本例程中，对数据同步需要操作的是在维护链路链表方面上。服务线程需要计算哪个连接空闲超时了，工作线程需要处理断线情况，应用层主动发送数据时需要对该链路独占，否则一个在发送，一个在处理断线故障，就会发送冲突，导致灾难后果。在本人的压力测试中，已经有效的解决了这个问题，应用层部分不需要做什么同步工作，可以安心的收发数据了。同时每个线程都支持了数据库连接。三、到底要创建多少个工作线程合适很多文章说，有N个CPU就创建N个线程，也有说N*2+2。最不喜欢说话不负责任的人了，本例程可以让刚入门 I/O CP 的人对它有更深入的了解。例程测试结果：四、该不该使用类有人说，抛弃一切类，对于服务器而言，会为类付出很多代价，从我的观点看，为类付出代价的，主要是动态创建的原因。其实，类成员访问和结构成员访问一样，需要相对地址。如果都是预先创建的，两者没有多大的差别。本例程采用裸奔函数的方式，当然在应用层可以采用类来管理，很难想象，如果没有没有类，需要多做多少工作。五、缺点不能发大数据包，只能发不超过固定数的数据包。但对于小数据报而言，它将是优秀的。时间原因，不能做太多的解释和对代码做太多的注释，需要例程源码的可以和本人联系，免费提供。ＱＱ：４８０９２７８８例程源码：http://d.download.csdn.net/down/1546336/guestcode完成端口通讯服务模块源码：{******************************************************************************* UCode 系列组件、控件 ** 作者：卢益贵 2003～2009 ** 版权所有 任何未经授权的使用和销售，均保留追究法律责任的权力 ** ** UCode 系列由XCtrls－YCtrls－ICtrls－NCode系列演变而来 ** QQ:48092788 luyigui.blog.gxsky.com *******************************************************************************}{******************************************************************************完成端口模型的socket服务器******************************************************************************}unit UTcpServer;interfaceusesWindows, Classes, UClasses, UWinSock2;const//每个IO缓冲区的大小IO_MEM_SIZE = 2048;//内存要足够用,可视情况设置IO_MEM_MAX_COUNT = 1000 * 10;//最大连接数SOCK_MAX_COUNT = 3000;//连接空闲实现,超过这个时间未收到客户端数据则关闭SOCK_IDLE_OVERTIME = 60;type//工作线程信息PWorker =^ TWorker;TWorker = recordID: THandle;CompletionPort: THandle;Data: Pointer;//用于反应工作情况的数据TickCountLong,TickCountActive: DWord;ExecCount: Integer;//线程完成后设置Finished: THandle;Next: PWorker;end;//每个连接的信息PLink =^ TLink;TLink = recordSocket: TSocket;RemoteIP: string[30];RemotePort: DWord;//最后收到数据时的系统节拍TickCountActive: DWord;//处理该连接的当前线程的信息Worker: PWorker;Data: Pointer;Section: TRTLCriticalSection;Next: PLink;Prior: PLink;end;TOnLinkIdleOvertimeEvt = procedure(Link: PLink);TOnDisconnectEvt = procedure(Link: PLink);TOnReceiveEvt = function(Link: PLink; Buf: PByte; Len: Integer): Boolean;TOnThreadCreateEvt = function(IsWorkerThread: Boolean): Pointer;//取得链路链表使用情况X%function GetLinkUse(): real;//链路链表所占内存function GetLinkSize(): Integer;//当前链路数function GetLinkCount(): Integer;//空闲链路数function GetLinkFree(): Integer;//IO内存使用情况function GetIOMemUse(): Real;//IO内存链表占内存数function GetIOMemSize(): Integer;//IO内存空闲数function GetIOMemFree(): Integer;//交还一个IO内存procedure FreeIOMem(Mem: Pointer);//获取一个IO内存区function GetIOMem(): Pointer;//获取工作线程的工作情况function GetWorkerExecInfo(Index: Integer; var TickCount: DWord): Integer;//获取工作线程的IDfunction GetWorkerID(Index: Integer): Integer;//获取工作线程数量function GetWorkerCount(): Integer;//打开一个IP端口,并监听function StartTcpServer(RemoteIP: String; RemotePort: DWord): Boolean;//停止并关闭一个IP端口function StopTcpServer(): Boolean;//设置响应事件的函数指针,在StartTcpServer之前调用procedure SetEventProc(OnReceive: TOnReceiveEvt;OnDisconnect: TOnDisconnectEvt;OnLinkIdleOvertime: TOnLinkIdleOvertimeEvt;OnServerThreadCreate: TOnThreadCreateEvt;OnWorkerThreadCreate: TOnThreadCreateEvt);//写日志文件procedure WriteLog(Log: String);function PostRecv(Link: PLink; IOMem: Pointer): Boolean;//抛出一个发送事件function PostSend(Link: PLink; IOMem: Pointer; Len: Integer): Boolean;//广播数据到所有的链路对方procedure PostBroadcast(Buf: PByte; Len: Integer);//当前是否打开function IsTcpServerActive(): Boolean;//获取服务线程最后一次工作所占的时间(MS)function GetServerExecLong(): DWord;//获取服务线程工作次数function GetServerExecCount(): Integer;//获取本地或对外IP地址function GetLocalIP(IsIntnetIP: Boolean): String;implementationusesIniFiles, SysUtils, ActiveX;varExePath: String = '';constHEAP_NO_SERIALIZE = 1; {非互斥, 此标记可允许多个线程同时访问此堆}HEAP_GENERATE_EXCEPTIONS = 4; {当建立堆出错时, 此标记可激发一个异常并返回异常标识}HEAP_ZERO_MEMORY = 8; {把分配的内存初始化为 0}HEAP_REALLOC_IN_PLACE_ONLY = 16; {此标记不允许改变原来的内存位置}STATUS_ACCESS_VIOLATION = DWORD($C0000005); {参数错误}STATUS_NO_MEMORY = DWORD($C0000017); {内存不足}{===============================================================================IO内存管理================================================================================}type//IO操作标志TIOFlag = (IO_ACCEPT, IO_READ, IO_WRITE);//IO操作信息PIOInfo =^ TIOInfo;TIOInfo = packed recordOverlapped: TOverlapped; //重叠结构DataBuf: TWSABUF; //IO数据信息Socket: TSocket;Flag: TIOFlag;TickCountSend: DWord;Next: PIOInfo;Prior: PIOInfo;end;PUNode =^ TUNode;TUNode = recordNext: Pointer;end;PIOMem =^ TIOMem;TIOMem = packed recordIOInfo: TIOInfo;Data: array[1..IO_MEM_SIZE] of Byte;end;varIOMemHead: PIOMem = nil;IOMemLast: PIOMem = nil;IOMemUse: Integer = 0;IOMemSec: TRTLCriticalSection;IOMemList: array[1..IO_MEM_MAX_COUNT] of Pointer;function GetIOMem(): Pointer;begin//内存要足够用，如果不够，即使是动态分配，神仙也救不了EnterCriticalSection(IOMemSec);trytryResult := @(IOMemHead^.Data);IOMemHead := PUNode(IOMemHead)^.Next;IOMemUse := IOMemUse + 1;exceptResult := nil;WriteLog('GetIOMem: error');end;finallyLeaveCriticalSection(IOMemSec);end;end;procedure FreeIOMem(Mem: Pointer);beginEnterCriticalSection(IOMemSec);trytryMem := Pointer(Integer(Mem) - sizeof(TIOInfo));PUNode(Mem).Next := nil;PUNode(IOMemLast)^.Next := Mem;IOMemLast := Mem;IOMemUse := IOMemUse - 1;exceptWriteLog('FreeIOMem: error');end;finallyLeaveCriticalSection(IOMemSec);end;end;procedure IniIOMem();vari: Integer;Heap: THandle;beginInitializeCriticalSection(IOMemSec);IOMemHead := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, sizeof(TIOMem));IOMemLast := IOMemHead;IOMemList[1] := IOMemHead;Heap := GetProcessHeap();for i := 2 to IO_MEM_MAX_COUNT dobeginPUNode(IOMemLast)^.Next := HeapAlloc(Heap, HEAP_ZERO_MEMORY, sizeof(TIOMem));IOMemList[i] := PUNode(IOMemLast)^.Next;IOMemLast := PUNode(IOMemLast)^.Next;end;PUNode(IOMemLast).Next := nil;end;function GetIOMemFree(): Integer;varIOMems: PUNode;beginEnterCriticalSection(IOMemSec);Result := 0;IOMems := PUNode(IOMemHead);while IOMems nil dobeginResult := Result + 1;IOMems := IOMems^.Next;end;LeaveCriticalSection(IOMemSec);end;procedure DeleteIOMem();vari: Integer;Heap: THandle;beginHeap := GetProcessHeap();for i := 1 to IO_MEM_MAX_COUNT doHeapFree(Heap, HEAP_NO_SERIALIZE, IOMemList[i]);IOMemUse := 0;DeleteCriticalSection(IOMemSec);end;function GetIOMemSize(): Integer;beginResult := IO_MEM_MAX_COUNT * sizeof(TIOMem);end;function GetIOMemUse(): Real;beginResult := (IOMemUse * 100) / IO_MEM_MAX_COUNT;end;{===============================================================================Socket链路管理================================================================================}procedure OnLinkIdleOvertimeDef(Link: PLink);beginend;varLinkHead: PLink = nil;LinkLast: PLink = nil;LinkUse: Integer = 0;LinkCount: Integer = 0;LinkSec: TRTLCriticalSection;LinkList: array[1..SOCK_MAX_COUNT] of PLink;OnLinkIdleOvertimeEvt: TOnLinkIdleOvertimeEvt = OnLinkIdleOvertimeDef;LinksHead: PLink = nil;LinksLast: PLink = nil;function GetLinkFree(): Integer;varLinks: PLink;beginEnterCriticalSection(LinkSec);Result := 0;Links := LinkHead;while Links nil dobeginResult := Result + 1;Links := Links^.Next;end;LeaveCriticalSection(LinkSec);end;function GetLink(): PLink;begintry//内存要足够用，如果不够，即使是动态分配，神仙也救不了Result := LinkHead;LinkHead := LinkHead^.Next;LinkUse := LinkUse + 1;LinkCount := LinkCount + 1;if LinksHead = nil thenbeginLinksHead := Result;LinksHead^.Next := nil;LinksHead^.Prior := nil;LinksLast := LinksHead;end elsebeginResult^.Prior := LinksLast;LinksLast^.Next := Result;LinksLast := Result;LinksLast^.Next := nil;end;with Result^ dobeginSocket := INVALID_SOCKET;RemoteIP := '';RemotePort := 0;TickCountActive := GetTickCount();Worker := nil;Data := nil;end;exceptResult := nil;WriteLog('GetLink: error');end;end;procedure FreeLink(Link: PLink);begintrywith Link^ dobeginLink^.Worker := nil;if Link = LinksHead thenbeginLinksHead := Next;if LinksLast = Link thenLinksLast := LinksHeadelseLinksHead^.Prior := nil;end elsebeginPrior^.Next := Next;if Next nil thenNext^.Prior := Prior;if Link = LinksLast thenLinksLast := Prior;end;Next := nil;LinkLast^.Next := Link;LinkLast := Link;LinkUse := LinkUse - 1;LinkCount := LinkCount - 1;end;exceptWriteLog('FreeLink: error');end;end;procedure CloseLink(Link: PLink);beginEnterCriticalSection(LinkSec);with Link^ dobeginEnterCriticalSection(Section);if Socket INVALID_SOCKET thenbegintryCloseSocket(Socket);exceptWriteLog('CloseSocket: error');end;Socket := INVALID_SOCKET;FreeLink(Link);end;LeaveCriticalSection(Link^.Section);end;LeaveCriticalSection(LinkSec);end;procedure CheckLinkLinkIdleOvertime(Data: Pointer);varTickCount: DWord;Long: Integer;Link: PLink;beginEnterCriticalSection(LinkSec);tryTickCount := GetTickCount();Link := LinksHead;while Link nil dowith Link^ dobeginEnterCriticalSection(Section);if Socket INVALID_SOCKET thenbeginif TickCount > TickCountActive thenLong := TickCount - TickCountActiveelseLong := $FFFFFFFF - TickCountActive + TickCount;if SOCK_IDLE_OVERTIME * 1000 0 doi := i - 1;if not PostSend(Link, IOMem, Len) thenFreeIOMem(IOMem);end;function OnWorkerThreadCreateDef(IsWorkerThread: Boolean): Pointer;beginResult := nil;end;varWorkerHead: PWorker = nil;WorkerCount: Integer = 0;OnDisconnectEvt: TOnDisconnectEvt = OnDisconnectDef;OnReceiveEvt: TOnReceiveEvt = OnReceiveDef;OnWorkerThreadCreateEvt: TOnThreadCreateEvt = OnWorkerThreadCreateDef;function GetWorkerCount(): Integer;beginResult := WorkerCount;end;function WorkerThread(Worker: PWorker): DWORD; stdcall;varLink: PLink;IOInfo: PIOInfo;Bytes: DWord;CompletionPort: THandle;beginResult := 0;CompletionPort := Worker^.CompletionPort;with Worker^ dobeginTickCountActive := GetTickCount();TickCountLong := 0;ExecCount := 0;end;WriteLog(Format('Worker thread:%d begin', [Worker^.ID]));CoInitialize(nil);trywhile True dobegintrywith Worker^ doTickCountLong := TickCountLong + GetTickCount() - TickCountActive;if GetQueuedCompletionStatus(CompletionPort, Bytes, DWORD(Link), POverlapped(IOInfo), INFINITE) = False thenbeginif (Link nil) thenwith Link^ dobeginEnterCriticalSection(LinkSec);EnterCriticalSection(Section);if Link^.Socket INVALID_SOCKET thenbegintryCloseSocket(Socket);exceptWriteLog(Format('CloseSocket1:%d error', [Worker^.ID]));end;Socket := INVALID_SOCKET;Link^.Worker := Worker;tryOnDisconnectEvt(Link);exceptWriteLog(Format('OnDisconnectEvt1:%d error', [Worker^.ID]));end;Link^.Worker := nil;FreeLink(Link);end;LeaveCriticalSection(Section);LeaveCriticalSection(LinkSec);end;if IOInfo nil thenFreeIOMem(IOInfo^.DataBuf.buf);WriteLog(Format('GetQueuedCompletionStatus:%d error', [Worker^.ID]));continue;end;with Worker^ dobeginTickCountActive := GetTickCount();ExecCount := ExecCount + 1;end;if (Bytes = 0) thenbeginif (Link nil) thenwith Link^ dobeginEnterCriticalSection(LinkSec);EnterCriticalSection(Section);if Link^.Socket INVALID_SOCKET thenbegintryCloseSocket(Socket);exceptWriteLog(Format('CloseSocket2:%d error', [Worker^.ID]));end;Socket := INVALID_SOCKET;Link^.Worker := Worker;tryOnDisconnectEvt(Link);exceptWriteLog(Format('OnDisconnectEvt2:%d error', [Worker^.ID]));end;Link^.Worker := nil;FreeLink(Link);end;LeaveCriticalSection(Section);LeaveCriticalSection(LinkSec);if IOInfo.Flag = IO_WRITE thenFreeIOMem(IOInfo^.DataBuf.buf)elseFreeIOMem(IOInfo^.DataBuf.buf);continue;end elsebeginif IOInfo nil thenFreeIOMem(IOInfo^.DataBuf.buf);break;end;end;if IOInfo.Flag = IO_WRITE thenbeginFreeIOMem(IOInfo^.DataBuf.buf);continue;end;{if IOInfo.Flag = IO_ACCEPT thenbegin......continue;end;}with Link^, IOInfo^.DataBuf dobeginLink^.Worker := Worker;tryOnReceiveEvt(Link, buf, Bytes);exceptWriteLog(Format('OnReceiveEvt:%d error', [Worker^.ID]));end;Link^.Worker := nil;TickCountActive := GetTickCount();if not PostRecv(Link, buf) thenbeginEnterCriticalSection(LinkSec);EnterCriticalSection(Section);if Socket INVALID_SOCKET thenbegintryCloseSocket(Socket);exceptWriteLog(Format('CloseSocket3:%d error', [Worker^.ID]));end;Socket := INVALID_SOCKET;Link^.Worker := Worker;tryOnDisconnectEvt(Link);exceptWriteLog(Format('OnDisconnectEvt3:%d error', [Worker^.ID]));end;Link^.Worker := nil;FreeLink(Link);end;LeaveCriticalSection(Section);LeaveCriticalSection(LinkSec);FreeIOMem(buf);end;end;exceptWriteLog(Format('Worker thread:%d error', [Worker^.ID]));end;end;finallyCoUninitialize();WriteLog(Format('Worker thread:%d end', [Worker^.ID]));SetEvent(Worker^.Finished);end;end;procedure CreateWorkerThread(CompletionPort: THandle);varWorker, Workers: PWorker;i: Integer;SystemInfo: TSystemInfo;ThreadHandle: THandle;beginGetSystemInfo(SystemInfo);Workers := nil;WorkerCount := (SystemInfo.dwNumberOfProcessors * 2 + 2);for i := 1 to WorkerCount dobeginWorker := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, sizeof(TWorker));if Workers = nil thenbeginWorkers := Worker;WorkerHead := Workers;end elsebeginWorkers^.Next := Worker;Workers := Worker;end;Worker^.CompletionPort := CompletionPort;Worker^.Data := OnWorkerThreadCreateEvt(False);Worker^.Finished := CreateEvent(nil, True, False, nil);ThreadHandle := CreateThread(nil, 0, @WorkerThread, Worker, 0, Worker^.ID);if ThreadHandle 0 thenCloseHandle(ThreadHandle);end;Workers^.Next := nil;end;procedure DestroyWorkerThread();varWorker, Save: PWorker;beginWorkerCount := 0;Worker := WorkerHead;while Worker nil dobeginPostQueuedCompletionStatus(Worker^.CompletionPort, 0, 0, nil);Worker := Worker^.Next;end;Worker := WorkerHead;while Worker nil dobeginwith Worker^ dobeginWaitForSingleObject(Worker^.Finished, INFINITE);CloseHandle(Worker^.Finished);Save := Worker^.Next;end;HeapFree(GetProcessHeap(), HEAP_NO_SERIALIZE, Worker);Worker := Save;end;end;function GetWorkerExecInfo(Index: Integer; var TickCount: DWord): Integer;varWorker: PWorker;Count: Integer;beginWorker := WorkerHead;Count := 0;Result := 0;while Worker nil dowith Worker^ dobeginCount := Count + 1;if Count = Index thenbeginTickCount := TickCountLong;TickCountLong := 0;Result := Worker^.ExecCount;break;end;Worker := Worker^.Next;end;end;function GetWorkerID(Index: Integer): Integer;varWorker: PWorker;Count: Integer;beginWorker := WorkerHead;Count := 0;while Worker nil dobeginCount := Count + 1;if Count = Index thenbeginCount := Worker^.ID;break;end;Worker := Worker^.Next;end;Result := Count;end;{===============================================================================服务线程================================================================================}function OnServerThreadCreateDef(IsWorkerThread: Boolean): Pointer;beginResult := nil;end;varListenSocket: TSocket = INVALID_SOCKET;SocketEvent: THandle = WSA_INVALID_EVENT;CompletionPort: THandle = 0;Terminated: Boolean = False;ServerThreadID: DWORD = 0;ServerExecCount: Integer = 0;ServerExecLong: DWord = 0;OnServerThreadCreateEvt: TOnThreadCreateEvt = OnServerThreadCreateDef;ServerFinished: THandle;function GetServerExecCount(): Integer;beginResult := ServerExecCount;end;function GetServerExecLong(): DWord;beginResult := ServerExecLong;ServerExecLong := 0;end;function ServerThread(Param: Pointer): DWORD; stdcall;varAcceptSocket: TSocket;Addr: TSockAddrIn;Len: Integer;Link: PLink;IOMem: Pointer;bNodelay: Boolean;TickCount: DWord;WR: DWord;beginResult := 0;CoInitialize(nil);WriteLog('Server thread begin');TickCount := GetTickCount();trywhile not Terminated dobegintryServerExecLong := ServerExecLong + (GetTickCount() - TickCount);WR := WaitForSingleObject(SocketEvent, 10000);ServerExecCount := ServerExecCount + 1;TickCount := GetTickCount();if (WAIT_TIMEOUT = WR) thenbeginCheckLinkLinkIdleOvertime(Param);continue;end elseif (WAIT_FAILED = WR) thenbegincontinue;end elsebeginLen := SizeOf(TSockAddrIn);AcceptSocket := WSAAccept(ListenSocket, @Addr, @Len, nil, 0);if (AcceptSocket = INVALID_SOCKET) thencontinue;if LinkCount >= SOCK_MAX_COUNT thenbegintryCloseSocket(AcceptSocket);exceptWriteLog('Link count over');end;continue;end;bNodelay := True;if SetSockOpt(AcceptSocket, IPPROTO_TCP, TCP_NODELAY,PChar(@bNodelay), sizeof(bNodelay)) = SOCKET_ERROR thenbegintryCloseSocket(AcceptSocket);exceptWriteLog('SetSockOpt: error');end;continue;end;EnterCriticalSection(LinkSec);Link := GetLink();with Link^ dobeginEnterCriticalSection(Section);RemoteIP := inet_ntoa(Addr.sin_addr);RemotePort := Addr.sin_port;TickCountActive := GetTickCount();Socket := AcceptSocket;IOMem := GetIOMem();if (CreateIoCompletionPort(AcceptSocket, CompletionPort, DWORD(Link), 0) = 0) or(not PostRecv(Link, IOMem)) thenbegintryCloseSocket(Socket);exceptWriteLog('CreateIoCompletionPort or PostRecv: error');end;Socket := INVALID_SOCKET;FreeLink(Link);FreeIOMem(IOMem);end;LeaveCriticalSection(Section);end;LeaveCriticalSection(LinkSec);end;exceptWriteLog('Server thread error');end;end;finallyCoUninitialize();WriteLog('Server thread end');SetEvent(ServerFinished);end;end;function StartTcpServer(RemoteIP: String; RemotePort: DWord): Boolean;varNonBlock: Integer;bNodelay: Boolean;Addr: TSockAddrIn;ThreadHandle: THANDLE;beginResult := ListenSocket = INVALID_SOCKET;if not Result thenexit;IniIOMem();IniLink();ListenSocket := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);Result := ListenSocket INVALID_SOCKET;if not Result thenbeginDeleteLink();DeleteIOMem();exit;end;bNodelay := True;NonBlock := 1;Addr.sin_family := AF_INET;Addr.sin_addr.s_addr := inet_addr(PChar(RemoteIP));Addr.sin_port := htons(RemotePort);Result := (SetSockOpt(ListenSocket, IPPROTO_TCP, TCP_NODELAY, PChar(@bNodelay), sizeof(bNodelay)) SOCKET_ERROR) and(ioctlsocket(ListenSocket, Integer(FIONBIO), NonBlock) SOCKET_ERROR) and(Bind(ListenSocket, @Addr, SizeOf(TSockAddrIn)) SOCKET_ERROR) and(Listen(ListenSocket, SOMAXCONN) SOCKET_ERROR);if not Result thenbeginListenSocket := INVALID_SOCKET;DeleteLink();DeleteIOMem();exit;end;SocketEvent := CreateEvent(nil, FALSE, FALSE, nil);Result := (SocketEvent WSA_INVALID_EVENT);if (not Result) thenbeginCloseSocket(ListenSocket);ListenSocket := INVALID_SOCKET;DeleteLink();DeleteIOMem();exit;end;Result := (WSAEventSelect(ListenSocket, SocketEvent, FD_ACCEPT) SOCKET_ERROR);if not Result thenbeginCloseSocket(ListenSocket);ListenSocket := INVALID_SOCKET;WSACloseEvent(SocketEvent);SocketEvent := WSA_INVALID_EVENT;DeleteLink();DeleteIOMem();exit;end;CompletionPort := CreateIoCompletionPort(INVALID_HANDLE_value, 0, 0, 0);Result := CompletionPort 0;if not Result thenbeginCloseSocket(ListenSocket);ListenSocket := INVALID_SOCKET;WSACloseEvent(SocketEvent);SocketEvent := WSA_INVALID_EVENT;DeleteLink();DeleteIOMem();exit;end;WriteLog('Server Start');CreateWorkerThread(CompletionPort);ServerFinished := CreateEvent(nil, True, False, nil);Result := ServerFinished 0;if not Result thenbeginCloseSocket(ListenSocket);ListenSocket := INVALID_SOCKET;WSACloseEvent(SocketEvent);SocketEvent := WSA_INVALID_EVENT;DeleteLink();DeleteIOMem();exit;end;Terminated := False;ThreadHandle := CreateThread(nil, 0, @ServerThread, OnServerThreadCreateEvt(False), 0, ServerThreadID);if (ThreadHandle = 0) thenbeginStopTcpServer();exit;end;CloseHandle(ThreadHandle);end;function StopTcpServer(): Boolean;beginResult := ListenSocket INVALID_SOCKET;if not Result thenexit;WriteLog('Server Stop');Terminated := True;if ServerFinished 0 thenbeginWaitForSingleObject(ServerFinished, INFINITE);CloseHandle(ServerFinished);ServerFinished := 0;end;if SocketEvent 0 thenWSACloseEvent(SocketEvent);SocketEvent := 0;DestroyWorkerThread();if ListenSocket INVALID_SOCKET thenCloseSocket(ListenSocket);ListenSocket := INVALID_SOCKET;if CompletionPort 0 thenCloseHandle(CompletionPort);CompletionPort := 0;ServerExecCount := 0;ServerExecLong := 0;DeleteLink();DeleteIOMem();end;function GetLocalIP(IsIntnetIP: Boolean): String;typeTaPInAddr = Array[0..10] of PInAddr;PaPInAddr = ^TaPInAddr;varphe: PHostEnt;pptr: PaPInAddr;Buffer: Array[0..63] of Char;I: Integer;beginResult := '0.0.0.0';tryGetHostName(Buffer, SizeOf(Buffer));phe := GetHostByName(buffer);if phe = nil thenExit;pPtr := PaPInAddr(phe^.h_addr_list);if IsIntnetIP thenbeginI := 0;while pPtr^[I] nil dobeginResult := inet_ntoa(pptr^[I]^);Inc(I);end;end elseResult := inet_ntoa(pptr^[0]^);exceptend;end;procedure SetEventProc(OnReceive: TOnReceiveEvt;OnDisconnect: TOnDisconnectEvt;OnLinkIdleOvertime: TOnLinkIdleOvertimeEvt;OnServerThreadCreate: TOnThreadCreateEvt;OnWorkerThreadCreate: TOnThreadCreateEvt);beginOnReceiveEvt := OnReceive;OnDisconnectEvt := OnDisconnect;OnLinkIdleOvertimeEvt := OnLinkIdleOvertime;OnServerThreadCreateEvt := OnServerThreadCreate;OnWorkerThreadCreateEvt := OnWorkerThreadCreate;end;function PostRecv(Link: PLink; IOMem: Pointer): Boolean;varFlags: DWord;Bytes: DWord;IOInfo: PIOInfo;beginResult := Link^.Socket INVALID_SOCKET;if Result thentryFlags := 0;Bytes := 0;IOInfo := PIOInfo(Integer(IOMem) - sizeof(TIOInfo));with IOInfo^ dobeginZeroMemory(IOInfo, sizeof(TIOInfo));DataBuf.buf := IOMem;DataBuf.len := IO_MEM_SIZE;Socket := Link^.Socket;Flag := IO_READ;Result := (WSARecv(Socket, @DataBuf, 1, @Bytes, @Flags, @Overlapped, nil) SOCKET_ERROR) or(WSAGetLastError() = ERROR_IO_PENDING);end;exceptResult := False;WriteLog('PostRecv: error');end;end;function PostSend(Link: PLink; IOMem: Pointer; Len: Integer): Boolean;varBytes: DWord;IOInfo: PIOInfo;beginResult := Link^.Socket INVALID_SOCKET;if Result thentryBytes := 0;IOInfo := PIOInfo(Integer(IOMem) - sizeof(TIOInfo));with IOInfo^ dobeginZeroMemory(IOInfo, sizeof(TIOInfo));DataBuf.buf := IOMem;DataBuf.len := Len;Socket := Link^.Socket;Flag := IO_WRITE;Result := (WSASend(Socket, @(DataBuf), 1, @Bytes, 0, @(Overlapped), nil) SOCKET_ERROR) or(WSAGetLastError() = ERROR_IO_PENDING);end;exceptResult := False;WriteLog('PostSend: error');end;end;procedure PostBroadcast(Buf: PByte; Len: Integer);varIOMem: Pointer;Link: PLink;beginEnterCriticalSection(LinkSec);Link := LinksHead;while Link nil dowith Link^ dobeginif Socket INVALID_SOCKET thenbeginIOMem := GetIOMem();CopyMemory(IOMem, Buf, Len);if not PostSend(Link, IOMem, Len) thenFreeIOMem(IOMem);end;Link := Link^.Next;end;LeaveCriticalSection(LinkSec);end;function IsTcpServerActive(): Boolean;beginResult := ListenSocket INVALID_SOCKET;end;{===============================================================================日志管理================================================================================}varLogSec: TRTLCriticalSection;Inifile: TIniFile;LogCount: Integer = 0;LogName: String = '';procedure WriteLog(Log: String);beginEnterCriticalSection(LogSec);tryLogCount := LogCount + 1;IniFile.WriteString(LogName,'Index' + IntToStr(LogCount),DateTimeToStr(Now()) + ':' + Log);finallyLeaveCriticalSection(LogSec);end;end;{===============================================================================初始化Window Socket================================================================================}varWSAData: TWSAData;procedure Startup;varErrorCode: Integer;beginErrorCode := WSAStartup( {$SK_blogItemTitle$}{$SK_ItemBody$}{$SK_blogDiary$} {$SK_blogItemLink$} {$SK_blogItemComm$} {$SK_blogItemQuote$} {$SK_blogItemVisit$}01, WSAData);if ErrorCode 0 thenWriteLog('Window Socket init Error!');end;procedure Cleanup;varErrorCode: Integer;beginErrorCode := WSACleanup;if ErrorCode 0 thenWriteLog('Window Socket cleanup error!');end;function GetExePath(): String;varModuleName: array[0..1024] of char;beginGetModuleFileName(MainInstance, ModuleName, SizeOf(ModuleName));Result := ExtractFilePath(ModuleName);end;initializationLogName := DateTimeToStr(Now());InitializeCriticalSection(LogSec);ExePath := GetExePath();IniFile := TIniFile.Create(ExePath + 'Logs.Ini');Startup();finalizationCleanup();DeleteCriticalSection(LogSec);IniFile.Destroy();end.主窗口单元源码：unit uMainTcpServerIOCP;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ExtCtrls, StdCtrls, ComCtrls, UTcpServer, Sockets, Grids;typeTfrmMainUTcpServerIOCP = class(TForm)Label1: TLabel;Label2: TLabel;edtIP: TEdit;edtPort: TEdit;btn: TButton;Timer1: TTimer;Label3: TLabel;lbIO: TLabel;Label5: TLabel;lbIOU: TLabel;Label7: TLabel;lbL: TLabel;Label9: TLabel;lbLU: TLabel;Label11: TLabel;lbLS: TLabel;Label13: TLabel;lbW: TLabel;Info: TStringGrid;Label4: TLabel;lbWC: TLabel;Label8: TLabel;lbWU: TLabel;Label12: TLabel;lbLF: TLabel;Label15: TLabel;lbLFL: TLabel;Label6: TLabel;lbIOF: TLabel;lbIOFL: TLabel;Label16: TLabel;Timer2: TTimer;procedure btnClick(Sender: TObject);procedure FormCreate(Sender: TObject);procedure Timer1Timer(Sender: TObject);procedure FormDestroy(Sender: TObject);procedure Timer2Timer(Sender: TObject);private{ Private declarations }FTickCount: DWord;public{ Public declarations }end;varfrmMainUTcpServerIOCP: TfrmMainUTcpServerIOCP;implementation{$R *.dfm}{ TfrmMainUTcpServerIOCP }procedure TfrmMainUTcpServerIOCP.btnClick(Sender: TObject);vari: Integer;C1: Integer;C2: DWord;DT: TDateTime;beginif btn.Caption = 'Open' thenbeginStartTcpServer(edtIP.Text, StrToInt(edtPort.Text));if IsTcpServerActive() thenbeginFTickCount := GetTickCount();Info.RowCount := GetWorkerCount() + 1;DT := Now();for i := 1 to Info.RowCount - 1 dobeginInfo.Cells[0, i] := IntToStr(i);Info.Cells[1, i] := IntToStr(GetWorkerID(i));C1 := GetWorkerExecInfo(i, C2);Info.Cells[2, i] := IntToStr(C1);Info.Cells[3, i] := '0';Info.Cells[4, i] := IntToStr(C2);Info.Cells[5, i] := '0';Info.Cells[6, i] := DateTimeToStr(DT);end;Timer1.Enabled := True;end;end elsebeginTimer1.Enabled := False;StopTcpServer();end;if IsTcpServerActive() thenbtn.Caption := 'Close'elsebtn.Caption := 'Open';end;procedure TfrmMainUTcpServerIOCP.FormCreate(Sender: TObject);beginedtIP.Text := GetLocalIP(False);Info.ColCount := 7;Info.RowCount := 2;Info.ColWidths[0] := 30;Info.ColWidths[1] := 30;Info.ColWidths[2] := 40;Info.ColWidths[3] := 40;Info.ColWidths[4] := 30;Info.ColWidths[5] := 40;Info.ColWidths[6] := 110;Info.Cells[0, 0] := '序号';Info.Cells[1, 0] := 'ID';Info.Cells[2, 0] := '计数';Info.Cells[3, 0] := '次／S';Info.Cells[4, 0] := '时长';Info.Cells[5, 0] := '使用率';Info.Cells[6, 0] := '时间';end;procedure TfrmMainUTcpServerIOCP.Timer1Timer(Sender: TObject);vari: Integer;Count1, Count2, Count3, TC, TCC: DWord;beginif not IsTcpServerActive() thenbeginTimer1.Enabled := False;exit;end;TC := GetTickCount();TCC := TC - FTickCount;if TCC = 0 thenTCC := $FFFFFFFF;lbWC.Caption := IntToStr(GetServerExecCount());lbWU.Caption := FloatToStrF(GetServerExecLong() / TCC * 100, ffFixed, 10, 3) + '%';for i := 1 to Info.RowCount - 1 dobeginCount1 := GetWorkerExecInfo(i, Count2);TC := GetTickCount();TCC := TC - FTickCount;if TCC = 0 thenTCC := $FFFFFFFF;Count3 := StrToInt(Info.Cells[2, i]);if Count1 Count3 thenbeginInfo.Cells[2, i] := IntToStr(Count1);Info.Cells[3, i] := IntToStr(Count1 - Count3);Info.Cells[4, i] := IntToStr(Count2);Info.Cells[5, i] := FloatToStrF(Count2 / TCC * 100, ffFixed, 10, 1) + '%';Info.Cells[6, i] := DateTimeToStr(Now());end;end;FTickCount := TC;lbIO.Caption := IntToStr(GetIOMemSize());lbIOU.Caption := FloatToStrF(GetIOMemUse(), ffFixed, 10, 3) + '%';Count1 := GetIOMemFree();lbIOF.Caption := IntToStr(Count1);lbIOFL.Caption := FloatToStrF(Count1 / IO_MEM_MAX_COUNT * 100, ffFixed, 10, 3) + '%';lbW.Caption := IntToStr(GetWorkerCount());lbL.Caption := IntToStr(GetLinkSize());Count1 := GetLinkFree();lbLF.Caption := IntToStr(Count1);lbLFL.Caption := FloatToStrF(Count1 / SOCK_MAX_COUNT * 100, ffFixed, 10, 3) + '%';lbLU.Caption := FloatToStrF(GetLinkUse(), ffFixed, 10, 3) + '%';lbLS.Caption := IntToStr(GetLinkCount());end;procedure TfrmMainUTcpServerIOCP.FormDestroy(Sender: TObject);beginStopTcpServer();end;procedure TfrmMainUTcpServerIOCP.Timer2Timer(Sender: TObject);beginif not IsTcpServerActive() thenbeginTimer1.Enabled := False;exit;end;PostBroadcast(PByte(PChar('这是来自服务器的数据!')), 21);end;end.