Socket I/O模型全接觸

 本文簡單介紹了當前Windows支持的各種Socket I/O模型，如果你發現其中存在什麼錯誤請務必賜教。

一：select模型
二：WSAAsyncSelect模型
三：WSAEventSelect模型
四：Overlapped I/O 事件通知模型
五：Overlapped I/O 完成例程模型
六：IOCP模型

老陳有一個在外地工作的女兒，不能經常回來，老陳和她通過信件聯繫。他們的信會被郵遞員投遞到他們的信箱裏。
這和Socket模型非常類似。下面我就以老陳接收信件爲例講解Socket I/O模型~~~

一：Select模型

老陳非常想看到女兒的信。以至於他每隔10分鐘就下樓檢查信箱，看是否有女兒的信~~~~~
在這種情況下，“下樓檢查信箱”然後回到樓上耽誤了老陳太多的時間，以至於老陳無法做其他工作。
select模型和老陳的這種情況非常相似：周而復始地去檢查......如果有數據......接收/發送.......

使用線程來select應該是通用的做法：
procedure TListenThread.Execute;
var
addr : TSockAddrIn;
fd_read : TFDSet;
timeout : TTimeVal;
ASock,
MainSock : TSocket;
len, i : Integer;
begin
MainSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
addr.sin_family := AF_INET;
addr.sin_port := htons(5678);
addr.sin_addr.S_addr := htonl(INADDR_ANY);
bind( MainSock, @addr, sizeof(addr) );
listen( MainSock, 5 );

while (not Terminated) do
begin
FD_ZERO( fd_read );
FD_SET( MainSock, fd_read );
timeout.tv_sec := 0;
timeout.tv_usec := 500;
if select( 0, @fd_read, nil, nil, @timeout ) > 0 then //至少有1個等待Accept的connection
begin
if FD_ISSET( MainSock, fd_read ) then
begin
for i:=0 to fd_read.fd_count-1 do //注意，fd_count <= 64，也就是說select只能同時管理最多64個連接
begin
len := sizeof(addr);
ASock := accept( MainSock, addr, len );
if ASock <> INVALID_SOCKET then
....//爲ASock創建一個新的線程，在新的線程中再不停地select
end;
end;
end;
end; //while (not self.Terminated)

shutdown( MainSock, SD_BOTH );
closesocket( MainSock );
end;

select模型

select已經是老掉牙的東西了，windows下很少用了，不過既然叫“全接觸”，還是寫出來吧！！！

首先創建一個listen線程(thrListen)負責監聽遠程機器的連接請求，
和遠程機器建立連接後，爲此連接專門創建一個線程(thrReadWrite)進行read/write。
注意，要使用“臨界區”保證線程對共享數據的安全訪問。

代碼很簡單，不多說了~~~~~~~~~~~~~~~~~~~~~~~~

unit thrListen;

interface

uses
Windows, Classes, SysUtils, Winsock2, thrReadWrite;

type
YConnection = record
thrRW : TRWThread;
hsock : TSocket;
dwIP : DWORD;
dwPort : DWORD;
end;
PConnection = ^YConnection;

type
TListenThread = class(TThread)
private
{ Private declarations }
FSock : TSocket; //主socket
FList : TList; //客戶連接線程列表
protected
procedure Execute; override;
end;

implementation

uses frmMain;

{ TListenThread }

procedure TListenThread.Execute;
var
addr : TSockAddrIn;
fd_read : TFDSet;
timeout : TTimeVal;
AConnect : PConnection;
len, i : Integer;
begin
FList:= TList.Create;

FSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );

addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

bind( FSock, @addr, sizeof(SOCKADDR) );
listen( FSock, 5 );//正在等待連接的最大隊列長度5

while (not Terminated) do
begin
FD_ZERO( fd_read );
FD_SET( FSock, fd_read );

timeout.tv_sec := 0;
timeout.tv_usec := 500;

if select( 0, @fd_read, nil, nil, @timeout ) > 0 then //至少有1個等待Accept的connection
begin
if FD_ISSET( FSock, fd_read ) then
begin
for i:=0 to fd_read.fd_count-1 do //注意，fd_count <= FD_SETSIZE(64)
begin
New( AConnect );
len := sizeof(addr);
AConnect^.hsock := accept( FSock, addr, len );
if AConnect^.hsock <> INVALID_SOCKET then
begin
AConnect^.dwIP := ntohl( addr.sin_addr.S_addr );
AConnect^.dwPort := ntohs( addr.sin_port );
AConnect^.thrRW := TRWThread.Create( True );
with AConnect^.thrRW do
begin
m_sock := AConnect^.hsock;
m_ip := AConnect^.dwIP;
m_port := AConnect^.dwPort;
m_itemid := AConnect;
FreeOnTerminate := True;
Resume;
end;

//修改客戶連接列表
FList.Add( AConnect );
len := FList.Count;
end else
begin
len := WSAGetLastError();
MessageBox( 0, PChar(IntToStr(len)), 'accept error', MB_ICONERROR );
Dispose( AConnect );
end;
end; //for i:=0 to fd_read.fd_count-1
end; //if FD_ISSET( m_sock, fd_read )
end; //if ret > 0

end; //while (not self.Terminated)

shutdown( FSock, SD_BOTH );
closesocket( FSock );

//結束所有維護客戶端連接的線程
if FList.Count > 0 then
begin
for i:=0 to FList.Count-1 do
begin
PConnection(FList.Items[i])^.thrRW.Terminate;
shutdown( PConnection(FList.Items[i])^.hsock, SD_BOTH );
closesocket( PConnection(FList.Items[i])^.hsock );
Dispose(FList.Items[i]);
end;
end;

FList.Free;
end;

end.

unit thrReadWrite;

interface

uses
Windows, Classes, SysUtils, Winsock2;

const
PACK_SIZE_RECEIVE = 4096;

type
TRWThread = class(TThread)
public
m_sock : THandle;
m_ip : DWORD;
m_port : DWORD;
m_itemid : Pointer;
private
FRecvBuf : Array [0..PACK_SIZE_RECEIVE-1] of Char;
protected
procedure Execute; override;
end;

implementation

uses frmMain;

{ TRWThread }

procedure TRWThread.Execute;
var
sTitle : String;
fd_read : TFDSet;
timeout : TTimeVal;
ret : Integer;
begin
sTitle := inet_ntoa( TInAddr(htonl(m_ip)) );
sTitle := 'IP: ' + sTitle + ' Port: ' + IntToStr(m_port) + ' Msg: ';

while (not self.Terminated) do
begin
FD_ZERO( fd_read );
FD_SET( m_sock, fd_read );
timeout.tv_sec := 0;
timeout.tv_usec := 500;

ret := select( 0, @fd_Read, nil, nil, @timeout );
if ret = SOCKET_ERROR then
begin
MessageBox( 0, 'Call select() failed.', 'Error', MB_ICONERROR );
Exit;
end;

if ret > 0 then
begin
if FD_ISSET( m_sock, fd_read ) then
begin
FillChar( FRecvBuf[0], PACK_SIZE_RECEIVE, 0 );
ret := recv( m_sock, FRecvBuf[0], PACK_SIZE_RECEIVE, 0 );

if (ret=0) or (ret=SOCKET_ERROR) then
begin
closesocket( m_sock );
Exit;
end;

EnterCriticalSection( gCSListBox );
fmMain.ListBox1.Items.Add( sTitle + FRecvBuf );
LeaveCriticalSection( gCSListBox );
end;
end; //if ret > 0

end; //while (not self.Terminated)

