WSAAsyncSelect模型Delphi简单实现

WSAAsyncSelect模型允许应用程序以Windows消息的形式接收网络事件通知。

WSAAsyncSelect函数自动将套接字设置为非阻塞形式，并且为套接字绑定一个窗口句柄，当有网络事件发生时，便向这个窗口发送消息，函数定义如下：

int WSAAsyncSelect(
 //需要设置的套接字句柄
 SOCKET s,
 //指定的一个窗口句柄
 //套接字的通知消息将被发送到与其对应的窗口过程中         
 HWND hWnd,
 //网络事件到来接收到的消息ID，
 //可以在WM_USER以上的数值中任意选择一个
 unsigned int wMsg,
 //指定哪些通知码需要发送
 long lEvent
);

成功调用WSAAsyncSelect后，在窗口函数中对应的wParam参数指定发生网络事件的套接字句柄，lParam参数的低字位指定了发生的网络事件，高字位包含了任何可能出现的错误代码，可以使用WSAGetSelectError和WSAGetSelectEvent将这些信息取出，如果没有错误发生，出错代码为0，程序可以继续检查通知码，以确定发生的网络事件。

代码：

Server端：

unit U_FrmServer;

interface

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

const
 WM_WINSOCK_ASYNC_MSG = WM_USER + 2987;
