Visual Basic 5 Developer's Kit/vb5 dev kit.iso/dev/tcp4w20/samples/pascal/pwtn.pas

Pascal/Delphi Source File | 1996-06-10 | 5.1 KB | 196 lines

Program PWTN;
{$A+,B-,D+,F-,G+,I-,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
{$M 8192,8192}
{Simple Telnet Client for TCP4W}

Uses WinTypes, WinProcs, WinCrt, Strings, UseTcp4w;

Const LTIL = $7000;

Type PLongTextItem = ^TLongTextItem;
     TLongTextItem = Array [0..LTIL] Of Char;

Var Status: Integer;
    LineMode: Boolean;
    S: TSocket;
    Port: Integer;
    T, U: PLongTextItem;
    Ch: Char;
    SaveExitProc : Pointer;
    IP: TIP;

Procedure WriteWinsockVerInfo;
  Const WSADESCRIPTION_LEN = 256;
        WSASYS_STATUS_LEN = 128;
  Type TWSAData = Record
           wVersion: Word;
           wHighVersion: Word;
           szDescription: Array [0..WSADESCRIPTION_LEN] Of Char;
           szSystemStatus: Array [0..WSASYS_STATUS_LEN] Of Char;
           iMaxSockets: Byte;
           iMaxUdpDg: Byte;
           lpVendorInfo: Pointer;
         End;
       TWSAStartUp = Function (wVersionRequested: Word; WSAData: TWSAData): Integer;
       TWSACleanup = Function: Integer;
  Var WSAData: TWSAData;
      hWinsock: THandle;
      FP : TFarProc;
  Begin
    hWinsock := LoadLibrary ('WINSOCK');
    If hWinsock >= 32 Then
      Begin
        FP := GetProcAddress (hWinsock, 'WSAStartup');
        If FP <> NIL Then
          If TWSAStartUp (FP) (257, WSAData) = 0 Then
            WriteLn (WSAData.szDescription);
        FP := GetProcAddress (hWinsock, 'WSACleanup');
        If FP <> NIL Then TWSACleanUp (FP);
        FreeLibrary (hWinsock)
      End
  End;

Procedure CheckStatus;
  Begin
    If Status > 0 Then Exit;
    WriteLn;
    WriteLn ('?', Tcp4W_Error (Status));
    Halt
  End;

Procedure MyExitProc; Far;
  Begin
    ExitProc := SaveExitProc;
    If S <> 0 Then TcpClose (S);
    Tcp4WCleanup;
  End;

Procedure CharModeLoop;
  Begin
    Repeat
      If KeyPressed Then
        Begin
          Ch := ReadKey;
          Status := TcpSend (S, @Ch, 1, False, -1);
          CheckStatus;
        End;
      If TcpIsDataAvail (S) <> 0 Then
        Begin
          Status := TcpRecv (S, T^, LTIL, 1, -1);
          CheckStatus;
          T^[Status] := #0;
          If T^[0] = #255 Then
            Begin
              If T^[1] = #253 Then
                Begin
                  StrCopy (T^, #255#252#24);
                  Status := TcpSend (S, T^, 3, False, -1);
                  CheckStatus;
                End
                Else If StrScan (T^, #13) <> NIL Then
                       Write (StrScan (T^, #13))
            End
            Else Write (T^);
        End;
    Until Ch = #3;
  End;

Procedure LineModeLoop;
  Begin
    CheckBreak := True;
    WriteLn ('Perhaps you must press enter now');
    Status := TcpRecv (S, T^, LTIL, 10, -1);
    CheckStatus;
    T^[Status] := #0;
    If T^[0] = #255 Then
      Begin
        StrCopy (T^, #255#252#24);
        Status := TcpSend (S, T^, 3, False, -1);
        CheckStatus;
        Status := TCPRecv (S, T^, LTIL, 10, -1);
      End
      Else Write (T^);
    Repeat
      While (TcpIsDataAvail (S) <> 0 ) Do
        Begin
          Status := TcpRecv (S, T^, LTIL, 1, -1);
          CheckStatus;
          T^[Status] := #0;
          Write (T^)
        End;
     ReadLn (U^);
     StrCat (U^, #13#10);
      While (TcpIsDataAvail (S) <> 0 ) Do
        Begin
          Status := TcpRecv (S, T^, LTIL, 1, -1);
          CheckStatus;
          T^[Status] := #0;
          Write (T^)
        End;
      Status := TcpSend (S, U^, StrLen (U^) , False, -1);
      CheckStatus;
      Repeat Until (TcpIsDataAvail (S) <> 0);
      Status := TcpRecv (S, T^, LTIL, 10, -1);
      CheckStatus;
      T^[Status] := #0;
      Write (T^);
    Until False;
  End;

Begin
  CheckBreak := False;
  CmdShow := sw_ShowMaximized;
  AutoTracking := False;
  New (T);
  New (U);
  WriteLn ('Simple Telnet Client by AStA ([e-mail]) <Polarwolf>');
  Tcp4wVer (T^, 0);
  WriteLn (T^);
  WriteWinsockVerInfo;
  WriteLn;
  S := 0;
  Port := 23;
  SaveExitProc := ExitProc;
  ExitProc := @MyExitProc;
  Status := Tcp4wInit;
  CheckStatus;

  Write ('Host (Default:polydos.uni-konstanz.de):');
  ReadLn (T^);
  If StrLen (T^) = 0 Then
    Begin
      StrCopy (T^,'polydos.uni-konstanz.de');
      Port := 775;
      LineMode := True;
    End
    Else Begin
      Write ('Enter "c" for Char-Mode, "l" for Line-Mode:');
      Repeat
        Ch := ReadKey;
      Until Ch In ['c', 'C', 'l', 'L'];
      If LineMode Then WriteLn ('Line-Mode') Else Write ('CharMode');
      LineMode := Ch In ['l', 'L'];
    End;
  Status := TcpConnect (S, T^, '', Port);
  CheckStatus;
  WriteLn ('Socket: ', S, '  Port: ', Port);
  Status := TcpGetLocalID (T^, LTIL, IP);
  CheckStatus;
  WriteLn ('Local  Host: ', T^, ' (', IP.B1, '.', IP.B2, '.',
    IP.B3, '.', IP.B4, ')');
  Status := TcpGetRemoteID (S, T^, LTIL, IP);
  CheckStatus;
  WriteLn ('Remote Host: ', T^, ' (', IP.B1, '.', IP.B2, '.',
    IP.B3, '.', IP.B4, ')');
  WriteLn;

  Ch := #0;
  If LineMode Then LineModeLoop Else CharModeLoop;
  TcpClose (S);
  S := 0;
  CheckStatus;
  Tcp4WCleanUp;
  ExitProc := SaveExitProc;
  DoneWinCrt;
End.