delphi异步选择模型编程TCP
2016-04-06 14:47
337 查看
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.
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.
相关文章推荐
- HTTP响应头和请求头信息对照表
- IP地址、子网掩码、网络号、主机号、网络地址、主机地址
- C#中检查网络是否连通的二种方法
- C# WebClient 使用http免费代理。
- (待续)IP, DNS, HTTP
- HTTP 缓存
- 详解HTTPS
- 基于Twisted的通过HTTP协议下载文件
- TCP/IP,Http,Socket,XMPP的区别
- 后端程序员也需要理解的HTTP缓存
- HTTP 304
- GPG error: http://cn.archive.ubuntu.com trusty InRelease: Clearsigned file isn't valid, got 'NODATA'
- 网络爬虫开发技术——快速线程池爬虫
- 网络爬虫开发技术——数据存储以及多线程
- Android客户端采用Http 协议Post方式请求与服务端进行数据交互(转)
- 网络爬虫开发技术——整站爬虫与Web挖掘
- 网络爬虫开发技术——入门
- iOS如何添加自定义UIWebView的HTTP请求头
- 汽车 http://www.chinawebinar.com/lobbyPage.do?eventId=100210&utm_source=CW&utm_medium=CW_eDM_1027&utm_
- 理解和正确使用Java中的断言(assert) - Leichelle的专栏 - 博客频道 - CSDN.NET http://blog.csdn.net/leichelle/article/deta