网上Delphi的Socket服务器优良代码,实在少见,索性写个简化的异步Socket服务器,虽然代码较少,但却该有的都有了,使用的是异步选择WSAAsyncSelect,减少了编写线程的繁琐。可能会问,性能如何?当然使用窗体消息通知,占用的是主线程,侦听、发送、多个客户端的接收都一个线程,大量数据时,性能当然是差强人意的,编写这个代码目的也不在于此。但是在实际的项目中,大数据量的情况也不多,以下是代码:(Delphi7编译)

{
最简化的消息异步Socket 异步选择WSAAsyncSelect, 没有64的限制
} program SocketDemo; {$APPTYPE CONSOLE} uses Windows, WinSock; const
ListenPort : Word = ;
BufferSize : DWORD = ; type
TConn = ^TConnData;
TConnData = record
FSocket: TSocket;
FAddrIn: TSockAddr;
Buffer : PChar;
BufLen : Integer;
end; procedure DoSocketData(Conn: TConn);
var S: string;
begin
Writeln(Conn.Buffer);
//这里插入业务处理代码
S:= 'Server echo';
send(Conn.FSocket, PChar(S)^, Length(S), );
end; //--------- 以下不要修改 -----------
const
wcName : PChar = 'THrWndClass';
WM_SOCKET = {WM_USER}$ + ; // 自定义消息 var
AddrInLen: Integer = SizeOf(TSockAddr); var FConns: array of TConn; function GetFreeConn: Integer;
var i: Integer;
begin
Result:= -;
for i:= to High(FConns) do
if FConns[i]=nil then begin
Result:= i; Break;
end;
if Result< then begin
Result:= Length(FConns); SetLength(FConns, Result+);
end;
FConns[Result]:= New(TConn);
GetMem(FConns[Result].Buffer, BufferSize+);
FConns[Result].BufLen:= BufferSize;
end; function GetCltConn(S: TSocket): Integer;
var i: Integer;
begin
for i:= to High(FConns) do
if Assigned(FConns[i]) and (FConns[i].FSocket=S) then begin
Result:= i; Break;
end;
end; procedure FreeConn(S: TSocket);
var id: Integer;
var Conn: TConn;
begin
id:= GetCltConn(S);
Conn:= FConns[id];
if not Assigned(Conn) then Exit;
FreeMem(Conn.Buffer);
CloseSocket(Conn.FSocket);
Dispose(Conn);
FConns[id]:= nil;
end; function WndProc(wnd, msg, sock, wm: DWORD): Integer; stdcall;
var id, AddrLen: Integer;
begin
Result:= DefWindowProc(wnd, msg, sock, wm);
if (msg<>WM_SOCKET) or (wm=) then Exit;
case LoWord(wm) of
FD_ACCEPT:
begin
id:= GetFreeConn;
with FConns[id]^ do begin
FSocket:= Accept(sock, @FAddrIn, @AddrInLen);
WSAAsyncSelect(FSocket, wnd, WM_SOCKET, FD_READ or FD_CLOSE);
end;
end;
FD_READ:
begin
id:= GetCltConn(sock);
with FConns[id]^ do begin
BufLen:= Recv(sock, Buffer^, BufferSize, );
if (BufLen<) or (BufLen>Buflen) then FreeConn(sock) else
begin
Buffer[BufLen]:= #;
try DoSocketData(FConns[id]) except end;
end;
end;
end;
FD_CLOSE: FreeConn(sock);
end;
end; function MakeWndHandle(WndProc: Pointer; wcName: PChar): HWND;
var wc: TWndClass;
begin
FillChar(wc, SizeOf(wc), );
wc.lpfnWndProc := WndProc;
wc.hInstance := HInstance;
wc.lpszClassName:= wcName;
Windows.RegisterClass(wc);
Result:= CreateWindow(wcName,'HrWnd',,,,,,,,HInstance,nil);
end; function SrvListen(Port: Word): Boolean;
var Wnd: HWND; S: TSocket; Addr: TSockAddrIn; WSAData: TWSAData;
begin
WSAStartup($, WSAData);
Addr.sin_family := AF_INET;
Addr.sin_port := Swap(Port);
Addr.sin_addr.S_addr := ;
S:= Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
Bind(S, Addr, AddrInLen); Wnd:= MakeWndHandle(@WndProc, wcName);
WSAAsyncSelect(S, Wnd, WM_SOCKET, FD_ACCEPT or FD_CLOSE);
//Writeln(SysErrorMessage(WSAGetLastError()), ' Wnd: ', Wnd);
Listen(S, );
end; procedure SysFina;
begin
Windows.UnregisterClass(wcName, HInstance);
WSACleanup;
end; procedure Stay;
var msg: TMsg;
begin
while GetMessage(msg, , , ) do begin
TranslateMessage(msg);
DispatchMessage (msg);
end;
PostQuitMessage();
end; begin
//if InitProc <> nil then TProcedure(InitProc);
SrvListen(ListenPort);
Stay;
SysFina;
Halt();
end.

