Delphi simplifies the asynchronous selection of TCP servers

On-line Delphi Socket Server Good code, it is rare, simply write a simplified asynchronous socket server, although the code is less, but there are all, the use of asynchronous select WSAAsyncSelect, reduce the tedious writing thread. May ask, how is the performance? Of course, the use of form message notification, occupy the main thread, listening, sending, the reception of multiple clients are a thread, a lot of data, the performance of course is not satisfactory, writing this code is not the purpose of this. But in the actual project, the large data volume situation is not much, the following is the code: (Delphi7 Compilation)

{The most streamlined message asynchronous socket Async selection WSAAsyncSelect, no 64 limit} ProgramSocketdemo;{$APPTYPE CONSOLE}usesWindows, WinSock;ConstListenport:word=12345; Buffersize:dword=1024x768;typeTconn=^tconndata; Tconndata=RecordFsocket:tsocket;    FADDRIN:TSOCKADDR;    Buffer:pchar;  Buflen:integer; End;procedureDosocketdata (conn:tconn);varSstring;beginWriteln (Conn.buffer); //Insert Business processing code heres:='Server Echo'; Send (Conn.fsocket, PChar (s) ^, Length (s),0);End;//do not modify the following--------------------ConstWcname:pchar='Thrwndclass'; Wm_socket={Wm_user}$0400+101;//Custom MessagesvarAddrinlen:integer=SizeOf (tsockaddr);varFconns:Array  ofTconn;functionGetfreeconn:integer;varI:integer;beginResult:= -1;  fori:=0  toHigh (Fconns) Do  iffconns[i]=Nil  Then beginResult:=i;  break; End; ifresult<0  Then beginResult:= Length (Fconns); SetLength (Fconns, result+1); End; Fconns[result]:=New (Tconn); Getmem (Fconns[result]. Buffer, BufferSize+1); Fconns[result]. Buflen:=buffersize;End;functionGetcltconn (s:tsocket): Integer;varI:integer;begin   fori:=0  toHigh (Fconns) Do  ifAssigned (Fconns[i]) and(Fconns[i]. Fsocket=s) Then beginResult:=i;  break; End;End;procedureFreeconn (s:tsocket);varId:integer;varConn:tconn;beginID:=Getcltconn (S); Conn:=Fconns[id]; if  notAssigned (Conn) ThenExit;  Freemem (Conn.buffer);  Closesocket (Conn.fsocket);  Dispose (Conn); Fconns[id]:=Nil;End;functionWndProc (WND, MSG, sock, Wm:dword): Integer;stdcall;varID, Addrlen:integer;beginResult:=DefWindowProc (WND, MSG, sock, WM); if(Msg<>wm_socket)or(wm=0) ThenExit;  CaseLoWord (WM) offd_accept:beginID:=Getfreeconn;  withfconns[id]^ Do beginFsocket:=Accept (sock, @FAddrIn, @AddrInLen); WSAAsyncSelect (Fsocket, Wnd, Wm_socket, Fd_readorfd_close); End; End; Fd_read:beginID:=Getcltconn (sock);  withfconns[id]^ Do beginBuflen:= Recv (sock, buffer^, BufferSize,0); if(buflen<0)or(Buflen>buflen) ThenFreeconn (sock)Else          beginBuffer[buflen]:= #0; TryDosocketdata (Fconns[id])except End; End; End; End;  Fd_close:freeconn (sock); End;End;functionMakewndhandle (wndproc:pointer; wcname:pchar): HWND;varWc:twndclass;beginFillchar (WC, SizeOf (WC),0); Wc.lpfnwndproc:=WndProc; Wc.hinstance:=hinstance; Wc.lpszclassname:=Wcname;  Windows.registerclass (WC); Result:= CreateWindow (Wcname,'Hrwnd',0,0,0,0,0,0,0, HINSTANCE,Nil);End;functionSrvlisten (Port:word): Boolean;varWnd:hwnd; S:tsocket; Addr:tsockaddrin; Wsadata:twsadata;beginWSAStartup ($0202, Wsadata); Addr.sin_family:=af_inet; Addr.sin_port:=Swap (Port); Addr.sin_addr. S_ADDR:=0; S:=sockets (Af_inet, Sock_stream, ipproto_tcp);  Bind (S, Addr, Addrinlen); Wnd:=Makewndhandle (@WndProc, wcname); WSAAsyncSelect (S, Wnd, Wm_socket, Fd_acceptorfd_close); //Writeln (Syserrormessage (WSAGetLastError ()), ' Wnd: ', Wnd);Listen (S),5);End;procedureSysfina;beginWindows.unregisterclass (Wcname, hinstance); WSACleanup;End;procedurestay;varmsg:tmsg;begin   whileGetMessage (MSG,0,0,0) Do beginTranslateMessage (msg);  DispatchMessage (msg); End; PostQuitMessage (0);End;begin  //if Initproc <> nil then tprocedure (INITPROC);Srvlisten (Listenport);  Stay;  Sysfina; Halt (0);End.

Delphi simplifies the asynchronous selection of TCP servers