Unit
 Telnet;

Interface

Uses
  kSockCli,
  kSockDef,
{$IFNDEF WIN32}
  Strings,
{$ELSE}
  SysUtils,
{$ENDIF}
  Parse,
  Log,
  tMisc,
  Resource,
  tGlob;

Procedure TelnetOpen (Hostname: String);
Procedure TelnetProcess;
Procedure TelnetSend (Ch: Char);
Procedure TelnetClose;
Function TelnetDataAvail: Boolean;

Const
  TelnFinish : Boolean = False;

Implementation

{$IFDEF WIN32}
Uses
  tor32u;
{$ENDIF}

Type
  TFlags = (Connected, TType, Binary, Echo);

Const
  CommandLen : Integer = 0;
  Term       : PChar = 'nvt';
  Yes        : PChar = '[yes]';
  Local      : Set Of TFlags = [Echo];
  Remote     : Set Of TFlags = [];

Var
  Command       : Array [1..64] Of Char;
  S             : LongInt;
  Sock          : TSockClient;
  St            : String;

Procedure SetOpt (Const Opt : TFlags);
Begin
  Case Command [2] Of
    #254 : Begin
             Local := Local - [opt];
             Command [2] := #252;
             Sock. fSocket. BlockWrite (Command, CommandLen);
           End;
    #253 : Begin
             Local := Local + [opt];
             Command [2] := #251;
             Sock. fSocket. BlockWrite (Command, CommandLen);
           End;
    #252 : Remote := Remote - [opt];
    #251 : Remote := Remote + [opt];
  End;
End;

Procedure UnknownOpt;
Begin
  Case Command [2] Of
    #254 : Begin
             Command [2] := #252;
             Sock. fSocket. BlockWrite (Command, CommandLen);
           End;
    #253 : Begin
             Command [2] := #251;
             Sock. fSocket. BlockWrite (Command, CommandLen);
           End;
  End;
End;

Procedure SetTermType;
Begin
  Case Command [4] Of
    #1 : Begin
           Command [4] := #0;
           Sock. fSocket. BlockWrite (Command, 4);
           Sock. fSocket. BlockWrite (Term^, StrLen (Term));
           Sock. fSocket. BlockWrite (Command [CommandLen+1], 2);
         End;
  End;
End;

Procedure UnknownType;
Begin
  Case Command [4] Of
    #1 : Begin
           Command [4] := #0;
           Sock. fSocket. BlockWrite (Command, CommandLen+2);
         End;
  End;
End;

Procedure Execute;
Var
  C : Integer;

Begin
  If CommandLen = 1 Then Exit;

  Case Command [2] Of
    #254,
    #253,
    #252,
    #251  : If CommandLen = 3 Then
            Begin
              Case Command [3] Of
                 #0 : SetOpt (Binary);
                 #1 : SetOpt (Echo);
                #24 : SetOpt (TType);
              Else
                UnknownOpt;
              End;
              CommandLen:=0;
            End;
    #248  : ComWrite (EmuClrEOL, 0);
    #247  : ComWrite (' '#8, 0);
    #246  : Sock. fSocket. BlockWrite (Yes^, StrLen (Yes));
    #255  : Begin
              ComWrite (#255, 0);
              CommandLen := 0;
            End;
    #250  : If CommandLen > 3 Then
            Begin
              For C := 2 To CommandLen Do
              Begin
                If (Command [C-1] = #255) And (Command [C] = #240) Then
                Begin
                  Dec (CommandLen, 2);
                  Case Command [3] Of
                    #24 : SetTermType;
                  Else
                    UnknownType;
                  End;
                  CommandLen := 0;
                  Break;
                End;
              End;
            End;
  Else
    If CommandLen = 2 Then CommandLen := 0;
  End;
End;

Procedure TelnetProcess;
Var
  Buf    : Array [1..512] Of Char;
  Len, C : LongInt;

Begin
  Len := 0;
  Sock. fSocket. BlockRead (Buf, SizeOf (Buf), Cardinal (Len));

  If Sock. fSocket. Error <> 0 Then
  Begin
    TelnFinish := True;
    Exit;
  End;

  TelnFinish := TelnFinish Or Not Sock. fSocket. isConnected;

  If (Len > 0) And (Len <= Sizeof (Buf)) And Not TelnFinish Then
  For C := 1 To Len Do
  Begin
    If CommandLen > 0 Then
    Begin
      Inc (CommandLen);
      Command [CommandLen] := Buf [C];
      Execute;
    End Else
    If Buf [C] = #255 Then
    Begin
      CommandLen := 1;
      Command [CommandLen] := Buf [C];
    End Else
      If Buf [C] <> #0 Then ComWrite (Buf [C], 0);
  End;
End;

Procedure TelnetSend (Ch: Char);
Var
  Buf : Array [0..1] Of Char;

Begin
  Buf [0] := Ch;

  Case Buf [0] Of
    #13 : Begin
            Buf [1] := #10;
            Sock. fSocket. BlockWrite (Buf, 2);
            If Echo in Local Then ComWriteLn ('', 0);
          End;
  Else
    Sock. fSocket. BlockWrite (Buf, 1);
    If Echo in Local Then ComWrite (Buf [0], 0);
  End;

  If Sock. fSocket. Error <> 0 Then TelnFinish := True;
End;

Procedure TelnetOpen (Hostname: String);
Begin
  S := 1;
  TelnFinish := False;
  Sock := tSockClient. Create;
  Sock. hostname := hostname;
  Sock. Service := 'telnet';
  ComWrite (lang (laTelnTrying) + hostname + ' ... ', eoCodes+eoMacro);

{$IFDEF WIN32}
  MainForm. Console1. Paint;
  MainForm. Console1. ShowCursor;
{$ENDIF}

  Sock. Open;

  If Sock. fSocket. Error <> 0 Then
  Begin
    If Sock. fSocket. Error = scResolveErr Then
    Begin
      LogWrite ('+', PlaceSubStr (sm (inetTelnetUnblResolve), '%1', Hostname));
      Message ('|' + lang (laUnableToResolve));
    End Else
    Begin
      LogWrite ('+', PlaceSubStr (sm (inetTelnetUnblConnect), '%1', Hostname));
      Message ('|' + lang (laCannotConnect));
    End;

    TelnFinish := True;
    Exit;
  End;

  ComWriteLn (lang (laTelnConnected) + Sock. fSocket.
  ConnectedToAddrStr, eoCodes+eoMacro);

  LogWrite ('+', PlaceSubStr (sm (inetTelnetConnected), '%1', Hostname + ' [' + Sock. fSocket. ConnectedToAddrStr) + ']');
End;

Procedure TelnetClose;
Begin
  LogWrite ('+', PlaceSubStr (sm (inetTelnetClosed), '%1',
  Sock. fSocket. ConnectedToAddrStr));

  Message ('|' + lang (laTelnConnection) +
    Sock. fSocket. ConnectedToAddrStr +
    lang (laTelnClosed));

  Sock. Close;
  Sock. Destroy;
End;

Function TelnetDataAvail: Boolean;
Begin
  TelnetDataAvail := Sock. fSocket. DataAvailable;
End;

End.