idmappedporttcp.pas

Indy控件的使用源代码

    end;//if
  end;//tryf
End;//TIdMappedPortTCP.DoExecute

function TIdMappedPortTCP.GetOnConnect: TIdMappedPortThreadEvent;
Begin
  Result:=TIdMappedPortThreadEvent(FOnConnect);
End;//
function TIdMappedPortTCP.GetOnExecute: TIdMappedPortThreadEvent;
Begin
  Result:=TIdMappedPortThreadEvent(FOnExecute);
End;//
function TIdMappedPortTCP.GetOnDisconnect: TIdMappedPortThreadEvent;
Begin
  Result:=TIdMappedPortThreadEvent(FOnDisconnect);
End;//OnDisconnect

procedure TIdMappedPortTCP.SetOnConnect(const Value: TIdMappedPortThreadEvent);
Begin
  TIdMappedPortThreadEvent(FOnConnect):=Value;
End;//
procedure TIdMappedPortTCP.SetOnExecute(const Value: TIdMappedPortThreadEvent);
Begin
  TIdMappedPortThreadEvent(FOnExecute):=Value;
End;//
procedure TIdMappedPortTCP.SetOnDisconnect(const Value: TIdMappedPortThreadEvent);
Begin
  TIdMappedPortThreadEvent(FOnDisconnect):=Value;
End;//OnDisconnect


{ TIdMappedPortThread }

constructor TIdMappedPortThread.Create;
Begin
  inherited Create(ACreateSuspended);
  FReadList:= TList.Create;
  FConnectTimeOut := IdTimeoutDefault;
End;

procedure TIdMappedPortThread.Cleanup;
Begin
  FreeAndNil(FOutboundClient);
  inherited Cleanup;
End;

destructor TIdMappedPortThread.Destroy;
begin
  //^FreeAndNil(FOutboundClient);
  FreeAndNil(FReadList);
  inherited Destroy;
End;

procedure TIdMappedPortThread.OutboundConnect;
Begin
  FOutboundClient := TIdTCPClient.Create(NIL);
  with TIdMappedPortTCP(Connection.Server) do begin
    try
      with TIdTcpClient(FOutboundClient) do begin
        Port := MappedPort;
        Host := MappedHost;
      end;//with
      DoLocalClientConnect(SELF);

      TIdTcpClient(FOutboundClient).Connect(FConnectTimeOut);
      DoOutboundClientConnect(SELF);
    except
      on E: Exception do begin
        DoOutboundClientConnect(SELF,E); // DONE: Handle connect failures
        Connection.Disconnect; //req IdTcpServer with "Stop this thread if we were disconnected"
      end;
    end;//trye
  end;//with
End;//for easy inheritance

//=============================================================================

{ TIdCustomMappedTelnet }

constructor TIdCustomMappedTelnet.Create(AOwner: TComponent);
Begin
  inherited Create(AOwner);
  FAllowedConnectAttempts := -1;
  ThreadClass := TIdMappedTelnetThread;
  DefaultPort := IdPORT_TELNET;
  MappedPort := IdPORT_TELNET;
End;//TIdMappedTelnet.Create

procedure TIdCustomMappedTelnet.DoCheckHostPort(AThread: TIdMappedPortThread; const AHostPort: String; var VHost,VPort: String);
Begin
  if Assigned(FOnCheckHostPort) then FOnCheckHostPort(AThread,AHostPort,VHost,VPort);
End;//

procedure TIdCustomMappedTelnet.ExtractHostAndPortFromLine(AThread: TIdMappedPortThread; const AHostPort: String);
var
  LHost,LPort: String;
  P,L: PChar;
