home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / PCL4P51.ZIP / LOGIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-05  |  6.6 KB  |  217 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*          LOGIN.PAS      April 96          *)
  4. (*                                           *)
  5. (*  This program is donated to the Public    *)
  6. (*  Domain by MarshallSoft Computing, Inc.   *)
  7. (*  It is provided as an example of the use  *)
  8. (*  of the Personal Communications Library.  *)
  9. (*                                           *)
  10. (*********************************************)
  11.  
  12.  
  13. program login;
  14. uses crt, modem_io, PCL4P;
  15.  
  16. const
  17.    ONE_SEC = 18;
  18. const
  19.    BaudRateArray : array[1..10] of LongInt =
  20.        (300,600,1200,2400,4800,9600,19200,38400,57600,115200);
  21. var
  22.    BaudCode : Integer;
  23.    Code     : Integer;
  24.    Byte     : Char;
  25.    i        : Integer;
  26.    Port     : Integer;
  27.    ResetFlag: Boolean;
  28.    CharPace : Integer;
  29.    BufPtr   : Pointer;
  30.    BufSeg   : Integer;
  31.  
  32. procedure SayError( Code : Integer );
  33. begin
  34.    if Code < 0 then Code := SioError( Code )
  35.    else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
  36.       begin (* Port Error *)
  37.          if (Code and FramingError) <> 0 then writeln('Framing Error');
  38.          if (Code and ParityError)  <> 0 then writeln('Parity Error');
  39.          if (Code and OverrunError) <> 0 then writeln('Overrun Error')
  40.       end
  41. end;
  42.  
  43. (*** send string & expect reply ***)
  44.  
  45. function PutGet(Send:String; Expect:String; Tics:Integer) : Char;
  46. var
  47.   Code : Integer;
  48.   Flag : Boolean;
  49.   Byte : Char;
  50. begin
  51.   Byte := chr(0);
  52.   WriteLn;
  53.   Write('*** Sending "',Send,'"');
  54.   if Length(Expect) > 0 then Write(' & awaiting "',Expect,'"');
  55.   WriteLn;
  56.  
  57. (*function  ModemSendTo(Port:Integer;Pace:Integer;TheString:String):Boolean;*)
  58. (*function  ModemWaitFor(Port:Integer;WaitTics:Integer;CaseFlag:Boolean;TheString:String):Char;*)
  59.  
  60.   Flag := ModemSendTo(Port, CharPace, Send);
  61.   if Flag and (Length(Expect) > 0) then
  62.     begin
  63.       Byte := ModemWaitFor(Port,Tics,FALSE,Expect);
  64.       if Byte = chr(0) then WriteLn('ERROR: "',Send,'" sent but "',Expect,'" not received');
  65.     end;
  66.   PutGet := Byte;
  67.  end;
  68.  
  69. procedure MyHalt( ExitCode : Integer );
  70. begin
  71.    if ExitCode < 0 then SayError( ExitCode );
  72.    if ResetFlag then Code := SioDone(Port);
  73.    writeln('*** HALTING ***');
  74.    Halt;
  75. end;
  76.  
  77. function MatchBaud(BaudString : String) : Integer;
  78. var
  79.    i : Integer;
  80.    BaudRate: LongInt;
  81.    Code : Integer;
  82. begin
  83.   Val(BaudString,BaudRate,Code);
  84.   if Code <> 0 then
  85.   begin
  86.     MatchBaud := -1;
  87.     exit;
  88.   end;
  89.   for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
  90.   begin
  91.     MatchBaud := i - 1;
  92.     exit;
  93.   end;
  94.   (* no match *)
  95.   MatchBaud := -1;
  96. end;
  97.  
  98. begin   (* main program *)
  99.    ResetFlag := FALSE;
  100.    CharPace := 3;
  101.    (* fetch PORT # from command line *)
  102.    if ParamCount <> 2 then
  103.       begin
  104.          writeln('USAGE: "LOGIN <port> <baud rate>" where port = 1 to 20');
  105.          halt;
  106.       end;
  107.    Val( ParamStr(1),Port, Code );
  108.    if Code <> 0 then
  109.       begin
  110.          writeln('Port must be 1 to 16');
  111.          Halt;
  112.       end;
  113.    (* COM1 = 0, COM2 = 1, etc. *)
  114.    Port := Port - 1;
  115.    if (Port<COM1) or (Port>COM16) then
  116.       begin
  117.          writeln('Port must be 1 to 16');
  118.          Halt
  119.       end;
  120.    (* get baud rate *)
  121.    BaudCode := MatchBaud(ParamStr(2));
  122.    (* setup 1K receive buffer *)
  123.    GetMem(BufPtr,1024+16);
  124.    BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  125.    Code := SioRxBuf(Port, BufSeg, Size1024);
  126.    if Code < 0 then MyHalt( Code );
  127.    if SioInfo('I') > 0 then
  128.      begin
  129.        (* setup 128 transmit buffer *)
  130.        GetMem(BufPtr,128+16);
  131.        BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  132.        Code := SioTxBuf(Port, BufSeg, Size128);
  133.        if Code < 0 then MyHalt( Code );
  134.      end;
  135.    (* reset port *)
  136.    Code := SioReset(Port,BaudCode);
  137.    (* if error then try one more time *)
  138.    if Code <> 0 then Code := SioReset(Port,BaudCode);
  139.    (* Was port reset ? *)
  140.    if Code <> 0 then
  141.      begin
  142.         writeln('Cannot reset COM',Port+1);
  143.         MyHalt( Code );
  144.      end;
  145.    (* Port successfully reset *)
  146.    writeln;
  147.    writeln('COM',1+Port,' @ ',BaudRateArray[BaudCode+1],' Baud');
  148.    ResetFlag := TRUE;
  149.    (* specify parity, # stop bits, and word length for port *)
  150.    Code := SioParms(Port, NoParity, OneStopBit, WordLength8);
  151.    if Code < 0 then MyHalt( Code );
  152.  
  153.    (* set FIFO level if have INS16550 *)
  154.    Code := SioFIFO(Port, LEVEL_8);
  155.    if Code < 0 then MyHalt( Code );
  156.  
  157.    Code := SioRxClear(Port);
  158.    if Code < 0 then MyHalt( Code );
  159.  
  160.    (* set DTR & RTS *)
  161.    Code := SioDTR(Port,SetPort);
  162.    Code := SioRTS(Port,SetPort);
  163.  
  164.    (* initialize (Hayes compatible) modem *)
  165.    Byte := PutGet('!AT!','OK',ONE_SEC);
  166.    if Byte <> chr(0) then Byte := PutGet('AT E1 S7=60 S11=60 V1 X1 Q0!','OK',5*ONE_SEC);
  167.    if Byte <> chr(0) then
  168.       begin
  169.         WriteLn('  <<Modem ready. Logging on...>>');
  170.         (* dial number & wait for CONNECT *)
  171.         Byte := PutGet('!ATDT1,205,880,9748!','CONNECT',60*ONE_SEC);
  172.         if Byte = chr(0) then MyHalt(0);
  173.         Byte := PutGet('!','graphics (y/N)?|LAST name:',45*ONE_SEC);
  174.         if Byte = chr(0) then MyHalt(0);
  175.         (* '0' means 1st arg matched, '1' means second arg matched *)
  176.         if Byte = '0' then Byte := PutGet('!','LAST Name:',10*ONE_SEC);
  177.         Byte := PutGet('GUEST GUEST!','password:',10*ONE_SEC);
  178.         if Byte = chr(0) then MyHalt(0);
  179.         Byte := PutGet('GUEST!','',10*ONE_SEC);
  180.       end
  181.    else WriteLn('  <<WARNING: Expected OK not received>>');
  182.  
  183.    (* begin terminal loop *)
  184.    writeln('Enter terminal loop ( Type ^Z to exit )');
  185.    while TRUE do
  186.       begin
  187.          (* did user press Ctrl-BREAK ? *)
  188.          if SioBrkKey then
  189.             begin
  190.                writeln('User typed Ctl-BREAK');
  191.                Code := SioDone(Port);
  192.                Halt;
  193.             end;
  194.          (* anything incoming over serial port ? *)
  195.          Code := SioGetc(Port,0);
  196.          if Code < -1 then MyHalt( Code );
  197.          if Code > -1 then Write( chr(Code) );
  198.          (* has user pressed keyboard ? *)
  199.          if KeyPressed then
  200.             begin
  201.                (* read keyboard *)
  202.                Byte := ReadKey;
  203.                (* quit if user types ^Z *)
  204.                if Byte = chr($1a) then
  205.                   begin
  206.                      writeln('User typed ^Z');
  207.                      Code := SioDone(Port);
  208.                      Halt;
  209.                   end;
  210.                (* send out over serial line *)
  211.                Code := SioPutc(Port, Byte );
  212.                if Code < 0 then MyHalt( Code );
  213.             end
  214.       end
  215. end.
  216.  
  217.