closesocket( m_sock );
end;

end.

 

二：WSAAsyncSelect模型

後來，老陳使用了微軟公司的新式信箱。這種信箱非常先進，一旦信箱裏有新的信件，蓋茨就會給老陳打電話：喂，大爺，你有新的信件了！從此，老陳再也不必頻繁上下樓檢查信箱了，牙也不疼了，你瞅準了，藍天......不是，微軟~~~~~~~~
微軟提供的WSAAsyncSelect模型就是這個意思。

WSAAsyncSelect模型是Windows下最簡單易用的一種Socket I/O模型。使用這種模型時，Windows會把網絡事件以消息的形勢通知應用程序。
首先定義一個消息標示常量：
const WM_SOCKET = WM_USER + 55;
再在主Form的private域添加一個處理此消息的函數聲明：
private
procedure WMSocket(var Msg: TMessage); message WM_SOCKET;
然後就可以使用WSAAsyncSelect了：
var
addr : TSockAddr;
sock : TSocket;

sock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
addr.sin_family := AF_INET;
addr.sin_port := htons(5678);
addr.sin_addr.S_addr := htonl(INADDR_ANY);
bind( m_sock, @addr, sizeof(SOCKADDR) );

WSAAsyncSelect( m_sock, Handle, WM_SOCKET, FD_ACCEPT or FD_CLOSE );

listen( m_sock, 5 );
....

應用程序可以對收到WM_SOCKET消息進行分析，判斷是哪一個socket產生了網絡事件以及事件類型：

procedure TfmMain.WMSocket(var Msg: TMessage);
var
sock : TSocket;
addr : TSockAddrIn;
addrlen : Integer;
buf : Array [0..4095] of Char;
begin
//Msg的WParam是產生了網絡事件的socket句柄，LParam則包含了事件類型
case WSAGetSelectEvent( Msg.LParam ) of
FD_ACCEPT :
begin
addrlen := sizeof(addr);
sock := accept( Msg.WParam, addr, addrlen );
if sock <> INVALID_SOCKET then
WSAAsyncSelect( sock, Handle, WM_SOCKET, FD_READ or FD_WRITE or FD_CLOSE );
end;

FD_CLOSE : closesocket( Msg.WParam );
FD_READ : recv( Msg.WParam, buf[0], 4096, 0 );
FD_WRITE : ;
end;
end;

1。WSAAsyncSelect模型

這個很簡單，貼個源碼了事。。。。。。。。。。。。

unit frmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Winsock2, StdCtrls, ComCtrls;

const
LISTEN_PORT = 5005;
WM_SOCKET = WM_USER + 55;

type
TfmMain = class(TForm)
btnStart: TButton;
btnStop: TButton;
ListBox1: TListBox;
StatusBar1: TStatusBar;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);

private
{ Private declarations }
procedure WMSocket(var Msg: TMessage); message WM_SOCKET;
procedure SendBuf( hsock: TSocket );
procedure RecvBuf( hsock: TSocket );
public
{ Public declarations }
m_sock : TSocket; //主socket
m_connect_list : TList; //客戶連接列表
end;

var
fmMain : TfmMain;

implementation

{$R *.dfm}

procedure TfmMain.WMSocket(var Msg: TMessage);
var
s : TSocket;
addr : TSockAddrIn;
addrlen : Integer;
begin
case WSAGetSelectEvent( Msg.LParam ) of
FD_ACCEPT :
begin
addrlen := sizeof(addr);
s := accept( m_sock, addr, addrlen );
if s <> INVALID_SOCKET then
begin
WSAAsyncSelect( s, Handle, WM_SOCKET, FD_READ or FD_WRITE or FD_CLOSE );
m_connect_list.Add( Pointer(s) );
StatusBar1.Panels[0].Text := 'Connection count: ' +
IntToStr(m_connect_list.Count);
end;
end;

FD_CLOSE :
begin
if m_connect_list.IndexOf( Pointer(Msg.WParam) ) > -1 then
begin
m_connect_list.Remove( Pointer(Msg.WParam) );
StatusBar1.Panels[0].Text := 'Connection count: ' +
IntToStr(m_connect_list.Count);
end;
closesocket( Msg.WParam );
end;

FD_READ : RecvBuf( Msg.WParam );
FD_WRITE : SendBuf( Msg.WParam );
end; //case...
end;

procedure TfmMain.SendBuf( hsock: TSocket );
begin
{/*
只有在三種條件下，纔會發出FD_WRITE通知：
■使用connect或WSAConnect ，一個套接字首次建立了連接。
■使用accept或WSAAccept，套接字被接受以後。
■若send、WSASend、sendto或WSASendTo操作失敗，返回了WSAEWOULDBLOCK錯誤，
而且緩衝區的空間變得可用
因此，作爲一個應用程序，自收到首條FD_WRITE消息開始，便應認爲自己必然能在一
個套接字上發出數據，直至一個send、WSASend、sendto或WSASendTo返回套接字錯誤
WSAEWOULDBLOCK。經過了這樣的失敗以後，要再用另一條FD_WRITE通知應用程序再次
送數據。
也就是說，不要關心FD_WRITE消息，儘管send，直到出現WSAEWOULDBLOCK錯誤！
*/}
end;

procedure TfmMain.RecvBuf( hsock: TSocket );
var
buf : Array [0..4095] of Char;
adr : TSockAddrIn;
len : Integer;
s : String;
begin
FillChar( buf[0], 4096, 0 );
recv( hsock, buf[0], 4096, 0 );

len := sizeof(adr);
getpeername( hsock, adr, len );
s := inet_ntoa( adr.sin_addr );
s := 'IP: ' + s + ' Port: ' + IntToStr(ntohs(adr.sin_port)) + ' Msg: ';
ListBox1.Items.Add( s + buf );
end;

procedure TfmMain.FormCreate(Sender: TObject);
var
wsa : TWSAData;
begin
if WSAStartup( $0202, wsa ) <> 0 then //WSAStartup returns zero if successful.
begin
MessageBox( 0, 'WSAStartup failed', 'Error', MB_ICONERROR );
btnStart.Enabled := False;
btnStop.Enabled := False;
end;

btnStart.Enabled := True;
btnStop.Enabled := False;

m_connect_list := TList.Create;
end;

procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : Integer;
begin
shutdown( m_sock, SD_BOTH );
closesocket( m_sock );

//結束所有維護客戶端連接的線程
if m_connect_list.Count > 0 then
for i:=0 to m_connect_list.Count-1 do
begin
shutdown( TSocket(m_connect_list.Items[i]), SD_BOTH );
closesocket( TSocket(m_connect_list.Items[i]) );
end;

m_connect_list.Free;

WSACleanup();
end;

procedure TfmMain.btnStartClick(Sender: TObject);
var
addr : TSockAddr;
ret : Integer;
begin
m_sock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
if m_sock = INVALID_SOCKET then
begin
MessageBox( 0, 'Call socket() failed.', 'Error', MB_ICONERROR );
Exit;
end;

addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

