高性能的Socket通讯服务器(完成端口模型IOCP)
高性能的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 record
Overlapped: TOverlapped; //重叠结构
DataBuf: TWSABUF; //IO数据信息
Socket: TSocket;
Flag: TIOFlag;
TickCountSend: DWord;
Next: PIOInfo;
Prior: PIOInfo;
end;
PUNode =^ TUNode;
TUNode = record
Next: Pointer;
end;
PIOMem =^ TIOMem;
TIOMem = packed record
IOInfo: TIOInfo;
    Da
    //申请内存的时候,返回的是Da
end;
2、链路数据管理
采用双向链表结构,减少删除节点时遍历消耗的时间
//每个连接的信息
PLink =^ TLink;
TLink = record
Socket: TSocket;
RemoteIP: string[30];
RemotePort: DWord;
//最后收到数据时的系统节拍
TickCountActive: DWord;
//处理该连接的当前线程的信息
Worker: PWorker;
    Da
Section: TRTLCriticalSection;
Next: PLink;
Prior: PLink;
end;
二、如何管理线程
  每个工作线程创建的时候,调用:On
//工作线程信息
PWorker =^ TWorker;
TWorker = record
ID: THandle;
CompletionPort: THandle;
    Da
//用于反应工作情况的数据
TickCountLong,
TickCountActive: DWord;
ExecCount: Integer;
//线程完成后设置
Finished: THandle;
Next: PWorker;
end;
同理,服务线程也是具有一样的特点。相见源码。
关于线程同步,一直是众多程序头疼的问题。在本例程中,尽量避免了过多的互斥,并有效地防止了死锁现象。用RTLCriticalSection,稍微不注意,就会造成死锁的灾难。哪怕是两行代码的差别,对多线程而言都是灾难的。在本例程中,对数据同步需要操作的是在维护链路链表方面上。服务线程需要计算哪个连接空闲超时了,工作线程需要处理断线情况,应用层主动发送数据时需要对该链路独占,否则一个在发送,一个在处理断线故障,就会发送冲突,导致灾难后果。
在本人的压力测试中,已经有效的解决了这个问题,应用层部分不需要做什么同步工作,可以安心的收发数据了。同时每个线程都支持了数据库连接。
三、到底要创建多少个工作线程合适
很多文章说,有N个CPU就创建N个线程,也有说N*2+2。最不喜欢说话不负责任的人了,本例程可以让刚入门 I/O CP 的人对它有更深入的了解。
例程测试结果:
 
 
四、该不该使用类
有人说,抛弃一切类,对于服务器而言,会为类付出很多代价,从我的观点看,为类付出代价的,主要是动态创建的原因。其实,类成员访问和结构成员访问一样,需要相对地址。如果都是预先创建的,两者没有多大的差别。本例程采用裸奔函数的方式,当然在应用层可以采用类来管理,很难想象,如果没有没有类,需要多做多少工作。
五、缺点
不能发大数据包,只能发不超过固定数的数据包。但对于小数据报而言,它将是优秀的。
时间原因,不能做太多的解释和对代码做太多的注释,需要例程源码的可以和本人联系,免费提供。QQ:48092788
完成端口通讯服务模块源码: 
{****************************************************************************** 
*                      UCode 系列组件、控件                                  * 
*                  作者:卢益贵        2003~2009                          * 
*      版权所有    任何未经授权的使用和销售,均保留追究法律责任的权力        * 
*                                                                            * 
*      UCode 系列由XCtrls-YCtrls-ICtrls-NCode系列演变而来                  * 
*          QQ:48092788        luyigui.blog.gxsky.com                        * 
******************************************************************************} 
{****************************************************************************** 
                    完成端口模型的socket服务器 
******************************************************************************} 
unit UTcpServer; 
interface 
uses 
  Windows, 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 = record 
    ID: THandle; 
    CompletionPort: THandle; 
    Da
    //用于反应工作情况的数据 
    TickCountLong, 
    TickCountActive: DWord; 
    ExecCount: Integer; 
    //线程完成后设置 
    Finished: THandle; 
    Next: PWorker; 
  end; 
  //每个连接的信息 
  PLink =^ TLink; 
  TLink = record 
    Socket: TSocket; 
    RemoteIP: string[30]; 
    RemotePort: DWord; 
    //最后收到数据时的系统节拍 
    TickCountActive: DWord; 
    //处理该连接的当前线程的信息 
    Worker: PWorker; 
    Da
    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; 