type
 TTestServer = class(TComponent)
 private
   FWindow: HWND;
   FServerSocket: TSocket;
 protected
   procedure WndProc(var Msg: TMessage);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;

   procedure OpenServer;
 end;

 TfrmServer = class(TForm)
   btnOpenServer: TButton;
   procedure btnOpenServerClick(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
   FServer: TTestServer;
 public
   { Public declarations }
 end;

var
 frmServer: TfrmServer;
 WSData: TWSAData;

implementation

{$R *.DFM}

{ TTestServer }

constructor TTestServer.Create(AOwner: TComponent);
begin
 inherited;
 FWindow := INVALID_HANDLE_VALUE;
 FServerSocket := INVALID_SOCKET;
end;

destructor TTestServer.Destroy;
begin
 {Clsses.}DeallocateHWnd(FWindow);
 closesocket(FServerSocket);
 inherited;
end;

procedure TTestServer.OpenServer;
var
 sin: TSockAddrIn;
begin
 //建立一个隐藏窗口，获得句柄
 if FWindow = INVALID_HANDLE_VALUE then begin
   FWindow := {Classes.} AllocateHWnd(WndProc);
 end;

 FServerSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
 sin.sin_family := AF_INET;
 sin.sin_port := htons(4567);
 sin.sin_addr.S_addr := INADDR_ANY;

 //绑定套接字到本机
 if bind(FServerSocket, @sin, SizeOf(sin)) = SOCKET_ERROR then exit;

 //将套接字设置为窗体通知消息类型
 WSAAsyncSelect(FServerSocket, FWindow, WM_WINSOCK_ASYNC_MSG,
   FD_ACCEPT or FD_CLOSE or FD_READ or FD_WRITE);
 //进入监听模式
 listen(FServerSocket, 5);
end;

procedure TTestServer.WndProc(var Msg: TMessage);
var
 sClient, sEvent: TSocket;
 addrRemote: TSockAddrIn;
 nAddrLen, nRecv: Integer;
 sRecv: string;
begin
 //非Socket消息
 if Msg.Msg <> WM_WINSOCK_ASYNC_MSG then begin
   Msg.Result := DefWindowProc(FWindow, Msg.Msg, Msg.WParam, Msg.LParam);
   Exit;
 end;

 //取得有事件发生的套接字
 sEvent := Msg.WParam;
 if WSAGetSelectError(Msg.lParam) <> 0 then begin
   closesocket(sEvent);
   exit;
 end;

 //处理发生的事件
 case WSAGetSelectEvent(Msg.lParam) of
   //监听的套接字检测到有连接进入
   FD_ACCEPT:
     begin
       nAddrLen := sizeOf(addrRemote);
       sClient := accept(sEvent, addrRemote, nAddrLen);
       WSAAsyncSelect(sClient, FWindow, WM_WINSOCK_ASYNC_MSG,
         FD_READ or FD_WRITE or FD_CLOSE);
       ShowMessage(inet_ntoa(addrRemote.sin_addr) + ' connected');
     end;
   FD_WRITE:
     begin

     end;
   FD_READ:
     begin
       SetLength(sRecv, 1024);
       nRecv := recv(sEvent, sRecv[1], 1024, 0);
       if nRecv = -1 then closesocket(sEvent)
       else begin
         SetLength(sRecv, nRecv);
         ShowMessage(sRecv);
       end;
     end;
   FD_CLOSE:
     begin
       closesocket(sEvent);
       ShowMessage('Clent Quit');
     end;
 end;
end;

procedure TfrmServer.btnOpenServerClick(Sender: TObject);
begin
 FServer := TTestServer.Create(Self);
 FServer.OpenServer;
end;

procedure TfrmServer.FormDestroy(Sender: TObject);
begin
 FServer.Free;
end;

initialization
 WSAStartup($0202, WSData);

finalization
 WSACleanup;

end.

Client端：

unit U_FrmClient;

interface

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

const
 WM_WINSOCK_ASYNC_MSG = WM_USER + 2988;

type
 TTestClient = class(TComponent)
 private
   FWindow: HWND;
   FClientSocket: TSocket;
 protected
   procedure WndProc(var Msg: TMessage);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;

   procedure SendStr(Str: string);
   procedure ConnectServer;
 end;

 TfrmClient = class(TForm)
   btnConnect: TButton;
   btnSend: TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure btnConnectClick(Sender: TObject);
   procedure btnSendClick(Sender: TObject);
 private
   { Private declarations }
   FClient: TTestClient;
 public
   { Public declarations }
 end;

var
 frmClient: TfrmClient;
 WSData: TWSAData;

implementation

{$R *.DFM}

{ TTestClient }

procedure TTestClient.ConnectServer;
var
 servAddr: TSockAddrIn;
begin
 if FWindow = INVALID_HANDLE_VALUE then begin
   FWindow := {Classes.} AllocateHWnd(WndProc);
 end;

 if FClientSocket = INVALID_SOCKET then begin
   FClientSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
   if FClientSocket = INVALID_SOCKET then exit;
 end;

 servAddr.sin_family := AF_INET;
 servAddr.sin_port := htons(4567);
 servAddr.sin_addr.S_addr := inet_addr('127.0.0.1');

 WSAAsyncSelect(FClientSocket, FWindow, WM_WINSOCK_ASYNC_MSG,
   FD_CONNECT or FD_WRITE or FD_READ or FD_CLOSE);

 if connect(FClientSocket, @servAddr, SizeOf(servAddr)) = -1 then exit;

 PostMessage(FWindow, WM_WINSOCK_ASYNC_MSG, FClientSocket,
   WSAMakeSelectReply(FD_CONNECT, 0));
end;

constructor TTestClient.Create(AOwner: TComponent);
begin
 inherited;
 FWindow := INVALID_HANDLE_VALUE;
 FClientSocket := INVALID_SOCKET;
end;

destructor TTestClient.Destroy;
begin
 {Clsses.}DeallocateHWnd(FWindow);
 closesocket(FClientSocket);
 inherited;
end;

procedure TTestClient.SendStr(Str: string);
begin
 send(FClientSocket, Pointer(Str)^, Length(Str), 0);
end;

procedure TTestClient.WndProc(var Msg: TMessage);
begin
 if Msg.Msg <> WM_WINSOCK_ASYNC_MSG then begin
   Msg.Result := DefWindowProc(FWindow, Msg.Msg, Msg.WParam, Msg.LParam);
   Exit;
 end;

 //客户端Socket
 if Msg.WParam <> Integer(FClientSocket) then Exit;

 if WSAGetSelectError(Msg.lParam) = 0 then begin
   exit;
 end;

 case WSAGetSelectEvent(Msg.lParam) of
   FD_CONNECT: ShowMessage('Connect Server succ');
   FD_READ: ShowMessage('recv succ');
   FD_WRITE: ShowMessage('send succ');
   FD_CLOSE: ;
 end;
end;

procedure TfrmClient.FormCreate(Sender: TObject);
begin
 FClient := TTestClient.Create(Self);
end;

procedure TfrmClient.FormDestroy(Sender: TObject);
begin
 FClient.Free;
end;

procedure TfrmClient.btnConnectClick(Sender: TObject);
begin
 FClient.ConnectServer;
end;

procedure TfrmClient.btnSendClick(Sender: TObject);
begin
 FClient.SendStr('test');
end;

initialization
 WSAStartup($0202, WSData);

finalization
 WSACleanup;

end.