好的，贴部分(全部代码太长了)：
uses .....,winsock2;
// winsock2中的WSAAccept的定义已修正，原先第二个参数的定义是：addr : TSockAddr;，现已改正成 addr : PSockAddr;
....
procedure TCPListenSock.DoOpen;
begin
if not active then
begin
fsock := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, 1); // 创建一个带overlapped标志的socket
if fsock<0 then
begin
exit;
end;
if bind(fsock, @faddr, sizeof(TSockAddrIn)) = SOCKET_ERROR then // faddr 为 TSockAddrIn结构，已经初始化
begin
closesocket(fsock);
fsock := -1;
exit;
end;
if listen(fsock, 5) = SOCKET_ERROR then
begin
closesocket(fsock);
fsock := -1;
exit;
end;
FListenThrd := TCPListenThread.Create(self);
end;
end;
.....
procedure TCPListenThread.Execute;
var
ASock: Integer;
begin
FreeOnTerminate := True;
while not terminated do
try
ASock := WSAAccept(FOwner.FSock, nil, nil, nil, 0);
if terminated then break;
if ASock <> SOCKET_ERROR then
try
fowner.DoAccept(asock);
except
end
else
break;
except
break;
end;
end;
....
procedure TCPListenSock.DoAccept(ASocket: Integer);
var
addr: TSockAddrIn;
l, n, f: cardinal;
c: TCPListenClient;
ov: PCPOverlapped;
begin
l := sizeof(addr);
if (getpeername(asocket, addr, integer(l))<>SOCKET_ERROR) and docheckaccept(asocket, @addr) then
begin
c := FClientType.CreateWithSocket(self, ASocket, @addr); // 创建client类实例
if not completionport.BindUsr(c) then // 关联到完成端口
begin
completionport.RemoveKey(c.FCPKey);
closesocket(c.FSock);
exit;
end
else begin
c.Lock;
c.OnOpen := doclientopen;
c.OnClose := doclientleave;
c.OnReceived := doreceived;
add(c.FSock, c); // 将client加入到 Server的Clients列表中
c.UnLock;
c.Open; // 调用 c.OnOpen事件
ov := completionport.GetOverlapped; // 分配一个扩展的OverLapped结构
ov^.IsRead := true; // 读操作
setlength(ov^.SendingData, MAX_READ_BLOCK); // 设置读取缓冲区
ov^.Buffer.len := length(ov^.SendingData); // 填写WSABUF结构
ov^.Buffer.buf := pchar(integer(ov^.SendingData));
f := 0;
n := WSARecv(c.FSock, @(ov^.buffer), 1, l, f, PWSAOverlapped(ov), nil);
if integer
= SOCKET_ERROR then
begin
n := wsagetlasterror; // 郁闷，返回10022
if integer
<> WSA_IO_PENDING then
begin
c.doclose;
exit;
end;
end;
end;
end;
end;
PCPOverlapped的定义：
TCPOverlapped = record
Overlapped: _OVERLAPPED;
OVKey: Integer;
IsRead: Boolean;
Buffer: WSABUF;
SendingData: string;
end;
PCPOverlapped = ^TCPOverlapped;
TCompletionPort的定义：
TCompletionPort = class
public
WorkThrds: array of TCPWorkThread; // 工作线程
Handle: Integer; // completion port handle
//************ User List **************//
UsrLock: TRTLCriticalSection;
WaitUsers: array of TCPSocket;
DelUsers: array of Integer;
UsrCnt: Integer;
DelUsrCnt: Integer;
//*************************************//
//*********** Overlapped structs **************//
OvLock: TRTLCriticalSection;
Overlaps: array of PCPOverlapped;
DelOverlaps: array of Integer;
OvCnt: Integer;
DelOvCnt: Integer;
//********************************************//
constructor Create;
destructor Destroy; override;
function BindUsr(AUsr: TCPSocket): Boolean; // 将一个client连接绑定到完成端口
function GetOverlapped: PCPOverlapped; // 分配一个Overlapped结构
procedure RemoveOverlapped(Ov: PCPOverlapped); // 释放一个Overlapped结构
function GetCPKey(AUsr: TCPSocket): Integer; // 分配一个CompletionPort Key
procedure RemoveKey(AKey: Integer); // 释放一个CompletionPort Key
function GetUser(AKey: Integer): TCPSocket; //根据Key查找Client
function WaitJobs(var Usr: TCPSocket; var Ov: PCPOverLapped; var Len: Integer): Boolean; // 等待CompletionPort的完成通知并填写相关信息
end;
]