Begin
  if Length(AHostPort)>0 then begin
    P := Pointer(AHostPort);
    L := P + Length(AHostPort);
    while (P<L) and NOT(P^ in [#0,#9,' ',':']) do begin {Do not Localize}
      inc(P);
    end;
    SetString(LHost, PChar(Pointer(AHostPort)), P-Pointer(AHostPort));
    while (P<L) and (P^ in [#9,' ',':']) do begin {Do not Localize}
      inc(P);
    end;
    SetString(LPort, P, L-P);
    LHost := TrimRight(LHost);
    LPort := TrimLeft(LPort);
  end
  else begin
    LHost := '';    {Do not Localize}
    LPort := '';    {Do not Localize}
  end;//if
  DoCheckHostPort(AThread, AHostPort,LHost,LPort);

  TIdTcpClient(AThread.OutboundClient).Host := LHost;
  TIdTcpClient(AThread.OutboundClient).Port := StrToIntDef(LPort,TIdTcpClient(AThread.OutboundClient).Port);
End;//ExtractHostAndPortFromLine

procedure TIdMappedTelnetThread.OutboundConnect;
var
  LHostPort: String;
Begin
  //don`t call inherited, NEW behavior
  FOutboundClient := TIdTCPClient.Create(NIL);
  with TIdCustomMappedTelnet(Connection.Server) do begin
    with TIdTcpClient(FOutboundClient) do begin
      Port := MappedPort;
      Host := MappedHost;
    end;//with
    FAllowedConnectAttempts := TIdCustomMappedTelnet(Connection.Server).AllowedConnectAttempts;
    DoLocalClientConnect(SELF);

    repeat
      if FAllowedConnectAttempts>0 then begin
        dec(FAllowedConnectAttempts);
      end;
      try
        LHostPort := Trim(Connection.InputLn); //~telnet input
        ExtractHostAndPortFromLine(SELF,LHostPort);

        if Length(TIdTcpClient(FOutboundClient).Host)<1 then begin
          raise EIdException.Create(RSEmptyHost);
        end;
        TIdTcpClient(FOutboundClient).Connect(FConnectTimeOut);
      except
        on E: Exception do begin // DONE: Handle connect failures
          FNetData := 'ERROR: ['+E.ClassName+'] ' + E.Message;    {Do not Localize}
          DoOutboundClientConnect(SELF,E);//?DoException(AThread,E);
          Connection.WriteLn(FNetData);
        end;
      end;//trye
    until FOutboundClient.Connected or (FAllowedConnectAttempts=0);

    if FOutboundClient.Connected then begin
      DoOutboundClientConnect(SELF)
    end
    else begin
      Connection.Disconnect; //prevent all next work
    end;
  end;//with
End;//TIdMappedTelnet.OutboundConnect

procedure TIdCustomMappedTelnet.SetAllowedConnectAttempts(const Value: Integer);
Begin
  if Value >= 0 then begin
    FAllowedConnectAttempts:= Value
  end else begin
    FAllowedConnectAttempts:=-1; //unlimited
  end;
End;//


{ TIdMappedPop3 }

constructor TIdMappedPop3.Create(AOwner: TComponent);
Begin
  inherited Create(AOwner);
  FUserHostDelimiter := '#';//standard    {Do not Localize}
  Greeting.NumericCode := 0;//same as POP3
  Greeting.Text.Text := '+OK '+RSPop3ProxyGreeting;    {Do not Localize}
  ReplyUnknownCommand.NumericCode := 0;
  ReplyUnknownCommand.Text.Text := '-ERR '+RSPop3UnknownCommand;    {Do not Localize}
  DefaultPort := IdPORT_POP3;
  MappedPort := IdPORT_POP3;
  ThreadClass := TIdMappedPop3Thread;
End;//TIdMappedPop3.Create

{ TIdMappedPop3Thread }

procedure TIdMappedPop3Thread.OutboundConnect;
var
  LHostPort,LUserName,LPop3Cmd: String;
Begin
  //don`t call inherited, NEW behavior
  with TIdMappedPop3(Connection.Server) do begin
    FOutboundClient := TIdTCPClient.Create(NIL);
    with TIdTcpClient(FOutboundClient) do begin
      Port := MappedPort;
      Host := MappedHost;
    end;//with
    FAllowedConnectAttempts := TIdMappedPop3(Connection.Server).AllowedConnectAttempts;
    DoLocalClientConnect(SELF);

    repeat
      if FAllowedConnectAttempts>0 then begin
        dec(FAllowedConnectAttempts);
      end;
      try
        // Greeting
        LHostPort := Trim(Connection.ReadLn);//USER username#host OR QUIT
        LPop3Cmd := UpperCase(Fetch(LHostPort,' ',TRUE));    {Do not Localize}
        if LPop3Cmd = 'QUIT' then begin    {Do not Localize}
          Connection.WriteLn('+OK '+RSPop3QuitMsg);    {Do not Localize}
          Connection.Disconnect;
          BREAK;
        end
        else if LPop3Cmd = 'USER' then begin    {Do not Localize}
          LUserName := Fetch(LHostPort,FUserHostDelimiter,TRUE,FALSE);//?:CaseSensetive
          FNetData := LUserName; //save for OnCheckHostPort
          LHostPort := TrimLeft(LHostPort); //trimRight above
          ExtractHostAndPortFromLine(SELF,LHostPort);
          LUserName := FNetData; //allow username substitution
        end
        else begin
          Connection.WriteRFCReply(ReplyUnknownCommand);
          Continue;
        end;//if

        if Length(TIdTcpClient(FOutboundClient).Host)<1 then begin
          raise EIdException.Create(RSEmptyHost);
        end;
        TIdTcpClient(FOutboundClient).Connect(FConnectTimeOut);
        FNetData := FOutboundClient.ReadLn;//Read Pop3 Banner for OnOutboundClientConnect

        FOutboundClient.WriteLn('USER '+LUserName);    {Do not Localize}
      except
        on E: Exception do begin // DONE: Handle connect failures
          FNetData :='-ERR ['+E.ClassName+'] '+E.Message;    {Do not Localize}
          DoOutboundClientConnect(SELF,E);//?DoException(AThread,E);
          Connection.WriteLn(FNetData);
        end;
      end;//trye
    until FOutboundClient.Connected or (FAllowedConnectAttempts=0);

    if FOutboundClient.Connected then begin
      DoOutboundClientConnect(SELF)
    end
    else begin
      Connection.Disconnect; //prevent all next work
    end;
  end;//with
End;//TIdMappedPop3.OutboundConnect

END.