delphi异步选择模型编程TCP

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端：

[delphi] view plain copy
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.