Delphi最简化异步选择TCP服务器的更多相关文章

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

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

  2. Swoole学习(七)Swoole之异步TCP服务器的创建

    环境:Centos6.4,PHP环境:PHP7 <?php //创建TCP服务器 /** * $host 是swoole需要监听的ip,如果要监听本地,不对外服务,那么就是127.0.0.1;如 ...

  3. 【Python】使用socketserver建立一个异步TCP服务器

    概述 这篇文章是讲解如何使用socketserver建立一个异步TCP服务器,其中Python版本为3.5.1. socketserver主要的类 socketserver模块中的类主要有以下几个:1 ...

  4. 06.swoole学习笔记--异步tcp服务器

    <?php //创建tcp服务器 $host='0.0.0.0'; $port=; $serv=new swoole_server($host,$port); //设置异步进程工作数 $serv ...

  5. php的异步非阻塞swoole模块使用(一)实现简易tcp服务器--服务端

    绑定tcp服务器的地址 $swserver = new swoole_server("127.0.0.1",9501); 设置tcp服务器装机容量(太危言耸听了-其实就是设置属性) ...

  6. 使用.net core在Ubuntu构建一个TCP服务器

    介绍和背景 TCP编程是网络编程领域最有趣的部分之一.在Ubuntu环境中,我喜欢使用.NET Core进行TCP编程,并使用本机Ubuntu脚本与TCP服务器进行通信.以前,我在.NET框架本身写了 ...

  7. 使用CBrother做TCP服务器与C++客户端通信

    使用CBrother脚本做TCP服务器与C++客户端通信 工作中总是会遇到一些对于服务器压力不是特别大,但是代码量比较多,用C++写起来很不方便.对于这种需求,我选择用CBrother脚本做服务器,之 ...

  8. LwIP应用开发笔记之五:LwIP无操作系统TCP服务器

    前面我们实现了UDP服务器及客户端以及基于其上的TFTP应用服务器.接下来我们将实现同样广泛应用的TCP协议各类应用. 1.TCP简述 TCP(Transmission Control Protoco ...

  9. PHP写的异步高并发服务器,基于libevent

    PHP写的异步高并发服务器,基于libevent 博客分类: PHP PHPFPSocketLinuxQQ  本文章于2013年11月修改. swoole已使用C重写作为PHP扩展来运行.项目地址:h ...

随机推荐

  1. 【189】◀▶ PowerShell 系统学习

    参考网站如下: PowerShell 中文博客      PowerShell 博客——叹为观止 Mater-PowerShell      通过 PowerShell 编写脚本      Power ...

  2. 【184】FileZilla 搭建 FTP 及访问

    参考:FileZilla 下载中心 参考:使用FileZilla Server轻松搭建个人FTP服务器 建好后,Windows 访问:Windows徽标键+R打开运行窗口,输入ftp://*** ,* ...

  3. CodeForces 721A One-dimensional Japanese Crossword (水题)

    题意:给定一行字符串,让你输出字符‘B'连续出现的次数. 析:直接扫一下就OK了. 代码如下: #pragma comment(linker, "/STACK:1024000000,1024 ...

  4. bzoj 1415: [Noi2005]聪聪和可可【期望dp+bfs】

    因为边权为1所以a直接bfs瞎搞就行--我一开始竟然写了个spfa #include<iostream> #include<cstdio> #include<queue& ...

  5. 《Windows核心编程系列》十谈谈同步设备IO与异步设备IO之异步IO

    同步设备IO与异步设备IO之异步IO介绍 设备IO与cpu速度甚至是内存访问相比较都是比较慢的,而且更不可预测.虽然如此,通过使用异步设备IO我们仍然能够创造出更高效的程序. 同步IO时,发出IO请求 ...

  6. linux自动连接校园网设置

    不知道有没有人用linux的时候碰到过校园网连接后,跳不出登录界面,即使手动输入也没有作用.写一个可能可行的方法: - 首先打开控制面板 选择网络代理 将代理中的选项设置为 估计现在就能自动弹出登录页 ...

  7. C#模版学习研究

    原文链接1   原文链接2 using System; using System.Collections.Generic; using System.Text; using T = System.By ...

  8. C# 判断是否移动设备

    /// <summary> /// 判断是否移动设备. /// </summary> /// <returns></returns> public st ...

  9. 谷歌的 I/O 2019,究竟推出了什么新特性?

    前言 昨天,也即赶在微软 Build 2019 的第二天,一年一度的2019年 Google I/O大会在美国如期举行,Google I/O 2019全纪录:AI惊艳,Android Q真香,包括两款 ...

  10. jqueryUI插件

    <link rel="stylesheet" href="~/Content/themes/base/jquery-ui.css" /> <s ...