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;