tnsrv2.pas

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

        Socket.SendStr('This is the last message line.' + #13 + #10);
        Response := '.'
    end
    else if CommandVerb = 'LIST' then begin
        if Trim(CommandTail) = '' then begin
            Socket.SendStr('+OK 2 messages (320 octets)' + #13 + #10);
            Socket.SendStr('1 120' + #13 + #10);
            Socket.SendStr('2 200' + #13 + #10);
            Response := '.'
        end
        else
            Response := '+OK ' + CommandTail + ' 200'
    end
    else if CommandVerb = 'STAT' then
        Response := '+OK 10 12345'
    else if CommandVerb = 'QUIT' then
        Response := '+OK'
    else if CommandVerb = 'TOP' then begin
        if atoi(CommandTail) <= 0 then
            Response := '-ERR Message doesn''t exists'
        else begin
            Socket.SendStr('+OK' + #13 + #10);
            Socket.SendStr('This is the message body.' + #13 + #10);
            Socket.SendStr('This is the last message line.' + #13 + #10);
            Response := '.'
        end;
    end
    else if CommandVerb = 'RPOP' then
        Response := '+OK'
    else if CommandVerb = 'APOP' then
        Response := '+OK'
    else if CommandVerb = 'DELE' then
        Response := '+OK'
    else if CommandVerb = 'LAST' then
        Response := '+OK 1'
    else if CommandVerb = 'NOOP' then
        Response := '+OK'
    else if CommandVerb = 'UIDL' then
        Response := '+OK ' + Trim(CommandTail) + ' Msg' + Trim(CommandTail)
    else if CommandVerb = 'RSET' then
        Response := '+OK'
    else
        Response := '-ERR';

    Socket.SendStr(Response + #13 + #10);
    if CommandVerb = 'QUIT' then
        Socket.Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Not a real TELNET command interpreter, just enough to see how it could    }
{ be implemented.                                                           }
procedure TClientForm.TELNET_Interpreter(
    CommandVerb : String;
    CommandTail : String);
begin
    Socket.SendStr(#13 + #10 + 'Executing command ''' + CommandVerb + '''...' +
                   #13 + #10);

    if CommandVerb = 'EXIT' then
        DisconnectButtonClick(Self)
    else if CommandVerb = 'HELP' then
        Socket.SendStr('List of commands:' + #13 + #10 +
                       '    Exit      logoff from server' + #13 + #10 +
                       '    Help      show this help screen' + #13 + #10)
    else
        Socket.SendStr('Unknown command, ignoring');

    Socket.SendStr(#13 + #10 + '--> ');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This is the command line interpreter. Should extend the code to support   }
{ every command needed...                                                   }
procedure TClientForm.CommandInterpreter;
var
    CommandVerb : String;
    CommandTail : String;
    I, J        : Integer;
begin
    CommandVerb := FCommand;

    { Skip leading spaces }
    I := 1;
    while (I <= Length(CommandVerb)) and (CommandVerb[I] in [' ', #9]) do
        Inc(I);

    { Find separator and separe CommandVerb and CommandTail }
    J := I;
    while TRUE do begin
        if (J >= Length(CommandVerb)) then begin
            CommandTail := '';
            break;
        end;

        if CommandVerb[J] in [' ', #9, '/'] then begin
            CommandTail := Copy(CommandVerb, J, Length(CommandVerb) - J + 1);
            CommandVerb := Copy(CommandVerb, I, J - I);
            break;
        end;
        Inc(J);
    end;
    CommandVerb := UpperCase(CommandVerb);

    if PortNum = SMTP_PORT then
        SMTP_Interpreter(CommandVerb, CommandTail)
    else if PortNum = POP3_PORT then
        POP3_Interpreter(CommandVerb, CommandTail)
    else
        TELNET_Interpreter(CommandVerb, CommandTail);

    FCommand := '';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{* Process each charcter received to do minimal line editing                }
procedure TClientForm.ProcessChar(Ch : Char);
begin
    if Ch = #8 then begin
        if Length(FCommand) > 0 then begin
            SetLength(FCommand, Length(FCommand) - 1);
            Socket.SendStr(#8 + ' ' + #8);
        end
        else
            Socket.SendStr(#7);
        Exit;
    end
    else if (Ch = #10) and FRcvdCR then begin
        { Ignore LF just after CR (CR/LF is normal end of line) }
        FRcvdCR := FALSE;
        Exit;
    end
    else if Ch = #13 then begin
        FRcvdCR := TRUE;
        CommandInterpreter;
        Exit;
    end
    else if Ch = #10 then begin
        CommandInterpreter;
        Exit;
    end;

    { Ordinary character, put in buffer in some place left }
{$IFNDEF WIN32}
    if Length(FCommand) = High(FCommand) then
        Ch := #7
    else
{$ENDIF}
        FCommand := FCommand + Ch;

    if (PortNum <> POP3_PORT) and (PortNum <> SMTP_PORT) then begin
        { Echo to client }
        Socket.Send(@Ch, 1);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{* Event handler for datavailable. Called each time some data is received  *}
procedure TClientForm.SocketDataAvailable(Sender: TObject; Error : word);
var
    Len    : Integer;
    Buffer : String[255];
    Socket : TWSocket;
    I      : Integer;
begin
    Socket := Sender as TWSocket;
    Len := Socket.Receive(@Buffer[1], High(Buffer));
    if Len = 0 then begin
        { Remote has closed }
        Display(#13 + #10 + '**** Remote has closed ****' + #13 + #10);
    end
    else if Len < 0 then begin
        { An error has occured }
        if Socket.LastError <> WSAEWOULDBLOCK then
            Display(#13 + #10 + '**** ERROR: ' + IntToStr(Socket.LastError) +
                    ' ****' + #13 + #10);
    end
    else begin
        Buffer[0] := chr(Len);
        Display(Buffer);
        for I := 1 to Len do
            ProcessChar(Buffer[I]);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{* Event handler called when the remote has closed the connection          *}
procedure TClientForm.SocketSessionClosed(Sender: TObject; Error : word);
begin
    Display(#13 + #10 + '**** Remote has closed ****' + #13 + #10);
    PostMessage(AcceptForm.Handle, WM_DISCONNECT,
                                   DISCONNECT_REMOTE,
                                   LongInt(Reference));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.FormDestroy(Sender: TObject);
begin
    Socket.Shutdown(2);
    Socket.Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.DisconnectButtonClick(Sender: TObject);
begin
    { Post a message to server form asking to disconnect the client }
    PostMessage(AcceptForm.Handle, WM_DISCONNECT,
                                   DISCONNECT_SELF,
                                   LongInt(Reference));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.FormShow(Sender: TObject);
var
    Buf : String;
begin
    DataMemo.Text := '';
    ActiveControl := DataMemo;

    if PortNum = POP3_PORT then
        Buf := '+OK POP3 server ready <[e-mail]>' + #13 + #10
    else if PortNum = SMTP_PORT then begin
        Buf := '220-SMTP Simulator ready' + #13 + #10;
        Socket.Send(@Buf[1], Length(Buf));
        Buf := '220 ESMTP spoken here' + #13 + #10;
    end
    else
        Buf := 'Hello from TnSrv !' + #13 + #10 + '--> ';

    Socket.Send(@Buf[1], Length(Buf));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.SendButtonClick(Sender: TObject);
var
    Buf : String;
begin
    Buf := DataMemo.Text + #13 + #10;
    Socket.Send(@Buf[1], Length(Buf));
    DataMemo.Text := '';
    ActiveControl := DataMemo;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Adjust the position for each control in the form as the user resize it   *}
procedure TClientForm.FormResize(Sender: TObject);
begin
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.Button1Click(Sender: TObject);
begin
    Socket.SendStr('Hello !');
end;


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

end.