//获取工作线程的ID 
function GetWorkerID(Index: Integer): Integer; 
//获取工作线程数量 
function GetWorkerCount(): Integer; 
//打开一个IP端口,并监听 
function StartTcpServer(RemoteIP: String; RemotePort: DWord): Boolean; 
//停止并关闭一个IP端口 
function StopTcpServer(): Boolean; 
//设置响应事件的函数指针,在StartTcpServer之前调用 
procedure SetEventProc(On
                      On
                      On
                      On
                      On
//写日志文件 
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; 
implementation 
uses 
  IniFiles, SysUtils, ActiveX; 
var 
  ExePath: String = ''; 
const 
  HEAP_NO_SERIALIZE          = 1;  {非互斥, 此标记可允许多个线程同时访问此堆} 
  HEAP_GENERATE_EXCEPTIONS  = 4;  {当建立堆出错时, 此标记可激发一个异常并返回异常标识} 
  HEAP_ZERO_MEMORY          = 8;  {把分配的内存初始化为 0} 
  HEAP_REALLOC_IN_PLACE_ON
  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 record 
    Overlapped: TOverlapped;  //重叠结构 
    DataBuf: TWSABUF;          //IO数据信息 
    Socket: TSocket; 
    Flag: TIOFlag; 
    TickCountSend: DWord; 
    Next: PIOInfo; 
    Prior: PIOInfo; 
  end; 
  
  PUNode =^ TUNode; 
  TUNode = record 
    Next: Pointer; 
  end; 
  
  PIOMem =^ TIOMem; 
  TIOMem = packed record 
    IOInfo: TIOInfo; 
    Da
  end; 
var 
  IOMemHead: 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); 
  try 
    try 
      Result := @(IOMemHead^.Da
      IOMemHead := PUNode(IOMemHead)^.Next; 
      IOMemUse := IOMemUse + 1; 
    except 
      Result := nil; 
      WriteLog('GetIOMem: error'); 
    end; 
  finally 
    LeaveCriticalSection(IOMemSec); 
  end; 
end; 
procedure FreeIOMem(Mem: Pointer); 
begin 
  EnterCriticalSection(IOMemSec); 
  try 
    try 
      Mem := Pointer(Integer(Mem) - sizeof(TIOInfo)); 
      PUNode(Mem).Next := nil; 
      PUNode(IOMemLast)^.Next := Mem; 
      IOMemLast := Mem; 
      IOMemUse := IOMemUse - 1; 
    except 
      WriteLog('FreeIOMem: error'); 
    end; 
  finally 
    LeaveCriticalSection(IOMemSec); 
  end; 
end; 
procedure IniIOMem(); 
var 
  i: Integer; 
  Heap: THandle; 
begin 
  InitializeCriticalSection(IOMemSec); 
  IOMemHead := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, sizeof(TIOMem)); 
  IOMemLast := IOMemHead; 
  IOMemList[1] := IOMemHead; 
  Heap := GetProcessHeap(); 
  for i := 2 to IO_MEM_MAX_COUNT do 
  begin 
    PUNode(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; 
var 
  IOMems: PUNode; 
begin 
  EnterCriticalSection(IOMemSec); 
  Result := 0; 
  IOMems := PUNode(IOMemHead); 
  while IOMems <> nil do 
  begin 
    Result := Result + 1; 
    IOMems := IOMems^.Next; 
  end; 
  LeaveCriticalSection(IOMemSec); 
end; 
procedure DeleteIOMem(); 
var 
  i: Integer; 
  Heap: THandle; 
begin 
  Heap := GetProcessHeap(); 
  for i := 1 to IO_MEM_MAX_COUNT do 
    HeapFree(Heap, HEAP_NO_SERIALIZE, IOMemList[i]); 
  IOMemUse := 0; 
  DeleteCriticalSection(IOMemSec); 
end; 
function GetIOMemSize(): Integer; 
begin 
  Result := IO_MEM_MAX_COUNT * sizeof(TIOMem); 
end; 
function GetIOMemUse(): Real; 
begin 
  Result := (IOMemUse * 100) / IO_MEM_MAX_COUNT; 
end; 
{=============================================================================== 
                              Socket链路管理 
================================================================================} 
procedure On
begin 
end; 
var 
  LinkHead: PLink = nil; 
  LinkLast: PLink = nil; 
  LinkUse: Integer = 0; 
  LinkCount: Integer = 0; 
  LinkSec: TRTLCriticalSection; 
  LinkList: array[1..SOCK_MAX_COUNT] of PLink; 
  On
  LinksHead: PLink = nil; 
  LinksLast: PLink = nil; 
function GetLinkFree(): Integer; 
var 
  Links: PLink; 
begin 
  EnterCriticalSection(LinkSec); 
  Result := 0; 
  Links := LinkHead; 
  while Links <> nil do 
  begin 
    Result := Result + 1; 
    Links := Links^.Next; 
  end; 
  LeaveCriticalSection(LinkSec); 
end; 
function GetLink(): PLink; 
begin 
  try 
    //内存要足够用,如果不够,即使是动态分配,神仙也救不了 
    Result := LinkHead; 
    LinkHead := LinkHead^.Next; 
    LinkUse := LinkUse + 1; 
    LinkCount := LinkCount + 1; 
    if LinksHead = nil then 
    begin 
      LinksHead := Result; 
      LinksHead^.Next := nil; 
      LinksHead^.Prior := nil; 
      LinksLast := LinksHead; 
    end else 
    begin 
      Result^.Prior := LinksLast; 
      LinksLast^.Next := Result; 
      LinksLast := Result; 
      LinksLast^.Next := nil; 
    end; 
    with Result^ do 
    begin 
      Socket := INVALID_SOCKET; 
      RemoteIP := ''; 
      RemotePort := 0; 
      TickCountActive := GetTickCount(); 
      Worker := nil; 
      Da
    end; 
  except 
    Result := nil; 
    WriteLog('GetLink: error'); 
  end; 
end; 
procedure FreeLink(Link: PLink); 
begin 
  try 
    with Link^ do 
    begin 
      Link^.Worker := nil; 
      if Link = LinksHead then 
      begin 
        LinksHead := Next; 
        if LinksLast = Link then 
          LinksLast := LinksHead 
        else 
          LinksHead^.Prior := nil; 
      end else 
      begin 
        Prior^.Next := Next; 
        if Next <> nil then 
          Next^.Prior := Prior; 
        if Link = LinksLast then 
          LinksLast := Prior; 
      end; 
      Next := nil; 
      LinkLast^.Next := Link; 
      LinkLast := Link; 
      LinkUse := LinkUse - 1; 
      LinkCount := LinkCount - 1; 
    end; 
  except 
    WriteLog('FreeLink: error'); 
  end; 
end; 
procedure CloseLink(Link: PLink); 
begin 
  EnterCriticalSection(LinkSec); 
  with Link^ do 
  begin 
    EnterCriticalSection(Section); 
    if Socket <> INVALID_SOCKET then 
    begin 
      try 
        CloseSocket(Socket); 
      except 
        WriteLog('CloseSocket: error'); 
      end; 
      Socket := INVALID_SOCKET; 
      FreeLink(Link); 
    end; 
    LeaveCriticalSection(Link^.Section); 
  end; 
  LeaveCriticalSection(LinkSec); 
end; 
procedure CheckLinkLinkIdleOvertime(Da
var 
  TickCount: DWord; 
  Long: Integer; 
  Link: PLink; 
begin 
  EnterCriticalSection(LinkSec); 
  try 
    TickCount := GetTickCount(); 
    Link := LinksHead; 
    while Link <> nil do 
    with Link^ do 
    begin 
      EnterCriticalSection(Section); 
      if Socket <> INVALID_SOCKET then 
      begin 
        if TickCount > TickCountActive then 
          Long := TickCount - TickCountActive 
        else 
          Long := $FFFFFFFF - TickCountActive + TickCount; 
        if SOCK_IDLE_OVERTIME * 1000 < Long then 
        begin 
          try 
            CloseSocket(Socket); 
          except 
            WriteLog('CloseSocket overtime: error'); 
          end; 
          Socket := INVALID_SOCKET; 
          Worker := Da
          try 
            On
          except 
            WriteLog('On
          end; 
          Worker := nil; 
          FreeLink(Link); 
          LeaveCriticalSection(Section); 
          break; 
        end; 
      end else 
      begin 
        LeaveCriticalSection(Section); 
        break; 
      end; 
      LeaveCriticalSection(Section); 
      Link := Link^.Next; 
    end; 
  except 
    WriteLog('CheckLinkLinkIdleOvertime: error'); 
  end; 
  LeaveCriticalSection(LinkSec); 
end; 
procedure IniLink(); 
var 
  i: Integer; 
  Heap: THandle; 
begin 
  InitializeCriticalSection(LinkSec); 
  LinkHead := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, sizeof(TLink)); 
  InitializeCriticalSection(LinkHead^.Section); 
  LinkLast := LinkHead; 
  LinkList[1] := LinkHead; 
  Heap := GetProcessHeap(); 
  for i := 2 to SOCK_MAX_COUNT do 
  begin 
    LinkLast^.Next := HeapAlloc(Heap, HEAP_ZERO_MEMORY, sizeof(TLink)); 
    LinkLast := LinkLast^.Next; 
    InitializeCriticalSection(LinkLast^.Section); 
    LinkList[i] := LinkLast; 
  end; 
  LinkLast.Next := nil; 
end; 
procedure DeleteLink(); 
var 
  i: Integer; 
  Heap: THandle; 
begin 
  Heap := GetProcessHeap(); 
  for i := 1 to SOCK_MAX_COUNT do 
  begin 
    DeleteCriticalSection(LinkList[i]^.Section); 
    HeapFree(Heap, HEAP_NO_SERIALIZE, LinkList[i]); 
  end; 
  LinkUse := 0; 
  LinkCount := 0; 
  LinksHead := nil; 
  LinksLast := nil; 
  DeleteCriticalSection(LinkSec); 
end; 
function GetLinkSize(): Integer; 
begin 
  Result := SOCK_MAX_COUNT * sizeof(TLink); 
end; 
function GetLinkUse(): real; 
begin 
  Result := (LinkUse * 100) / SOCK_MAX_COUNT; 
end; 
function GetLinkCount(): Integer; 
begin 
  Result := LinkCount; 
end; 
{=============================================================================== 
                              工作线程 
================================================================================} 
procedure On
begin 
end; 
function On
var 
  IOMem: Pointer; 
  i: Integer; 
begin 
  Result := True;                  
  IOMem := GetIOMem(); 
  CopyMemory(IOMem, Buf, Len); 
  i := 1000000; 
  while i > 0 do 
    i := i - 1; 
  if not PostSend(Link, IOMem, Len) then 
    FreeIOMem(IOMem); 
end; 
function On
begin 
  Result := nil; 
end; 
var 
  WorkerHead: PWorker = nil; 
  WorkerCount: Integer = 0; 
  On
  On
  On
function GetWorkerCount(): Integer; 
begin 
  Result := WorkerCount; 
end; 
function WorkerThread(Worker: PWorker): DWORD; stdcall; 
var 
  Link: PLink; 
  IOInfo: PIOInfo; 
  Bytes: DWord; 
  CompletionPort: THandle; 
begin 
  Result := 0; 
  CompletionPort := Worker^.CompletionPort; 
  with Worker^ do 
  begin 
    TickCountActive := GetTickCount(); 
    TickCountLong := 0; 
    ExecCount := 0; 
  end; 
  WriteLog(Format('Worker thread:%d begin', [Worker^.ID])); 
  CoInitialize(nil); 
  try 
    while True do 
    begin 
      try 
        with Worker^ do 
          TickCountLong := TickCountLong + GetTickCount() - TickCountActive; 
          
        if GetQueuedCompletionStatus(CompletionPort, Bytes, DWORD(Link), POverlapped(IOInfo), INFINITE) = False then 
        begin 
          if (Link <> nil) then 
          with Link^ do 
          begin 
            EnterCriticalSection(LinkSec); 
            EnterCriticalSection(Section); 
            if Link^.Socket <> INVALID_SOCKET then 
            begin 
              try 
                CloseSocket(Socket); 
              except 
                WriteLog(Format('CloseSocket1:%d error', [Worker^.ID])); 
              end; 
              Socket := INVALID_SOCKET; 
              Link^.Worker := Worker; 
              try 
                On
              except 
                WriteLog(Format('On
              end; 
              Link^.Worker := nil; 
              FreeLink(Link); 
            end; 
            LeaveCriticalSection(Section); 
            LeaveCriticalSection(LinkSec); 
          end; 
          if IOInfo <> nil then 
            FreeIOMem(IOInfo^.DataBuf.buf); 
          WriteLog(Format('GetQueuedCompletionStatus:%d error', [Worker^.ID])); 
          continue; 
        end; 
        
        with Worker^ do 
        begin 
          TickCountActive := GetTickCount(); 
          ExecCount := ExecCount + 1; 
        end; 
        if (Bytes = 0) then 
        begin 
          if (Link <> nil) then 
          with Link^ do 
          begin 
            EnterCriticalSection(LinkSec); 
            EnterCriticalSection(Section); 
            if Link^.Socket <> INVALID_SOCKET then 
            begin 
              try 
                CloseSocket(Socket); 
              except 
                WriteLog(Format('CloseSocket2:%d error', [Worker^.ID])); 
              end; 
              Socket := INVALID_SOCKET; 
              Link^.Worker := Worker; 
              try 
                On
              except 
                WriteLog(Format('On
              end; 
              Link^.Worker := nil; 
              FreeLink(Link); 
            end; 
            LeaveCriticalSection(Section); 
            LeaveCriticalSection(LinkSec); 
            if IOInfo.Flag = IO_WRITE then 
              FreeIOMem(IOInfo^.DataBuf.buf) 
            else 
              FreeIOMem(IOInfo^.DataBuf.buf); 
            continue; 
          end else 
          begin 
            if IOInfo <> nil then 
              FreeIOMem(IOInfo^.DataBuf.buf); 
            break; 
          end; 
        end; 
      
        if IOInfo.Flag = IO_WRITE then 
        begin 
          FreeIOMem(IOInfo^.DataBuf.buf); 
          continue; 
        end; 
        
        {if IOInfo.Flag = IO_ACCEPT then 
        begin 
          ...... 
          continue; 
        end;} 
        with Link^, IOInfo^.DataBuf do 
        begin 
          Link^.Worker := Worker; 
          try 
            On
          except 
            WriteLog(Format('On
          end; 
          Link^.Worker := nil; 
          TickCountActive := GetTickCount(); 
          if not PostRecv(Link, buf) then 
          begin 
            EnterCriticalSection(LinkSec); 
            EnterCriticalSection(Section); 
            if Socket <> INVALID_SOCKET then 
            begin 
              try 
                CloseSocket(Socket); 
              except 
                WriteLog(Format('CloseSocket3:%d error', [Worker^.ID])); 
              end; 
              Socket := INVALID_SOCKET; 
              Link^.Worker := Worker; 
              try 
                On
              except 
                WriteLog(Format('On
              end; 
              Link^.Worker := nil; 
              FreeLink(Link); 
            end; 
            LeaveCriticalSection(Section); 
            LeaveCriticalSection(LinkSec); 
            FreeIOMem(buf); 
          end; 
        end; 
      except 
        WriteLog(Format('Worker thread:%d error', [Worker^.ID])); 
      end; 
    end; 
  finally 
    CoUninitialize(); 
    WriteLog(Format('Worker thread:%d end', [Worker^.ID])); 
    SetEvent(Worker^.Finished); 
  end; 
end; 
procedure CreateWorkerThread(CompletionPort: THandle); 
var 
  Worker, Workers: PWorker; 
  i: Integer; 
  SystemInfo: TSystemInfo; 
  ThreadHandle: THandle; 
begin 
  GetSystemInfo(SystemInfo); 
  Workers := nil; 
  WorkerCount := (SystemInfo.dwNumberOfProcessors * 2 + 2); 
  for i := 1 to WorkerCount do 
  begin 
    Worker := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, sizeof(TWorker)); 
    if Workers = nil then 
    begin 
      Workers := Worker; 
      WorkerHead := Workers; 
    end else 
    begin 
      Workers^.Next := Worker; 
      Workers := Worker; 
    end; 
    Worker^.CompletionPort := CompletionPort; 
    Worker^.Da
    Worker^.Finished := CreateEvent(nil, True, False, nil); 
    ThreadHandle := CreateThread(nil, 0, @WorkerThread, Worker, 0, Worker^.ID); 
    if ThreadHandle <> 0 then 
      CloseHandle(ThreadHandle); 
  end; 
  Workers^.Next := nil; 
end; 
procedure DestroyWorkerThread(); 
var 
  Worker, Save: PWorker; 
begin 
  WorkerCount := 0; 
  Worker := WorkerHead; 
  while Worker <> nil do 
  begin 
    PostQueuedCompletionStatus(Worker^.CompletionPort, 0, 0, nil); 
    Worker := Worker^.Next; 
  end; 
  Worker := WorkerHead; 
  while Worker <> nil do 
  begin 
    with Worker^ do 
    begin 
      WaitForSingleObject(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; 
var 
  Worker: PWorker; 
  Count: Integer; 
begin 
  Worker := WorkerHead; 
  Count := 0; 
  Result := 0; 
  while Worker <> nil do 
  with Worker^ do 
  begin 
    Count := Count + 1; 
    if Count = Index then 
    begin 
      TickCount := TickCountLong; 
      TickCountLong := 0; 
      Result := Worker^.ExecCount; 
      break; 
    end; 
    Worker := Worker^.Next; 
  end; 
end; 
function GetWorkerID(Index: Integer): Integer; 
var 
  Worker: PWorker; 
  Count: Integer; 
begin 
  Worker := WorkerHead; 
  Count := 0; 
  while Worker <> nil do 
  begin 
    Count := Count + 1; 
    if Count = Index then 
    begin 
      Count := Worker^.ID; 
      break; 
    end; 
    Worker := Worker^.Next; 
  end; 
  Result := Count; 
end; 
 
                    
                 
                
            
         浙公网安备 33010602011771号
浙公网安备 33010602011771号