if bind( m_sock, @addr, sizeof(SOCKADDR) ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call bind failed.', 'Error', MB_ICONERROR );
Exit;
end;

ret := WSAAsyncSelect( m_sock, Handle, WM_SOCKET, FD_ACCEPT or FD_CLOSE );
if ret = SOCKET_ERROR then
begin
MessageBox( 0, 'Call WSAAsyncSelect failed.', 'Error', MB_ICONERROR );
Exit;
end;

if listen( m_sock, 5 ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call listen failed.', 'Error', MB_ICONERROR );
Exit;
end;

btnStart.Enabled := False;
btnStop.Enabled := True;
end;

procedure TfmMain.btnStopClick(Sender: TObject);
var
i : Integer;
begin
shutdown( m_sock, SD_BOTH );
closesocket( m_sock );

//結束所有維護客戶端連接的線程
if m_connect_list.Count > 0 then
for i:=0 to m_connect_list.Count-1 do
begin
shutdown( TSocket(m_connect_list.Items[i]), SD_BOTH );
closesocket( TSocket(m_connect_list.Items[i]) );
end;

m_connect_list.Clear;

btnStart.Enabled := True;
btnStop.Enabled := False;
end;

end.

 

三：WSAEventSelect模型

後來，微軟的信箱非常暢銷，購買微軟信箱的人以百萬計數......以至於蓋茨每天24小時給客戶打電話，累得腰痠背痛，喝蟻力神都不好使~~~~~~
微軟改進了他們的信箱：在客戶的家中添加一個附加裝置，這個裝置會監視客戶的信箱，每當新的信件來臨，此裝置會發出“新信件到達”聲，提醒老陳去收信。蓋茨終於可以睡覺了。

同樣要使用線程：
procedure TListenThread.Execute;
var
hEvent : WSAEvent;
ret : Integer;
ne : TWSANetworkEvents;
sock : TSocket;
adr : TSockAddrIn;
sMsg : String;
Index,
EventTotal : DWORD;
EventArray : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of WSAEVENT;
begin
...socket...bind...
hEvent := WSACreateEvent();
WSAEventSelect( ListenSock, hEvent, FD_ACCEPT or FD_CLOSE );
...listen...

while ( not Terminated ) do
begin
Index := WSAWaitForMultipleEvents( EventTotal, @EventArray[0], FALSE, WSA_INFINITE, FALSE );
FillChar( ne, sizeof(ne), 0 );
WSAEnumNetworkEvents( SockArray[Index-WSA_WAIT_EVENT_0], EventArray[Index-WSA_WAIT_EVENT_0], @ne );

if ( ne.lNetworkEvents and FD_ACCEPT ) > 0 then
begin
if ne.iErrorCode[FD_ACCEPT_BIT] <> 0 then
continue;

ret := sizeof(adr);
sock := accept( SockArray[Index-WSA_WAIT_EVENT_0], adr, ret );
if EventTotal > WSA_MAXIMUM_WAIT_EVENTS-1 then//這裏WSA_MAXIMUM_WAIT_EVENTS同樣是64
begin
closesocket( sock );
continue;
end;

hEvent := WSACreateEvent();
WSAEventSelect( sock, hEvent, FD_READ or FD_WRITE or FD_CLOSE );
SockArray[EventTotal] := sock;
EventArray[EventTotal] := hEvent;
Inc( EventTotal );
end;

if ( ne.lNetworkEvents and FD_READ ) > 0 then
begin
if ne.iErrorCode[FD_READ_BIT] <> 0 then
continue;
FillChar( RecvBuf[0], PACK_SIZE_RECEIVE, 0 );
ret := recv( SockArray[Index-WSA_WAIT_EVENT_0], RecvBuf[0], PACK_SIZE_RECEIVE, 0 );
......
end;
end;
end;

WSAEventSelect模型

看來大家不感興趣啊呵呵沒有信心了把代碼貼完拉倒。。。。。。

unit frmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Winsock2, StdCtrls, ComCtrls, thrEvent;

const
LISTEN_PORT = 5005;

type
TfmMain = class(TForm)
btnStart: TButton;
btnStop: TButton;
ListBox1: TListBox;
StatusBar1: TStatusBar;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
EventThread : TEventThread;
end;

var
fmMain : TfmMain;

implementation

{$R *.dfm}

procedure TfmMain.FormCreate(Sender: TObject);
var
wsa : TWSAData;
begin
if WSAStartup( $0202, wsa ) <> 0 then //WSAStartup returns zero if successful.
begin
MessageBox( 0, 'WSAStartup failed', 'Error', MB_ICONERROR );
btnStart.Enabled := False;
btnStop.Enabled := False;
end;

btnStart.Enabled := True;
btnStop.Enabled := False;
end;

procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
WSACleanup();
end;

procedure TfmMain.btnStartClick(Sender: TObject);
begin
EventThread := TEventThread.Create( True );
EventThread.FreeOnTerminate := True;
EventThread.OnTerminate := EventThread.WhileTerminate;
EventThread.Resume;

btnStart.Enabled := False;
btnStop.Enabled := True;
end;

procedure TfmMain.btnStopClick(Sender: TObject);
begin
EventThread.Terminate;
btnStart.Enabled := True;
btnStop.Enabled := False;
end;

end.
//--------------------------------------------------------------------------------------

unit thrEvent;

interface

uses
Windows, SysUtils, Classes, Winsock2;

const
PACK_SIZE_RECEIVE = 4096;

type
TEventThread = class(TThread)
public
procedure WhileTerminate(Sender: TObject);
private
ListenSock : TSocket;
SockArray : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of TSocket;
EventArray : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of WSAEVENT;
EventTotal : DWORD;
Index : DWORD;
RecvBuf : Array [0..PACK_SIZE_RECEIVE-1] of Char;

procedure InitSock;
procedure CompressArray(idx: DWORD);
protected
procedure Execute; override;
end;

implementation

uses frmMain;

{ TEventThread }

procedure TEventThread.Execute;
var
hEvent : WSAEvent;
ret : Integer;
ne : TWSANetworkEvents;
sock : TSocket;
adr : TSockAddrIn;
sMsg : String;
begin
InitSock();
if EventTotal = 0 then
Exit;

while ( not Terminated ) do
begin
Index := WSAWaitForMultipleEvents( EventTotal, @EventArray[0], FALSE,
WSA_INFINITE, FALSE );
if Index = WSA_WAIT_FAILED then
begin
MessageBox( 0,'Call WSAWaitForMultipleEvents failed.','Error',MB_ICONERROR );
Exit;
end;

FillChar( ne, sizeof(ne), 0 );
WSAEnumNetworkEvents( SockArray[Index-WSA_WAIT_EVENT_0],
EventArray[Index-WSA_WAIT_EVENT_0], @ne );

if ( ne.lNetworkEvents and FD_ACCEPT ) > 0 then
begin
if ne.iErrorCode[FD_ACCEPT_BIT] <> 0 then
continue;

ret := sizeof(adr);
sock := accept( SockArray[Index-WSA_WAIT_EVENT_0], adr, ret );
if EventTotal > WSA_MAXIMUM_WAIT_EVENTS-1 then
begin
closesocket( sock );
continue;
end;

hEvent := WSACreateEvent();
WSAEventSelect( sock, hEvent, FD_READ or FD_WRITE or FD_CLOSE );
SockArray[EventTotal] := sock;
EventArray[EventTotal] := hEvent;
Inc( EventTotal );

fmMain.StatusBar1.Panels[0].Text := 'Connection: ' +IntToStr(EventTotal-1);
end;

if ( ne.lNetworkEvents and FD_READ ) > 0 then
begin
if ne.iErrorCode[FD_READ_BIT] <> 0 then
continue;

FillChar( RecvBuf[0], PACK_SIZE_RECEIVE, 0 );
ret := recv( SockArray[Index-WSA_WAIT_EVENT_0], RecvBuf[0],
PACK_SIZE_RECEIVE, 0 );
if (ret=0) or (ret=SOCKET_ERROR) then
continue;

ret := sizeof(adr);
getpeername( SockArray[Index-WSA_WAIT_EVENT_0], adr, ret );
sMsg := inet_ntoa( adr.sin_addr );
sMsg := 'IP: ' +sMsg +' Port: ' +IntToStr(ntohs(adr.sin_port)) +' Msg: ';
fmMain.ListBox1.Items.Add( sMsg + RecvBuf );
end;
{
if ( ne.lNetworkEvents and FD_WRITE ) > 0 then
begin
if ne.iErrorCode[FD_WRITE_BIT] <> 0 then
continue;

...
end; }

if ( ne.lNetworkEvents and FD_CLOSE ) > 0 then
begin
if ne.iErrorCode[FD_CLOSE_BIT] <> 0 then
continue;

WSACloseEvent( EventArray[Index-WSA_WAIT_EVENT_0] );
closesocket( SockArray[Index-WSA_WAIT_EVENT_0] );
CompressArray( Index-WSA_WAIT_EVENT_0 );

fmMain.StatusBar1.Panels[0].Text := 'Connection: ' +IntToStr(EventTotal-1);
end;
end;
end;

procedure TEventThread.InitSock;
var
addr : TSockAddr;
hEvent : WSAEvent;
begin
EventTotal := 0;
ListenSock := INVALID_SOCKET;

ListenSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
if ListenSock = INVALID_SOCKET then
begin
MessageBox( 0, 'Call socket() failed.', 'Error', MB_ICONERROR );
Exit;
end;

addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

if bind( ListenSock, @addr, sizeof(SOCKADDR) ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call bind failed.', 'Error', MB_ICONERROR );
Exit;
end;

hEvent := WSACreateEvent();
if hEvent = WSA_INVALID_EVENT then
begin
MessageBox( 0, 'Call WSACreateEvent failed.', 'Error', MB_ICONERROR );
Exit;
end;

if WSAEventSelect( ListenSock,hEvent,FD_ACCEPT or FD_CLOSE )=SOCKET_ERROR then
begin
MessageBox( 0, 'Call WSAEventSelect failed.', 'Error', MB_ICONERROR );
Exit;
end;

if listen( ListenSock, 5 ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call listen failed.', 'Error', MB_ICONERROR );
Exit;
end;

SockArray[EventTotal] := ListenSock;
EventArray[EventTotal] := hEvent;
Inc( EventTotal );
end;

procedure TEventThread.CompressArray(idx: DWORD);
var
i : Integer;
begin
if idx = EventTotal-1 then
begin
Dec( EventTotal );
Exit;
end;

for i:=idx to EventTotal-2 do
begin
SockArray[i] := SockArray[i+1];
EventArray[i] := EventArray[i+1];
end;
Dec( EventTotal );
end;

procedure TEventThread.WhileTerminate(Sender: TObject);
var
i : Integer;
begin
if EventTotal > 0 then
begin
for i:=0 to EventTotal-1 do
begin
WSACloseEvent( EventArray[i] );
shutdown( SockArray[i], SD_BOTH );
closesocket( SockArray[i] );
end;
end;
end;

end.

四：Overlapped I/O 事件通知模型

後來，微軟通過調查發現，老陳不喜歡上下樓收發信件，因爲上下樓其實很浪費時間。於是微軟再次改進他們的信箱。新式的信箱採用了更爲先進的技術，只要用戶告訴微軟自己的家在幾樓幾號，新式信箱會把信件直接傳送到用戶的家中，然後告訴用戶，你的信件已經放到你的家中了！老陳很高興，因爲他不必再親自收發信件了！

Overlapped I/O 事件通知模型和WSAEventSelect模型在實現上非常相似，主要區別在“Overlapped”，Overlapped模型是讓應用程序使用重疊數據結構(WSAOVERLAPPED)，一次投遞一個或多個Winsock I/O請求。這些提交的請求完成後，應用程序會收到通知。什麼意思呢？就是說，如果你想從socket上接收數據，只需要告訴系統，由系統爲你接收數據，而你需要做的只是爲系統提供一個緩衝區~~~~~
Listen線程和WSAEventSelect模型一模一樣，Recv/Send線程則完全不同：
procedure TOverlapThread.Execute;
var
dwTemp : DWORD;
ret : Integer;
Index : DWORD;
begin
......

while ( not Terminated ) do
begin
Index := WSAWaitForMultipleEvents( FLinks.Count, @FLinks.Events[0], FALSE, RECV_TIME_OUT, FALSE );
Dec( Index, WSA_WAIT_EVENT_0 );
if Index > WSA_MAXIMUM_WAIT_EVENTS-1 then //超時或者其他錯誤
continue;

WSAResetEvent( FLinks.Events[Index] );
WSAGetOverlappedResult( FLinks.Sockets[Index], FLinks.pOverlaps[Index], @dwTemp, FALSE, FLinks.pdwFlags[Index]^ );

if dwTemp = 0 then //連接已經關閉
begin
......
continue;
end else
begin
fmMain.ListBox1.Items.Add( FLinks.pBufs[Index]^.buf );
end;

//初始化緩衝區
FLinks.pdwFlags[Index]^ := 0;
FillChar( FLinks.pOverlaps[Index]^, sizeof(WSAOVERLAPPED), 0 );
FLinks.pOverlaps[Index]^.hEvent := FLinks.Events[Index];
FillChar( FLinks.pBufs[Index]^.buf^, BUFFER_SIZE, 0 );

//遞一個接收數據請求
WSARecv( FLinks.Sockets[Index], FLinks.pBufs[Index], 1, FLinks.pdwRecvd[Index]^, FLinks.pdwFlags[Index]^, FLinks.pOverlaps[Index], nil );
end;
end;

Overlapped I/O 事件通知

unit thrAccept;

interface

uses
Windows, SysUtils, Classes, Winsock2, thrOverlap;

type
TEventThread = class(TThread)
private
FListenSock : TSocket;
FListenEvent : WSAEVENT;
FRWThread : TOverlapThread;
protected
procedure Execute; override;
function InitSock():BOOL;
procedure FreeResource;
end;

var
gCS1 : TRTLCriticalSection; //臨界區，保證線程安全
gSockTotal : DWORD;
gSockArray : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of TSocket;

implementation

uses frmMain;

{ TEventThread }

procedure TEventThread.Execute;
var
ret : Integer;
ne : TWSANetworkEvents;
sock : TSocket;
adr : TSockAddrIn;
begin
if not InitSock() then Exit;

InitializeCriticalSection( gCS1 );
gSockTotal := 0;

FRWThread := TOverlapThread.Create( True );
FRWThread.FreeOnTerminate := True;
FRWThread.Resume;

while ( not Terminated ) do
begin
WSAWaitForMultipleEvents( 1, @FListenEvent, FALSE, ACCEPT_TIME_OUT, FALSE );
FillChar( ne, sizeof(ne), 0 );
WSAEnumNetworkEvents( FListenSock, FListenEvent, @ne );

if ( ne.lNetworkEvents and FD_ACCEPT ) > 0 then
begin
if ne.iErrorCode[FD_ACCEPT_BIT] <> 0 then continue;
ret := sizeof(adr);
sock := accept( FListenSock, adr, ret );
if sock = INVALID_SOCKET then
continue;
EnterCriticalSection( gCS1 );
ret := gSockTotal;
LeaveCriticalSection( gCS1 );

if ret > WSA_MAXIMUM_WAIT_EVENTS-1 then
begin
closesocket( sock ); continue; end;

EnterCriticalSection( gCS1 );
gSockArray[gSockTotal] := sock;
Inc( gSockTotal );
ret := gSockTotal;
LeaveCriticalSection( gCS1 );

fmMain.StatusBar1.Panels[0].Text := 'Connection: ' + IntToStr(ret);
end;

//不關心其他事件。雖然客戶端斷開連接會ne.lNetworkEvents==0，但是鑑於本線程
//僅僅負責accept，所以不響應其他事件。
end;

FreeResource;
end;

function TEventThread.InitSock: BOOL;
var
addr : TSockAddr;
begin
result := False;

FListenSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

bind( FListenSock, @addr, sizeof(SOCKADDR) );
FListenEvent := WSACreateEvent();
WSAEventSelect( FListenSock, FListenEvent, FD_ACCEPT );
listen( FListenSock, 5 );

result := True;
end;

procedure TEventThread.FreeResource;
begin
FRWThread.Terminate;

DeleteCriticalSection( gCS1 );

closesocket( FListenSock );
WSACloseEvent( FListenEvent );
end;

end.
---------------------------------------------------------------------------------
unit thrOverlap;

interface

uses
Windows, SysUtils, Classes, Winsock2;

const
BUFFER_SIZE = 4096;
ACCEPT_TIME_OUT = 550;
RECV_TIME_OUT = 550;

type
YOverlappedSockets = record
Count : DWORD;
Sockets : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of TSocket;
Events : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of WSAEVENT;
pOverlaps : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of PWSAOVERLAPPED;
pBufs : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of PWSABUF;
pdwRecvd : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of PDWORD;
pdwFlags : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of PDWORD;
end;

type
TOverlapThread = class(TThread)
private
FLinks : YOverlappedSockets;
protected
procedure Execute; override;
procedure CompressArray(idx: DWORD);
procedure DoNewConnection(dwCount: DWORD);
procedure FreeResource;
end;

implementation

uses thrAccept, frmMain;

{ TOverlapThread }

procedure TOverlapThread.Execute;
var
dwTemp : DWORD;
ret : Integer;
Index : DWORD;
begin
for ret:=0 to WSA_MAXIMUM_WAIT_EVENTS-1 do
begin
New( FLinks.pdwRecvd[ret] ); FLinks.pdwRecvd[ret]^ := 0;
New( FLinks.pdwFlags[ret] ); FLinks.pdwFlags[ret]^ := 0;
New( FLinks.pOverlaps[ret] );
New( FLinks.pBufs[ret] );

FLinks.pBufs[ret]^.len := BUFFER_SIZE;
FLinks.pBufs[ret]^.buf := AllocMem( BUFFER_SIZE );
end;

while ( not Terminated ) do
begin
EnterCriticalSection( gCS1 );
dwTemp := gSockTotal; //得到連接數量
LeaveCriticalSection( gCS1 );

if dwTemp = 0 then //沒有客戶連接 dwTemp==FLinks.Count說明沒有新的連接
continue; //dwTemp < FLinks.Count --- 沒有這種可能性

if dwTemp > FLinks.Count then //Accept線程接受了新的連接
DoNewConnection( dwTemp );

Index := WSAWaitForMultipleEvents( FLinks.Count, @FLinks.Events[0],
FALSE, RECV_TIME_OUT, FALSE );
Dec( Index, WSA_WAIT_EVENT_0 );
if Index > WSA_MAXIMUM_WAIT_EVENTS-1 then //超時或者其他錯誤
continue;

WSAResetEvent( FLinks.Events[Index] );
WSAGetOverlappedResult( FLinks.Sockets[Index],
FLinks.pOverlaps[Index], @dwTemp, FALSE,
FLinks.pdwFlags[Index]^ );

if dwTemp = 0 then //連接已經關閉
begin
closesocket( FLinks.Sockets[Index] );
WSACloseEvent( FLinks.Events[Index] );
CompressArray( Index );
fmMain.StatusBar1.Panels[0].Text := 'Connection: '+IntToStr(FLinks.Count);
continue;
end else
begin
fmMain.ListBox1.Items.Add( FLinks.pBufs[Index]^.buf );
end;

FLinks.pdwFlags[Index]^ := 0;
FillChar( FLinks.pOverlaps[Index]^, sizeof(WSAOVERLAPPED), 0 );
FLinks.pOverlaps[Index]^.hEvent := FLinks.Events[Index];
FillChar( FLinks.pBufs[Index]^.buf^, BUFFER_SIZE, 0 );
WSARecv( FLinks.Sockets[Index], FLinks.pBufs[Index], 1,
FLinks.pdwRecvd[Index]^, FLinks.pdwFlags[Index]^,
FLinks.pOverlaps[Index], nil );
end;

FreeResource;
end;

procedure TOverlapThread.CompressArray(idx: DWORD);
var
i : Integer;
p1,p2,p3,p4 : Pointer;
begin
EnterCriticalSection( gCS1 );
if idx = gSockTotal-1 then
begin
Dec( gSockTotal );
end else
begin
for i:=idx to gSockTotal-2 do
gSockArray[i] := gSockArray[i+1];
Dec( gSockTotal );
end;
LeaveCriticalSection( gCS1 );

if idx = FLinks.Count-1 then
begin
Dec( FLinks.Count );
Exit;
end else
begin
p1 := FLinks.pOverlaps[idx];
p2 := FLinks.pBufs[idx];
p3 := FLinks.pdwRecvd[idx];
p4 := FLinks.pdwFlags[idx];

for i:=idx to FLinks.Count-2 do
begin
FLinks.Sockets[i] := FLinks.Sockets[i+1];
FLinks.Events[i] := FLinks.Events[i+1];
FLinks.pOverlaps[i] := FLinks.pOverlaps[i+1];
FLinks.pBufs[i] := FLinks.pBufs[i+1];
FLinks.pdwRecvd[i] := FLinks.pdwRecvd[i+1];
FLinks.pdwFlags[i] := FLinks.pdwFlags[i+1];
end;

FLinks.pOverlaps[FLinks.Count-1] := p1;
FLinks.pBufs[FLinks.Count-1] := p2;
FLinks.pdwRecvd[FLinks.Count-1] := p3;
FLinks.pdwFlags[FLinks.Count-1] := p4;
Dec( FLinks.Count );
end;
end;

procedure TOverlapThread.DoNewConnection(dwCount: DWORD);
var
ret : Integer;
begin
EnterCriticalSection( gCS1 );
for ret:=dwCount-1 downto FLinks.Count do
FLinks.Sockets[ret] := gSockArray[ret];
LeaveCriticalSection( gCS1 );

for ret:=dwCount-1 downto FLinks.Count do
begin
FLinks.Events[ret] := WSACreateEvent();
FillChar( FLinks.pOverlaps[ret]^, sizeof(WSAOVERLAPPED), 0 );
FLinks.pOverlaps[ret]^.hEvent := FLinks.Events[ret];
WSARecv( FLinks.Sockets[ret], FLinks.pBufs[ret], 1, FLinks.pdwRecvd[ret]^,
FLinks.pdwFlags[ret]^, FLinks.pOverlaps[ret], nil );
end;

FLinks.Count := dwCount;
end;

procedure TOverlapThread.FreeResource;
var
i : Integer;
begin
if FLinks.Count > 0 then
begin
for i:=0 to FLinks.Count-1 do
begin
closesocket( FLinks.Sockets[i] );
WSACloseEvent( FLinks.Events[i] );
end;
end;

for i:=0 to WSA_MAXIMUM_WAIT_EVENTS-1 do
begin
FreeMem( FLinks.pBufs[i]^.buf );
Dispose( FLinks.pdwRecvd[i] );
Dispose( FLinks.pdwFlags[i] );
Dispose( FLinks.pOverlaps[i] );
Dispose( FLinks.pBufs[i] );
end;
end;

end.

 

五：Overlapped I/O 完成例程模型

老陳接收到新的信件後，一般的程序是：打開信封----掏出信紙----閱讀信件----回覆信件......爲了進一步減輕用戶負擔，微軟又開發了一種新的技術：用戶只要告訴微軟對信件的操作步驟，微軟信箱將按照這些步驟去處理信件，不再需要用戶親自拆信/閱讀/回覆了！老陳終於過上了小資生活！

Overlapped I/O 完成例程要求用戶提供一個回調函數，發生新的網絡事件的時候系統將執行這個函數：
procedure WorkerRoutine( const dwError, cbTransferred : DWORD; const
lpOverlapped : LPWSAOVERLAPPED; const dwFlags : DWORD ); stdcall;
然後告訴系統用WorkerRoutine函數處理接收到的數據：
WSARecv( m_socket, @FBuf, 1, dwTemp, dwFlag, @m_overlap, WorkerRoutine );
然後......沒有什麼然後了，系統什麼都給你做了！微軟真實體貼！
while ( not Terminated ) do//這就是一個Recv/Send線程要做的事情......什麼都不用做啊！！！
begin
if SleepEx( RECV_TIME_OUT, True ) = WAIT_IO_COMPLETION then //
begin
;
end else
begin
continue;
end;
end;

Overlapped I/O 完成例程

據說，“重疊I / O （Overlapped I/O ）模型使應用程序能達到更佳的系統性能。”，不過性能到底“更佳”了多少，沒有做過測試，不清楚。。。道理網上有很多，不講了，還是直接貼代碼。。。

unit thrAccept;

interface

uses
Windows, SysUtils, Classes, Winsock2, thrOverlap;

type
TEventThread = class(TThread)
private
FListenSock : TSocket;
FListenEvent : WSAEVENT;
FRWThread : TOverlapThread;
protected
procedure Execute; override;
function InitSock: BOOL;
procedure FreeResource;
end;

implementation

uses frmMain;

{ TEventThread }

procedure TEventThread.Execute;
var
ret : Integer;
ne : TWSANetworkEvents;
sock : TSocket;
adr : TSockAddrIn;
begin
if not InitSock() then
Exit;

FRWThread := TOverlapThread.Create( True );
FRWThread.FreeOnTerminate := True;
FRWThread.Resume;

while ( not Terminated ) do
begin
WSAWaitForMultipleEvents( 1, @FListenEvent, FALSE, ACCEPT_TIME_OUT, FALSE );

FillChar( ne, sizeof(ne), 0 );
WSAEnumNetworkEvents( FListenSock, FListenEvent, @ne );
//此函數使FListenEvent自動成爲“未傳信”狀態. 不再需要使用WSAResetEvent

if ( ne.lNetworkEvents and FD_ACCEPT ) > 0 then
begin
if ne.iErrorCode[FD_ACCEPT_BIT] <> 0 then
continue;

ret := sizeof(adr);
sock := accept( FListenSock, adr, ret );
if sock = INVALID_SOCKET then
continue;

//fmMain.StatusBar1.Panels[0].Text := 'Connection: ' + IntToStr(gSockTotal);
end;

//不關心其他事件。雖然客戶端斷開連接會ne.lNetworkEvents==0，但是鑑於本線程
//僅僅負責accept，所以不響應其他事件。
end;

FreeResource;
end;

function TEventThread.InitSock: BOOL;
var
addr : TSockAddr;
begin
result := False;

FListenSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

bind( FListenSock, @addr, sizeof(SOCKADDR) )；
FListenEvent := WSACreateEvent();
WSAEventSelect( FListenSock, FListenEvent, FD_ACCEPT )；
listen( FListenSock, 5 );
result := True;
end;

procedure TEventThread.FreeResource;
begin
closesocket( FListenSock );
WSACloseEvent( FListenEvent );
end;

end.

unit thrOverlap;

interface

uses
Windows, SysUtils, Classes, Winsock2;

const
BUFFER_SIZE = 4096;
ACCEPT_TIME_OUT = 550;
RECV_TIME_OUT = 550;

type
TOverlapThread = class(TThread)
private
FBuf : WSABUF;
public
m_socket : TSocket;
m_overlap : WSAOVERLAPPED;
protected
procedure Execute; override;
end;

procedure WorkerRoutine( const dwError, cbTransferred : DWORD; const
lpOverlapped : LPWSAOVERLAPPED; const dwFlags : DWORD ); stdcall;

implementation

uses frmMain;

{ TOverlapThread }

procedure TOverlapThread.Execute;
var
dwTemp, dwFlag : DWORD;
begin
FBuf.len := BUFFER_SIZE;
FBuf.buf := AllocMem( BUFFER_SIZE );

dwFlag := 0;
FillChar( m_overlap, sizeof(WSAOVERLAPPED), 0 );
m_overlap.hEvent := DWORD(self);{If lpCompletionRoutine is not NULL,
the hEvent field is ignored and can be used by the application to
pass context information to the completion routine.}
WSARecv( m_socket, @FBuf, 1, dwTemp, dwFlag, @m_overlap, WorkerRoutine );

while ( not Terminated ) do
begin
if SleepEx( RECV_TIME_OUT, True ) = WAIT_IO_COMPLETION then //
begin
;
end else
begin
continue;
end;
end;
end;

procedure WorkerRoutine( const dwError, cbTransferred : DWORD; const
lpOverlapped : LPWSAOVERLAPPED; const dwFlags : DWORD );
var
dwTemp, Flags : DWORD;
begin
if ( dwError <> 0 ) or ( cbTransferred = 0 ) then
begin
closesocket( TOverlapThread(lpOverlapped^.hEvent).m_socket );
Exit;
end;

fmMain.ListBox1.Items.Add( TOverlapThread(lpOverlapped^.hEvent).FBuf.buf );
FillChar( TOverlapThread(lpOverlapped^.hEvent).FBuf.buf^, BUFFER_SIZE, 0 );

Flags := 0;
FillChar( lpOverlapped^, sizeof(WSAOVERLAPPED), 0 );

if WSARecv( TOverlapThread(lpOverlapped^.hEvent).m_socket,
@(TOverlapThread(lpOverlapped^.hEvent)).FBuf, 1, dwTemp, Flags,
@(TOverlapThread(lpOverlapped^.hEvent)).m_overlap,
WorkerRoutine ) = SOCKET_ERROR then
begin
;
end;
end;

end.

 

六：IOCP模型

微軟信箱似乎很完美，老陳也很滿意。但是在一些大公司情況卻完全不同！這些大公司有數以萬計的信箱，每秒鐘都有數以百計的信件需要處理，以至於微軟信箱經常因超負荷運轉而崩潰！需要重新啓動！微軟不得不使出殺手鐗......
微軟給每個大公司派了一名名叫“Completion Port”的超級機器人，讓這個機器人去處理那些信件！

“Windows NT小組注意到這些應用程序的性能沒有預料的那麼高。特別的，處理很多同時的客戶請求意味着很多線程併發地運行在系統中。因爲所有這些線程都是可運行的[沒有被掛起和等待發生什麼事]，Microsoft意識到NT內核花費了太多的時間來轉換運行線程的上下文[Context]，線程就沒有得到很多CPU時間來做它們的工作。大家可能也都感覺到並行模型的瓶頸在於它爲每一個客戶請求都創建了一個新線程。創建線程比起創建進程開銷要小，但也遠不是沒有開銷的。我們不妨設想一下：如果事先開好N個線程，讓它們在那hold[堵塞]，然後可以將所有用戶的請求都投遞到一個消息隊列中去。然後那N個線程逐一從消息隊列中去取出消息並加以處理。就可以避免針對每一個用戶請求都開線程。不僅減少了線程的資源，也提高了線程的利用率。理論上很不錯，你想我等泛泛之輩都能想出來的問題，Microsoft又怎會沒有考慮到呢?”-----摘自nonocast的《理解I/O Completion Port》

先看一下IOCP模型的實現：

//創建一個完成端口
FCompletPort := CreateIoCompletionPort( INVALID_HANDLE_VALUE, 0,0,0 );

//接受遠程連接，並把這個連接的socket句柄綁定到剛纔創建的IOCP上
AConnect := accept( FListenSock, addr, len);
CreateIoCompletionPort( AConnect, FCompletPort, nil, 0 );

//創建CPU數*2 + 2個線程
for i:=1 to si.dwNumberOfProcessors*2+2 do
begin
AThread := TRecvSendThread.Create( false );
AThread.CompletPort := FCompletPort;//告訴這個線程，你要去這個IOCP去訪問數據
end;

OK，就這麼簡單，我們要做的就是建立一個IOCP，把遠程連接的socket句柄綁定到剛纔創建的IOCP上，最後創建n個線程，並告訴這n個線程到這個IOCP上去訪問數據就可以了。

再看一下TRecvSendThread線程都幹些什麼：

procedure TRecvSendThread.Execute;
var
......
begin
while (not self.Terminated) do
begin
//查詢IOCP狀態（數據讀寫操作是否完成）
GetQueuedCompletionStatus( CompletPort, BytesTransd, CompletKey, POVERLAPPED(pPerIoDat), TIME_OUT );

if BytesTransd <> 0 then
....;//數據讀寫操作完成

//再投遞一個讀數據請求
WSARecv( CompletKey, @(pPerIoDat^.BufData), 1, BytesRecv, Flags, @(pPerIoDat^.Overlap), nil );
end;
end;

讀寫線程只是簡單地檢查IOCP是否完成了我們投遞的讀寫操作，如果完成了則再投遞一個新的讀寫請求。
應該注意到，我們創建的所有TRecvSendThread都在訪問同一個IOCP（因爲我們只創建了一個IOCP），並且我們沒有使用臨界區！難道不會產生衝突嗎？不用考慮同步問題嗎？
呵呵，這正是IOCP的奧妙所在。IOCP不是一個普通的對象，不需要考慮線程安全問題。它會自動調配訪問它的線程：如果某個socket上有一個線程A正在訪問，那麼線程B的訪問請求會被分配到另外一個socket。這一切都是由系統自動調配的，我們無需過問。

完成端口

unit frmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Winsock2, StdCtrls, thrListen;

type
TfmMain = class(TForm)
btnStart: TButton;
ListBox1: TListBox;
btnStop: TButton;
procedure btnStartClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
FListenThread : TListenThread;
public
{ Public declarations }
end;

const
LISTEN_PORT = 5005;

var
fmMain: TfmMain;

implementation

{$R *.dfm}

procedure TfmMain.btnStartClick(Sender: TObject);
begin
FListenThread := TListenThread.Create( true );
FListenThread.FreeOnTerminate := true;
FListenThread.Resume;

btnStop.Enabled := true;
btnStart.Enabled := false;
end;

procedure TfmMain.btnStopClick(Sender: TObject);
begin
FListenThread.terminate;
btnStop.Enabled := false;
btnStart.Enabled := true;
end;

procedure TfmMain.FormCreate(Sender: TObject);
var
wsa : TWSAData;
begin
if WSAStartup( $0202, wsa ) <> 0 then //WSAStartup returns zero if successful.
begin
MessageBox( 0, 'WSAStartup failed', 'Error', MB_ICONERROR );
btnStart.Enabled := False;
btnStop.Enabled := False;
end;

btnStart.Enabled := true;
btnStop.Enabled := false;
end;

procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
WSACleanup();
end;

end.
//---------------------------------------------------------------------

unit thrListen;

interface

uses
Windows, Classes, Winsock2;

const
RECV_POSTED = 0;
SEND_POSTED = 1;
TIME_OUT = 110;
BUFFER_SIZE = 4096;

type
YPER_OPERATION_DATA = record
Overlap : OVERLAPPED;
BufData : WSABUF;
Buf : Array [0..BUFFER_SIZE-1] of Char;
OprtType : Integer;
end;
PPER_OPERATION_DATA = ^YPER_OPERATION_DATA;

YPER_HANDLE_DATA = record
Sock : TSocket;
Ip : Array [0..15] of Char;
Port : DWORD;
OprtType : Integer;
end;
PPER_HANDLE_DATA = ^YPER_HANDLE_DATA;


type
TListenThread = class(TThread)
private
{ Private declarations }
FCompletPort : THandle;
FListenSock : TSocket;
function InitSocket: BOOL;
protected
procedure Execute; override;
end;

function WorkerThread( CompletPortID: Pointer ): DWORD; stdcall;

implementation

uses frmMain;

{ TListenThread }

procedure TListenThread.Execute;
var
si : SYSTEM_INFO;
i : Integer;
hThread : THandle;
ThreadID : DWORD;
AConnect : TSocket;
addr : TSockAddrIn;
len : Integer;
BytesRecv,
Flags : DWORD;
pPerIoDat : PPER_OPERATION_DATA;
begin
FCompletPort := CreateIoCompletionPort( INVALID_HANDLE_VALUE, 0,0,0 );
if FCompletPort = 0 then
begin
MessageBox( 0, 'CreateIoCompletionPort failed.', 'Error', MB_OK );
Exit;
end;

GetSystemInfo( si );
for i:=0 to si.dwNumberOfProcessors-1 do
begin
hThread := CreateThread( nil,0,@WorkerThread,Pointer(FCompletPort),0,ThreadID );
CloseHandle( hThread );
end;

if not InitSocket() then
Exit;

while (not self.Terminated) do
begin
len := sizeof(addr);
AConnect := accept( FListenSock, addr, len);
if AConnect = INVALID_SOCKET then
begin
sleepex( 110, false );
continue;
end;

CreateIoCompletionPort( AConnect, FCompletPort, AConnect, 0 );

New( pPerIoDat );

FillChar( pPerIoDat^.Overlap, sizeof(OVERLAPPED), 0 );
FillChar( pPerIoDat^.Buf[0], BUFFER_SIZE, 0 );
pPerIoDat^.BufData.len := BUFFER_SIZE;
pPerIoDat^.BufData.buf := pPerIoDat^.Buf;
pPerIoDat.OprtType := RECV_POSTED;

Flags := 0;
WSARecv( AConnect, @(pPerIoDat^.BufData), 1, BytesRecv, Flags,
@(pPerIoDat^.Overlap), nil );
end;

PostQueuedCompletionStatus( FCompletPort, 0,0,nil );
CloseHandle( FCompletPort );
end;

function TListenThread.InitSocket: BOOL;
var
addr : TSockAddr;
begin
result := False;

FListenSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
if FListenSock = INVALID_SOCKET then
begin
MessageBox( 0, 'Call socket() failed.', 'Error', MB_ICONERROR );
Exit;
end;

addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

if bind( FListenSock, @addr, sizeof(SOCKADDR) ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call bind failed.', 'Error', MB_ICONERROR );
Exit;
end;

if listen( FListenSock, 5 ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call listen failed.', 'Error', MB_ICONERROR );
Exit;
end;

result := True;
end;

function WorkerThread( CompletPortID: Pointer ): DWORD;
var
CompletPort : THandle;
CompletKey,
BytesTransd,
BytesSend,
BytesRecv,
Flags : DWORD;
pPerIoDat : PPER_OPERATION_DATA;
begin
CompletPort := DWORD(CompletPortID);

while True do
begin BytesTransd:=0;CompletKey:=0;
GetQueuedCompletionStatus( CompletPort, BytesTransd, CompletKey,
POVERLAPPED(pPerIoDat), 550 );

if ( BytesTransd = 0 ) and ( (pPerIoDat=nil )or(pPerIoDat^.OprtType = RECV_POSTED)or
(pPerIoDat^.OprtType = SEND_POSTED) ) then
begin
closesocket( CompletKey );
Dispose( pPerIoDat );
continue;
end;

if pPerIoDat^.OprtType = RECV_POSTED then
begin
fmmain.ListBox1.Items.Add( pPerIoDat^.BufData.buf );
end;

Flags := 0;
FillChar( pPerIoDat^.Overlap, sizeof(OVERLAPPED), 0 );
FillChar( pPerIoDat^.Buf[0], 4096, 0 );
pPerIoDat^.BufData.len := 4096;
pPerIoDat^.BufData.buf := pPerIoDat^.Buf;
pPerIoDat.OprtType := RECV_POSTED;

WSARecv( CompletKey, @(pPerIoDat^.BufData), 1, BytesRecv, Flags,
@(pPerIoDat^.Overlap), nil );
end;

//closesocket( CompletKey );
//Dispose( pPerIoDat );
end;

end.
----------------------------------------------------------------------------------
上面的完成端口的例子可能太C++了，換一個更Delphi的：

新建一個線程類TRecvSendThread ------------ thrRecvSend.pas

unit thrRecvSend;

interface

uses
Windows, Classes, Winsock2;

type
TRecvSendThread = class(TThread)
public
CompletPort : THandle;
protected
procedure Execute; override;
end;

implementation

uses thrListen, frmMain;

{ TRecvSendThread }

procedure TRecvSendThread.Execute;
var
CompletKey,
BytesTransd,
BytesRecv,
Flags : DWORD;
pPerIoDat : PPER_OPERATION_DATA;
begin
while (not self.Terminated) do
begin
BytesTransd := 0;
CompletKey := 0;
GetQueuedCompletionStatus( CompletPort, BytesTransd, CompletKey,
POVERLAPPED(pPerIoDat), TIME_OUT );

if ( BytesTransd = 0 ) and
( (pPerIoDat = nil) or
(pPerIoDat^.OprtType = RECV_POSTED) or
(pPerIoDat^.OprtType = SEND_POSTED) ) then
begin
closesocket( CompletKey );
Dispose( pPerIoDat );
continue;
end;

if pPerIoDat^.OprtType = RECV_POSTED then
begin
fmmain.ListBox1.Items.Add( pPerIoDat^.BufData.buf );
end;

Flags := 0;
FillChar( pPerIoDat^.Overlap, sizeof(OVERLAPPED), 0 );
FillChar( pPerIoDat^.Buf[0], 4096, 0 );
pPerIoDat^.BufData.len := 4096;
pPerIoDat^.BufData.buf := pPerIoDat^.Buf;
pPerIoDat.OprtType := RECV_POSTED;

WSARecv( CompletKey, @(pPerIoDat^.BufData), 1, BytesRecv, Flags,
@(pPerIoDat^.Overlap), nil );
end;

end;

end.

//-------------------------------------------------------------
原來的TListenThread也稍微修改一下。。。。。。。。。
unit thrListen;

interface

uses
Windows, Classes, Winsock2, thrRecvSend;

const
RECV_POSTED = 0;
SEND_POSTED = 1;
TIME_OUT = 110;
BUFFER_SIZE = 4096;

type
YPER_OPERATION_DATA = record
Overlap : OVERLAPPED;
BufData : WSABUF;
Buf : Array [0..BUFFER_SIZE-1] of Char;
OprtType : Integer;
end;
PPER_OPERATION_DATA = ^YPER_OPERATION_DATA;

YPER_HANDLE_DATA = record
Sock : TSocket;
Ip : Array [0..15] of Char;
Port : DWORD;
OprtType : Integer;
end;
PPER_HANDLE_DATA = ^YPER_HANDLE_DATA;


type
TListenThread = class(TThread)
private
{ Private declarations }
FCompletPort : THandle;
FListenSock : TSocket;
function InitSocket: BOOL;
protected
procedure Execute; override;
end;

implementation

uses frmMain;

{ TListenThread }

procedure TListenThread.Execute;
var
si : SYSTEM_INFO;
i, len : Integer;
AThread : TRecvSendThread;
AConnect : TSocket;
addr : TSockAddrIn;
BytesRecv,
Flags : DWORD;
pPerIoDat : PPER_OPERATION_DATA;
begin
if not InitSocket() then
Exit;

FCompletPort := CreateIoCompletionPort( INVALID_HANDLE_VALUE, 0,0,0 );
if FCompletPort = 0 then
begin
MessageBox( 0, 'CreateIoCompletionPort failed.', 'Error', MB_OK );
Exit;
end;

GetSystemInfo( si );
for i:=0 to si.dwNumberOfProcessors-1 do
begin
AThread := TRecvSendThread.Create( True );
AThread.CompletPort := FCompletPort;
AThread.FreeOnTerminate := True;
AThread.Resume;
end;

while (not self.Terminated) do
begin
len := sizeof(addr);
AConnect := accept( FListenSock, addr, len);
if AConnect = INVALID_SOCKET then
begin
sleepex( TIME_OUT, false );
continue;
end;

CreateIoCompletionPort( AConnect, FCompletPort, AConnect, 0 );

New( pPerIoDat );

FillChar( pPerIoDat^.Overlap, sizeof(OVERLAPPED), 0 );
FillChar( pPerIoDat^.Buf[0], BUFFER_SIZE, 0 );
pPerIoDat^.BufData.len := BUFFER_SIZE;
pPerIoDat^.BufData.buf := pPerIoDat^.Buf;
pPerIoDat.OprtType := RECV_POSTED;

Flags := 0;
WSARecv( AConnect, @(pPerIoDat^.BufData), 1, BytesRecv, Flags,
@(pPerIoDat^.Overlap), nil );
end;

PostQueuedCompletionStatus( FCompletPort, 0,0,nil );
CloseHandle( FCompletPort );
end;

function TListenThread.InitSocket: BOOL;
var
addr : TSockAddr;
begin
result := False;

FListenSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
if FListenSock = INVALID_SOCKET then
begin
MessageBox( 0, 'Call socket() failed.', 'Error', MB_ICONERROR );
Exit;
end;

addr.sin_family := AF_INET;
addr.sin_port := htons(LISTEN_PORT);
addr.sin_addr.S_addr := htonl(INADDR_ANY);

if bind( FListenSock, @addr, sizeof(SOCKADDR) ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call bind failed.', 'Error', MB_ICONERROR );
Exit;
end;

if listen( FListenSock, 5 ) = SOCKET_ERROR then
begin
MessageBox( 0, 'Call listen failed.', 'Error', MB_ICONERROR );
Exit;
end;

result := True;
end;

end.