thrdsrv1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

        ClientThread                 := TClientThread.Create(TRUE);
        ClientThread.FreeOnTerminate := TRUE;
        ClientThread.WSocket         := Client;
        ClientThread.OnDisplay       := Display;
        ClientThread.Suspended       := FALSE;
        { Wait until thread is started and has attached client socket to    }
        { his own context.                                                  }
        while not ClientThread.ThreadAttached do
            Sleep(0);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event is called each time a new client is connecting.                }
{ Called in main thread context.                                            }
procedure TTcpSrvForm.WSocketServer1ClientConnect(
    Sender : TObject;
    Client : TWSocketClient;
    Error  : Word);
begin
    with Client as TThrdSrvClient do begin
        Display('Client connected.' +
                ' Remote: '     + PeerAddr + '/' + PeerPort +
                ' Local: '      + GetXAddr + '/' + GetXPort +
                ' ThreadID : $' + IntToHex(ClientThread.ThreadID, 8));
        LineMode            := TRUE;
        LineEdit            := TRUE;
        LineLimit           := 80; { Do not accept long lines }
        OnDataAvailable     := ClientDataAvailable;
        OnLineLimitExceeded := ClientLineLimitExceeded;
        OnBgException       := ClientBgException;
        ConnectTime         := Now;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called each time a client disconnect.               }
{ This procedure is called in main thread context.                          }
procedure TTcpSrvForm.WSocketServer1ClientDisconnect(
    Sender : TObject;
    Client : TWSocketClient;
    Error  : Word);
begin
    with Client as TThrdSrvClient do begin
        Display('Client disconnecting: ' + PeerAddr + '   ' +
                'Duration: ' + FormatDateTime('hh:nn:ss',
                Now - ConnectTime) +
                ' ThreadID : $' + IntToHex(GetCurrentThreadID, 8));

        { Clear WSocket reference in worker thread }
        { ClientThread.WSocket := nil;             }
        { Break message pump within worker thread  }
        PostThreadMessage(ClientThread.ThreadID, WM_QUIT, 0, 0);
        { Allow up to 10 second for thread termination }
        WaitForSingleObject(ClientThread.Handle, 10000);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is called in client thread context. So be aware about GUI  }
{ update: you must use synchronize like ClientThread.Display does.          }
procedure TTcpSrvForm.ClientLineLimitExceeded(
    Sender        : TObject;
    Cnt           : LongInt;
    var ClearData : Boolean);
begin
    with Sender as TThrdSrvClient do begin
        ClientThread.Display('Line limit exceeded from ' + GetPeerAddr + '. Closing.');
        ClearData := TRUE;
        Close;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Each time a client has datavailable triggers this event handler.          }
{ We receive data (line mode) and execute "commands".                       }
{ This procedure is called in client thread context. So be aware about GUI  }
{ update: you must use synchronize like ClientThread.Display does.          }
procedure TTcpSrvForm.ClientDataAvailable(
    Sender : TObject;
    Error  : Word);
