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.