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.

delphi异步选择模型编程TCP的更多相关文章

  1. DELPHI异步选择模型UDP

    unit U_FrmServer; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Di ...

  2. 网络IO模型-异步选择模型(Delphi版)

    其实关于这个模型,网络上也有一个案例说明 老陈使用了微软公司的新式信箱.这种信箱非常先进,一旦信箱里有新的信件,盖茨就会给老陈打电话:喂,大爷,你有新的信件了!从此,老陈再也不必频繁上下楼检查信箱了, ...

  3. 二.Windows I/O模型之异步选择(WSAAsyncSelect)模型

    1.基于windows消息为基础的网络事件io模型.因此我们必须要在窗口程序中使用该模型.该模型中的核心是调用WSAAsyncSelect函数实现异步I/O. 2.WSAAsyncSelect函数:注 ...

  4. Delphi最简化异步选择TCP服务器

    网上Delphi的Socket服务器优良代码,实在少见,索性写个简化的异步Socket服务器,虽然代码较少,但却该有的都有了,使用的是异步选择WSAAsyncSelect,减少了编写线程的繁琐.可能会 ...

  5. (1)基于tcp协议的编程模型 (2)tcp协议和udp协议的比较 (3)基于udp协议的编程模型 (4)反射机制

    1.基于tcp协议的编程模型(重中之重)1.1 编程模型服务器: (1)创建ServerSocket类型的对象,并提供端口号: (2)等待客户端的连接请求,调用accept()方法: (3)使用输入输 ...

  6. windows下的IO模型之异步选择(WSAAsyncSelect)模型

    异步选择(WSAAsyncSelect)模型是一个有用的异步I/O 模型.其核心函数是WSAAsyncSelect,该函数是非阻塞的 (关于异步io的理解详情可以看:http://www.cnblog ...

  7. Linux 网络编程的5种IO模型:异步IO模型

    Linux 网络编程的5种IO模型:异步IO模型 资料已经整理好,但是还有未竟之业:复习多路复用epoll 阅读例程, 异步IO 函数实现 背景 上一讲< Linux 网络编程的5种IO模型:信 ...

  8. windows socket网络编程--事件选择模型

    目录 事件选择模型概述 API详解 工作原理 代码实现 事件选择模型概述 Winsock提供了另一种有用的异步事件通知I/O模型--WSAEventSelect模型.这个模型与WSAAsyncSele ...

  9. python 并发编程 异步IO模型

    异步IO(Asynchronous I/O) Linux下的asynchronous IO其实用得不多,从内核2.6版本才开始引入.先看一下它的流程: 用户进程发起read操作之后,立刻就可以开始去做 ...

随机推荐

  1. jsp 访问文件夹中的图片,tomcat配置虚拟目录

    1.配置hosts文件 找到C:\Windows\System32\drivers\etc\hosts.txt 文件 添加127.0.0.1  www.image.com  在dos 命令中执行 pi ...

  2. R in action读书笔记(4)-第六章:基本图形(下)

    6.3直方图 hist() 其中的x是一个由数据值组成的数值向量.参数freq=FALSE表示根据概率密度而不是频数绘制图形.参数breaks用于控制组的数量.在定义直方图中的单元时,默认将生成等距切 ...

  3. pdf 使用模板下载

    //根据模板下载模板 /** * * 政策5-8条的创建的pdf的模板 */public String createPdfCashTemplate(PdfCashParam pdfCashParam) ...

  4. SQL条件语句(IF, CASE WHEN, IF NULL)

    1.IF   表达式:IF( expr1 , expr2 , expr3 )   expr1条件,条件为true,则值是expr2 ,false,值就是expr3 SELECT o.id,u.acco ...

  5. c++ 模板template

    1.函数模板的声明 声明形式 template<typename 数据类型参数标识符> <返回类型><函数名>(参数表) {     函数体 } 注: templa ...

  6. Java递归扫描文件路径

    import java.io.File; public class Test { public static int count = 0; public static void main(String ...

  7. freenas iscsi initiator 配置

    1.加载Iscsi Initiator 模块 freebsd从7.0开始已经包含了Iscsi Initiator ,不需要安装后再使用,但在使用前,需要加载模块. # kldload -v iscsi ...

  8. 00PostgreSQL

    PostgreSQL PostgreSQL: The World's Most Advanced Open Source Relational Database;PostgreSQL是一个功能强大的开 ...

  9. 他山之石:D3DX书籍推荐

    一.DirectX9.0.3D游戏开发编程基础(龙书) 这本书网上评论很好,当初作为入门书看确实还不错,但是看得有点稀里糊涂的.现在回过头来看,它有些地方省略了,所以还得自己多多总结,总得来说还是值得 ...

  10. 洛谷——P2417 课程

    P2417 课程 裸地匈牙利算法, 贪心的不断匹配,若没匹配,则匹配:反之,判断与之匹配的点能否在找另一个点匹配,若能,抢多这个点与之匹配 时间复杂度$O(n\times m)$ #include&l ...