begin
    with Sender as TThrdSrvClient do begin
        { We use line mode. We will receive complete lines }
        RcvdLine := ReceiveStr;
        { Remove trailing CR/LF }
        while (Length(RcvdLine) > 0) and
              (RcvdLine[Length(RcvdLine)] in [#13, #10]) do
            RcvdLine := Copy(RcvdLine, 1, Length(RcvdLine) - 1);
        ClientThread.Display('Received from ' + GetPeerAddr + ': ''' +
                             RcvdLine + ''' ' +
                             'ThreadID: $' + IntToHex(GetCurrentThreadID, 8));
        ProcessData(Sender as TThrdSrvClient);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is called in client thread context. So be aware about GUI  }
{ update: you must use synchronize.                                         }
procedure TTcpSrvForm.ProcessData(Client : TThrdSrvClient);
var
    I       : Integer;
    AClient : TThrdSrvClient;
begin
    { We could replace all those CompareText with a table lookup }
    if CompareText(Client.RcvdLine, 'help') = 0 then
        Client.SendStr('Commands are:' + #10#13 +
                       '  exit'      + #10#13 +
                       '  who'       + #10#13 +
                       '  sleep'     + #10#13 +
                       '  time'      + #10#13 +
                       '  exception' + #10#13)
    else if CompareText(Client.RcvdLine, 'exit') = 0 then
        { We can't call Client.Close here because we will immediately }
        { reenter DataAvailable event handler with same line because  }
        { a line is removed from buffer AFTER it has been processed.  }
        { Using CloseDelayed will delay Close until we are out of     }
        { current event handler.                                      }
        Client.CloseDelayed
    else if CompareText(Client.RcvdLine, 'time') = 0 then
        { Send server date and time to client }
        Client.SendStr(DateTimeToStr(Now) + #13#10)
    else if CompareText(Client.RcvdLine, 'who') = 0 then begin
        { Send client list to client }
        Client.SendStr('There are ' + IntToStr(WSocketServer1.ClientCount) +
                       ' connected users:' + #13#10);
        for I := WSocketServer1.ClientCount - 1 downto 0 do begin
            AClient := TThrdSrvClient(WSocketServer1.Client[I]);
            Client.SendStr(AClient.PeerAddr + ':' + AClient.GetPeerPort + ' ' +
                           DateTimeToStr(AClient.ConnectTime) + #13#10);
        end;
    end
    else if CompareText(Client.RcvdLine, 'Sleep') = 0 then begin
        Client.SendStr('Now sleeping for 15"...' + #13#10);
        Sleep(15000);
        Client.SendStr('Wakeup !' + #13#10);
    end
    else if CompareText(Client.RcvdLine, 'exception') = 0 then
        { This will trigger a background exception for client }
        PostMessage(Client.Handle, WM_TRIGGER_EXCEPTION, 0, 0)
    else
        if Client.State = wsConnected then
            Client.SendStr('Unknown command: ''' + Client.RcvdLine + '''' + #13#10);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called when listening (server) socket experienced   }
{ a background exception. Should normally never occurs.                     }
{ This procedure is called in main thread context.                          }
procedure TTcpSrvForm.WSocketServer1BgException(
    Sender       : TObject;
    E            : Exception;
    var CanClose : Boolean);
begin
    Display('Server exception occured: ' + E.ClassName + ': ' + E.Message);
    CanClose := FALSE;  { Hoping that server will still work ! }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called when a client socket experience a background }
{ exception. It is likely to occurs when client aborted connection and data }
{ has not been sent yet.                                                    }
{ Warning: This procedure is executed in worker thread context.             }
procedure TTcpSrvForm.ClientBgException(
    Sender       : TObject;
    E            : Exception;
    var CanClose : Boolean);
begin
    with Sender as TThrdSrvClient do begin
        ClientThread.Display('Client exception occured: ' +
                             E.ClassName + ': ' + E.Message);
    end;
    CanClose := TRUE;   { Goodbye client ! }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{*                                                                         *}
{*                          TClientThread                                  *}
{*                                                                         *}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This is our client worker thread main procedure. It is thread's code.     }
{ We have to attach client socket to this thread's context and then         }
{ process messages so that TWSocket events works.                           }
procedure TClientThread.Execute;
begin
    if not Assigned(WSocket) then
        Exit;

    { Attach client socket to this thread                                   }
    WSocket.ThreadAttach;
    { Signal main thread that we've attached socket to this thread          }
    ThreadAttached := TRUE;
    { Now let main thread continue starting the connection.                 }
    { This little avoid race condition.                                     }
    Sleep(0);
    { Then process messages until WM_QUIT message is posted.                }
    { TWSocket is event-driven. So even when used within a thread, we       }
    { have to have a "message pump". Any message pump will do and there     }
    { is one built in TWSocket, so use it !                                 }
    WSocket.MessageLoop;
    { Be sure to have main thread waiting for termination before terminating}
    Sleep(0);
    { Detach the hidden window from within the thread                       }
    WSocket.ThreadDetach;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is called from client thread and must display a message    }
{ on the GUI (main application form). As we are in a thread, we can't       }
{ simply call something that act on the GUI, we MUST use synchronize to ask }
{ main thread to update the GUI.                                            }
procedure TClientThread.Display(const Msg: String);
begin
    { Synchronized procedure have no parameter, we must use a variable      }
    FMsg := Msg;
    { Then synchronize the procedure (which will use FMsg)                  }
    Synchronize(DisplayMsg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Never call this procedure directly, always call Synchronize(DisplayMsg)   }
procedure TClientThread.DisplayMsg;
begin
    if Assigned(FOnDisplay) then
        FOnDisplay(FMsg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.