Request-response programming framework in tserversocket Blocking Mode

In the thread blocking mode (tthreadblocking) of the tserversocket in DELPHI6, The onread/onwrite event is executed in the main thread. Although it is multi-thread, the actual efficiency is not high.
Therefore, if we need to use tserversocket to develop a truly multi-threaded server, we need to write the Child class of tserverclientthread. In this child class, we can handle data receiving and sending by ourselves, the rewrite focuses on the clientexecute method. Below isCodeDescribes this programming idea.

Type
Tserverform = Class (tform)
...
Private
Procedure getthread (Sender: tobject; clientsocket: tserverclientwinsocket; var socketthread: tserverclientthread );
End;

Type
Tmyserverclientthread = Class (tserverclientthread)
Private
Function waitfordata (Timeout: integer): Boolean;
Protected
Procedure clientexecute; override;
End;

Implementation

{Tmyserverclientthread}

Function tmyserverclientthread. waitfordata (Timeout: integer): Boolean;
VaR
Fdset: tfdset;
Timeval: ttimeval;
Begin
Fd_zero (fdset );
Fd_set (clientsocket. sockethandle, fdset );
Timeval. TV _sec: = timeout Div 1000;
Timeval. TV _usec: = timeout mod 1000;
Result: = select (0, @ fdset, nil, nil, @ timeval)> 0
End;

Procedure tmyserverclientthread. clientexecute;
VaR
Inputbuffer: tsockbuffer;
Ilen, IPOs: integer;
Scmd: string;
Tmpbuf: string;
Begin
Inputbuffer: = tsockbuffer. Create;
Try
While not terminated and clientsocket. Connected do
Begin
If waitfordata (500) and not terminated then
Begin
Ilen: = clientsocket. cancelength;
If ilen = 0 then
Begin
Break
End else
Begin
Setlength (tmpbuf, ilen );
Clientsocket. receivebuf (tmpbuf [1], ilen );
Inputbuffer. writebuffer (tmpbuf [1], ilen );
IPOs: = inputbuffer. pos (EoL );
If IPOs> 0 then
Begin
Scmd: = inputbuffer. Extract (IPOs + 1 );
Delete (scmd, length (scmd)-1, 2 );
If cmdlist. indexof (scmd)>-1 then
Clientsocket. sendtext ('+ OK ');
If sametext (scmd, 'exit ') then
Break;
End;
End;
End;
End;
Finally
Inputbuffer. Free;
End;
End;

{Tserverform}

Procedure tserverform. formcreate (Sender: tobject );
Begin
With tserversocket. Create (Self) Do
Begin
Port: = 4001;
Servertype: = stthreadblocking;
Ongetthread: = getthread; // this step is critical. When an ongetthread event is generated, create your own thread.
Active: = true;
End;
End;

Procedure tserverform. getthread (Sender: tobject;
Clientsocket: tserverclientwinsocket;
VaR socketthread: tserverclientthread );
Begin
Socketthread: = tmyserverclientthread. Create (false, clientsocket );
End;