Delphi6中的TServerSocket在线程阻塞模式(TThreadBlocking)下,OnRead/OnWrite事件的是在主线程中执行的,虽为多线程,实际效率不高。
故我们若需要利用TServerSocket来开发真正多线程的服务器,则需要写TServerClientThread的子类,在这个子类中,自行处理数据的接收与发送,而重写的的重点在ClientExecute方法。下面为代码描述了这种编程思路。
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.ReceiveLength;
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; //这一步是关键,OnGetThread事件产生时,创建自己的线程。
Active:=True;
end;
end;
procedure TServerForm.GetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:=TMyServerClientThread.Create(False,ClientSocket);
end;