home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vptcp110.zip / TELNET.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-11  |  4.2 KB  |  201 lines
  1. program Telnet;
  2. uses Use32,Sockets,Crt,Strings;
  3.  
  4. {$PMTYPE VIO}
  5.  
  6. type
  7.   TFlags    =(Connected,TType,Binary,Echo);
  8. const
  9.   Term        :PChar    ='nvt';
  10.   Yes        :PChar    ='[yes]';
  11. var
  12.   Port        :UShort;
  13.   Sock        :TSocket;
  14.   Command    :Array[1..64] of Char;
  15.   CommandLen,s    :Integer;
  16.   Local,Remote    :set of TFlags;
  17.   Server    :TSockAddr_in;
  18.   st        :String;
  19.  
  20. procedure SetOpt(const opt:TFlags);inline;
  21. begin
  22.   case Command[2] of
  23.     #254   :begin
  24.       Local:=Local-[opt];
  25.       Command[2]:=#252;
  26.       Sock_Write(Sock,Command,CommandLen,s);
  27.     end;
  28.     #253   :begin
  29.       Local:=Local+[opt];
  30.       Command[2]:=#251;
  31.       Sock_Write(Sock,Command,CommandLen,s);
  32.     end;
  33.     #252   :Remote:=Remote-[opt];
  34.     #251   :Remote:=Remote+[opt];
  35.   end;
  36. end;
  37.  
  38. procedure UnknownOpt;inline;
  39. begin
  40.   case Command[2] of
  41.     #254  :begin
  42.       Command[2]:=#252;
  43.       Sock_Write(Sock,Command,CommandLen,s);
  44.     end;
  45.     #253  :begin
  46.       Command[2]:=#251;
  47.       Sock_Write(Sock,Command,CommandLen,s);
  48.     end;
  49.   end;
  50. end;
  51.  
  52. Procedure SetTermType;
  53. begin
  54.   Case Command[4] of
  55.     #1 :begin
  56.       Command[4]:=#0;
  57.       Sock_Write(Sock,Command,4,s);
  58.       Sock_Write(Sock,Term^,StrLen(Term),s);
  59.       Sock_Write(Sock,Command[CommandLen+1],2,s);
  60.     end;
  61.   end;
  62. end;
  63.  
  64. Procedure UnknownType;
  65. begin
  66.   Case Command[4] of
  67.     #1 :begin
  68.       Command[4]:=#0;
  69.       Sock_Write(Sock,Command,CommandLen+2,s);
  70.     end;
  71.   end;
  72. end;
  73.  
  74. Procedure Execute;
  75. var
  76.   c        :Integer;
  77. begin
  78.   if CommandLen=1 then exit;
  79.   case Command[2] of
  80.     #254,#253,#252,#251:if CommandLen=3 then begin
  81.       case Command[3] of
  82.     #0  :SetOpt(Binary);
  83.     #1  :SetOpt(Echo);
  84.     #24 :SetOpt(TType);
  85.     else UnknownOpt;
  86.       end;
  87.       CommandLen:=0;
  88.     end;
  89.     #248    :clreol;
  90.     #247    :write(' '#8);
  91.     #246    :Sock_Write(Sock,Yes^,StrLen(Yes),s);
  92.     #255    :begin
  93.       Write(#255);
  94.       CommandLen:=0;
  95.     end;
  96.     #250    :if CommandLen>3 then begin
  97.       for c:=2 to CommandLen do begin
  98.     if (Command[c-1]=#255)and(Command[c]=#240) then begin
  99.       dec(CommandLen,2);
  100.       case Command[3] of
  101.         #24 :SetTermType;
  102.         else UnknownType;
  103.       end;
  104.       CommandLen:=0;
  105.       break;
  106.     end;
  107.       end;
  108.     end;
  109.     else if CommandLen=2 then CommandLen:=0;
  110.   end;
  111. end;
  112.  
  113. procedure ReadData;
  114. var
  115.   buf        :Array[1..512] of Char;
  116.   Len,c     :Integer;
  117.   fd        :TFD_Set;
  118. begin
  119.   FD_Zero(fd);
  120.   FD_Set(Sock,fd);
  121.   Sock_Select(Sock+1,@fd,nil,nil,0);
  122. {  if Sock_Error then halt(1);}
  123.   if not FD_IsSet(Sock,fd) then exit;
  124.   Len:=0;
  125.   Sock_Read(Sock,buf,sizeof(Buf),Len);
  126.   if (SockError=0)and(Len>0)and(Len<=Sizeof(Buf)) then
  127.   for c:=1 to Len do begin
  128.     if CommandLen>0 then begin
  129.       inc(CommandLen);
  130.       Command[CommandLen]:=buf[c];
  131.       Execute;
  132.     end else
  133.     if buf[c]=#255 then begin
  134.       CommandLen:=1;
  135.       Command[CommandLen]:=buf[c];
  136.     end else
  137.     if buf[c]<>#0 then Write(buf[c]);
  138.   end;
  139. end;
  140.  
  141.  
  142. Procedure SendChar(ch:char);
  143. var
  144.   buf        :array[0..1] of char;
  145. begin
  146.   buf[0]:=ch;
  147.   case buf[0] of
  148.     #13   :begin
  149.       buf[1]:=#10;
  150.       Sock_Write(Sock,buf,2,s);
  151.       if Echo in Local then writeln;
  152.     end;
  153.     else begin
  154.       Sock_Write(Sock,buf,1,s);
  155.       if Echo in Local then Write(buf[0]);
  156.     end;
  157.   end;
  158. end;
  159.  
  160. Procedure Open;
  161. var
  162.   Service        :TServEnt;
  163.   Host            :THostEnt;
  164. begin
  165.   Sock_Init;
  166.   if Sock_Error then halt;
  167.  
  168.   Sock:=Sock_New(AF_INET,SOCK_STREAM,0);
  169.   if Sock_Error then halt(1);
  170.  
  171.   {if soSetSockOpt(Sock,SOL_SOCKET,SO_RCVTIMEO,s,SizeOf(s))<0 then begin
  172.     halt(1);
  173.   end;}
  174.   if not GetServiceByName(Service,'telnet','tcp') then halt(2);
  175.  
  176.   if not GetHostByName(Host,'suma3.rdg.ac.uk') then halt(3);
  177.  
  178.   Server.sin_family     := AF_INET;
  179.   Server.sin_port     := Service.s_port;
  180.   Server.sin_addr     := Host.h_addr_list[0];
  181.  
  182.   Writeln('Connecting to ',Host.h_name,' (',inet_ntoa(Host.h_addr_list[0]),')');
  183.   Writeln('Using service ',Service.s_name,', protocol ',Service.s_proto);
  184.  
  185.   Sock_Connect(Sock,TSockAddr(Server));         (* Bind the socket to the port *)
  186.   if Sock_Error then halt(4);
  187.   Writeln('Connection established.');
  188.   s:=1;
  189. end;
  190.  
  191. begin
  192.   TextMode(co80);
  193.   CommandLen:=0;Local:=[Echo];Remote:=[];
  194.   Open;
  195.   repeat
  196.     ReadData;
  197.     if Keypressed then SendChar(readkey);
  198.   until SockError<>0;
  199.   Sock_Close(Sock);
  200. end.
  201.