本文轉自http://bbs.csdn.net/topics/70155972
1.WSAAsyncSelect模型
2.select模型3.Overlapped I/O 完成例程
4.WSAEventSelect模型
5.Overlapped I/O 事件通知
6.完成端口
Winsock2單元要到http://delphi-jedi.org下載。或者隨便搜一下，網上應該有很多。。。
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.
2. 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.
3. 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.
4. 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.
5. 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.
6.
完成端口
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.
