TOP

Delphi最简化异步选择TCP服务器(一)
2017-10-10 12:05:14 】 浏览:9760
Tags:Delphi 简化 异步 选择 TCP 服务器

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

 1 {
 2  最简化的消息异步Socket 异步选择WSAAsyncSelect, 没有64的限制  3 }
 4 
 5 program SocketDemo;  6 
 7 {$APPTYPE CONSOLE}
 8 
 9 uses Windows, WinSock;
 10 
 11 const
 12   ListenPort : Word  = 12345;  13   BufferSize : DWORD = 1024;  14 
 15 type
 16   TConn = ^TConnData;  17   TConnData = record
 18  FSocket: TSocket;  19  FAddrIn: TSockAddr;  20  Buffer : PChar;  21  BufLen : Integer;  22   end;  23 
 24 procedure DoSocketData(Conn: TConn);  25 var S: string;  26 begin
 27  Writeln(Conn.Buffer);  28   //这里插入业务处理代码
 29   S:= 'Server echo';  30   send(Conn.FSocket, PChar(S)^, Length(S), 0);  31 end;  32 
 33 
 34 
 35 //--------- 以下不要修改 -----------
 36 const
 37   wcName : PChar = 'THrWndClass';  38   WM_SOCKET = {WM_USER}$0400 + 101;        // 自定义消息
 39 
 40 var
 41   AddrInLen: Integer = SizeOf(TSockAddr);  42 
 43 var FConns: array of TConn;  44 
 45 function GetFreeConn: Integer;  46 var i: Integer;  47 begin
 48   Result:= -1;  49   for i:=0 to High(FConns) do
 50   if FConns[i]=nil then begin
 51     Result:= i; Break;  52   end;  53   if Result<0 then begin
 54     Result:= Length(FConns); SetLength(FConns, Result+1);  55   end;  56   FConns[Result]:= New(TConn);  57   GetMem(FConns[Result].Buffer, BufferSize+1);  58   FConns[Result].BufLen:= BufferSize;  59 end;  60 
 61 function GetCltConn(S: TSocket): Integer;  62 var i: Integer;  63 begin
 64   for i:=0 to High(FConns) do
 65   if Assigned(FConns[i]) and (FConns[i].FSocket=S) then begin
 66     Result:= i; Break;  67   end;  68 end;  69 
 70 procedure FreeConn(S: TSocket);  71 var id: Integer;  72 var Conn: TConn;  73 begin
 74   id:= GetCltConn(S);  75   Conn:= FConns[id];  76   if not Assigned(Conn) then Exit;  77  FreeMem(Conn.Buffer);  78  CloseSocket(Conn.FSocket);  79  Dispose(Conn);  80   FConns[id]:= nil;  81 end;  82 
 83 function WndProc(wnd, msg, sock, wm: DWORD): Integer; stdcall;  84 var id, AddrLen: Integer;  85 begin
 86   Result:= DefWindowProc(wnd, msg, sock, wm);  87   if (msg<>WM_SOCKET) or (wm=0) then Exit;  88   case LoWord(wm) of
 89  FD_ACCEPT:  90       begin
 91         id:= GetFreeConn;  92         with FConns[id]^ do begin
 93           FSocket:= Accept(sock, @FAddrIn, @AddrInLen);  94           WSAAsyncSelect(FSocket, wnd, WM_SOCKET, FD_READ or FD_CLOSE);  95         end;  96       end;  97  FD_READ:  98       begin
 99         id:= GetCltConn(sock); 100         with FConns[id]^ do begin
101           BufLen:= Recv(sock, Buffer^, BufferSize, 0); 102           if (BufLen<0) or (BufLen>Buflen) then FreeConn(sock) else
103           begin
104             Buffer[BufLen]:= #0; 105             try DoSocketData(FConns[id]) except end; 106           end; 107         end; 108       end; 109  FD_CLOSE: FreeConn(sock); 110   end; 111 end; 112 
113 function MakeWndHandle(WndProc: Pointer; wcName: PChar): HWND; 114 var wc: TWndClass; 115 begin
116   FillChar(wc, SizeOf(wc), 0); 117   wc.lpfnWndProc  := WndProc; 118   wc.hInstance    := HInstance; 119   wc.lpszClassName:= wcName; 120  Windows.RegisterClass(wc); 121   Result:= CreateWindow(wcName,'HrWnd',0,0,0,0,0,0,0,HInstance,nil); 122 end; 123 
124 function SrvListen(Port: Word): Boolean; 125 var Wnd: HWND; S: TSocket; Addr: TSockAddrIn; WSAData: TWSAData; 126 begin
127   WSAStartup($0202, WSAData); 128   Addr.sin_family      := AF_INET; 129   Addr.sin_port        := Swap(Port); 130   Addr.sin_addr.S_addr := 0; 131   S:= Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); 132  Bind(S, Addr, AddrInLen); 133 
134   Wnd:= MakeWndHandle(@Wnd  
		
Delphi最简化异步选择TCP服务器(一) https://www.cppentry.com/bencandy.php?fid=86&id=130072

首页 上一页 1 2 下一页 尾页 1/2/2
】【打印繁体】【投稿】【收藏】 【推荐】【举报】【评论】 【关闭】 【返回顶部
上一篇[调整] Firemonkey iOS 原生 Edit.. 下一篇重装系统后,delphi7打开报错