home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3pkt.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  25KB  |  541 lines
  1. Unit Packets ;
  2. (* ------------------------------------------------------------------ *)
  3. (* Packets - Packet procedures  and ReadChar procedures               *)
  4. (* ------------------------------------------------------------------ *)
  5. Interface
  6.   Uses
  7.      Dos,Crt,        (* Standard Turbo Pascal Unit *)
  8.      sysfunc,        (* System functions used by Kermit *)
  9.      KGlobals,       (* Kermit Globals - Execution Control Flags *)
  10.      ModemPro ;      (* Modem procedures *)
  11.   CONST
  12.      MaxPacketSize = 4096 ;
  13.   TYPE
  14.     STATETYPE = (S,SF,SD,SZ,SB,C,A,R,RF,RD) ;
  15.     ABORTTYPE = (NOSOH,BADSF,NOT_S,NOT_SFBZ,NOT_DZ);
  16.     BREAKTYPE = (NOBREAK,BX,BZ,BC,BE);
  17.     PACKET = PACKED ARRAY[1..MaxPacketsize] OF BYTE ;
  18.   VAR
  19.     STATE          : STATETYPE ;
  20.     ABORT          : ABORTTYPE ;
  21.     BREAKSTATE     : BREAKTYPE ;
  22.     RetryCount     : Integer ;
  23.  
  24.     (* Packet variables *)                           (* format   *)
  25.     (* Receive       Send     *)                     (* SOH      *)
  26.        InCount,      OutCount      : BYTE ;          (* COUNT    *)
  27.        INSEQ,        OUTSEQ        : BYTE ;          (* SEQNUM   *)
  28.        INPACKETTYPE, OUTPACKETTYPE : BYTE ;          (* TYPE     *)
  29.               LENX1,                                   (* extend lenght1 *)
  30.               LENX2,                                   (* extend Length2 *)
  31.               HCHECK               : BYTE ;            (* checksum *)
  32.        RecvData,     SendData      : PACKET ;        (* DATA...  *)
  33.        CHECKSUM                    : INTEGER ;       (* CHECKSUM *)
  34.        CRC                         : INTEGER ;       (* CRC      *)
  35.  
  36.        InDataCount,  OutDataCount  : Integer ;       (* dataCOUNT *)
  37.  
  38.  (* Initialization packet parameters *)
  39.     StartChar,sMAXL : byte ;
  40.     rPacketSize,sPacketSize : integer  ;
  41.     rTimeout,rNumPad,rPadChar,rEolChar,rCntrlQuote,
  42.     sTimeout,sNumPad,sPadChar,sEolChar,sCntrlQuote,
  43.     Bit8Quote,Checktype,RepChar,
  44.     rCapas,sCapas,Windo,Maxlx1,Maxlx2  : Byte ;
  45.  
  46.  (* Functions and Procedures *)
  47.     Function ReadChar(var char : byte): boolean;
  48.     Function ReadMChar(var char : byte): boolean;
  49.     PROCEDURE SENDPACKET ;
  50.     FUNCTION  RECVPACKET : BOOLEAN ;
  51.     PROCEDURE RESENDIT ( RETRIES : INTEGER ) ;
  52.     PROCEDURE SendPacketType  (PacketType : char);
  53.     PROCEDURE PutInitPacket  ;
  54.     PROCEDURE GetInitPacket ;
  55.  
  56. Implementation
  57. (* ------------------------------------------------------------------ *)
  58. (* ReadChar - Read a character from the modem.                        *)
  59. (*           Waits for a character to appear on the modem.            *)
  60. (*           It returns TRUE when the character is received and       *)
  61. (*           the value of the char is return in the parameter.        *)
  62. (*           It returns FALSE if the keyboard char is detected before *)
  63. (*           a character is received or it times out.                 *)
  64. (*   Side Effects : if the keys ^Z ^X ^C or ^E are pressed then       *)
  65. (*           BREAKSTATE is set to BZ, BX, BC, or BE respectively.     *)
  66. (*   Note : The ticker value may need to change if code is added to   *)
  67. (*           to this procedure or RecvChar or KeyChar. It is also     *)
  68. (*           machine dependent.                                       *)
  69. (* ------------------------------------------------------------------ *)
  70.     Function ReadChar(var char : byte): boolean;
  71.     var waiting : boolean ;
  72.         dummy : byte ;
  73.         hh,mm,ss,ms,seconds : word ;
  74.         Timer : integer ;
  75.     Begin (* Read Char *)
  76.     waiting := true ;
  77.     timer := 0 ;
  78.     While waiting Do
  79.          Begin (* Wait for a Character *)
  80.          If RecvChar(char) then
  81.               Begin (* got char *)
  82.               ReadChar := true ;
  83.               waiting := false ;
  84.               End  (* got char *)
  85.                            else
  86.               If KeyChar(char,dummy) then
  87.                    Begin (* key char *)
  88.                    ReadChar := false ;
  89.                    waiting := false ;
  90.                    if char = $03 then BREAKSTATE := BC ;
  91.                    if char = $05 then BREAKSTATE := BE ;
  92.                    if char = $18 then BREAKSTATE := BX ;
  93.                    if char = $1A then BREAKSTATE := BZ ;
  94.                    End   (* key char *)
  95.                                     else
  96.                    Begin (* Check for timeout *)
  97.                    GetTime(hh,mm,ss,ms);
  98.                    if timer = 0 then
  99.                       begin seconds := ss ; timer := 1 ; end
  100.                                 else
  101.                       if ss <> seconds then
  102.                          begin timer := timer + 1 ; seconds := ss ; end ;
  103.                    if Timer > rTimeOut then
  104.                         Begin Waiting := false; ReadChar := False; End;
  105.                   End;   (* Check for timeout *)
  106.         End ; (* Wait for a Character *)
  107.     End; (* Read Char *)
  108.  
  109. (* ------------------------------------------------------------------ *)
  110. (* ReadMChar - Read a character from the modem.                       *)
  111. (*           Waits for a character to appear on the modem.            *)
  112. (*           It returns TRUE when the character is received and       *)
  113. (*           the value of the char is return in the parameter.        *)
  114. (*           It returns FALSE if the it times out.                    *)
  115. (*   Note : This is simular to ReadChar except it does not check the  *)
  116. (*          key board and the time out value is smaller.              *)
  117. (*                                                                    *)
  118. (* ------------------------------------------------------------------ *)
  119.     Function ReadMChar(var char : byte): boolean;
  120.     var waiting : boolean ;
  121.         dummy : byte ;
  122.         hh,mm,ss,ms,seconds : word ;
  123.         Timer : integer ;
  124.     Begin (* Read MChar *)
  125.     waiting := true ;
  126.     timer := 0 ;
  127.     While waiting Do
  128.          Begin (* Wait for a Character *)
  129.          If RecvChar(char) then
  130.               Begin (* got char *)
  131.               ReadMChar := true ;
  132.               waiting := false ;
  133.               End  (* got char *)
  134.                            else
  135.               Begin (* Check for timeout *)
  136.               GetTime(hh,mm,ss,ms);
  137.               if timer = 0 then
  138.                    begin seconds := ss; timer := 1 ; end
  139.                            else
  140.                    if seconds <> ss then
  141.                         begin seconds := ss ; timer := timer + 1 ; end ;
  142.               if Timer > 5 then
  143.                    Begin Waiting := false; ReadMChar := False; End;
  144.               End;   (* Check for timeout *)
  145.          End ; (* Wait for a Character *)
  146.     End; (* Read MChar *)
  147.  
  148. (* ----------------------------------------------------------------- *)
  149. (* CRCheck - Procedure - generates a CCITT CRC using the polynominal *)
  150. (*                       X^16 + X^12 + X^5 + 1                       *)
  151. (* Side Effects : Updates the global variable CRC which should be    *)
  152. (*                initialized to 0. It is call only once for each    *)
  153. (*                byte to be checked and all 8 bits are included.    *)
  154. (*                No terminating calls are necessary.                *)
  155. (* ----------------------------------------------------------------- *)
  156. Procedure CRCheck ( Abyte : byte ) ;
  157. Var    j,temp : integer ;
  158.     Begin (* CRCheck *)
  159.     For j := 0 to 7 do
  160.          Begin (* check all 8 bits *)
  161.          temp := CRC xor Abyte ;
  162.          CRC := CRC shr 1 ;             (* shift right *)
  163.          If Odd(temp) then CRC := CRC xor $8408 ;
  164.          abyte := abyte shr 1 ;
  165.          End ; (* check all 8 bits *)
  166.     End ; (* CRCheck *)
  167.  
  168. (* ===============================================================  *)
  169. (* SENDPACKET -This procedure sends the SendData packet .           *)
  170. (*          1. The COUNT sent includes SEQ,PACKETTYPE,and CHECKSUM  *)
  171. (*             i.e. it is 3 larger than the OutCount or             *)
  172. (*               if CheckType = 2 or 3 then COUNT is 4 or 5 larger. *)
  173. (*          2. The COUNT and SEQ and CHECKSUM values are offset by  *)
  174. (*             32 decimal (20hex) to make it a printable ASCII char.*)
  175. (*          3. The CHECKSUM are calculated on the ASCII value of    *)
  176. (*             the printable characters.                            *)
  177. (*                                                                  *)
  178. (* Assumptions:                                                     *)
  179. (*       The following Global variables must be correctly set       *)
  180. (*       before calling this procedure .                            *)
  181. (*       1. OutDataCount - an integer-byte count of data characters.*)
  182. (*       2. OUTSEQ    - an integer-byte count of sequence number.   *)
  183. (*       3. OUTPACKETTYPE - an character    of type .               *)
  184. (*       4. SendData   - a character array of data to be sent.      *)
  185. (* ===============================================================  *)
  186. PROCEDURE SENDPACKET ;
  187.  VAR
  188.     I,SUM,Checkbytes : INTEGER ;
  189.     achar            : byte ;
  190.     SOHecho          : boolean ;
  191.  
  192.     BEGIN (* SENDPACKET procedure *)
  193. (*  SOHecho := Not (LocalEcho or (NoEcho and  WaitXon)) ;  *)
  194.     SOHecho := Not (LocalEcho or NoEcho) ;
  195.     achar := 0 ;
  196.     If WaitXon then
  197.          While achar <> XON do if Readchar(achar) then
  198.                                                   else achar := xon ;
  199.     WaitXon := XonXoff ;
  200.     While RecvChar(achar) do ; (* throw away all previous incoming data *)
  201.     Delay(50);
  202.      SUM := 0 ;
  203.      CRC := 0 ;
  204.      Checkbytes := 1 ;
  205.      If (OutPacketType = ord('S')) or (OutPacketType = ord('I')) or
  206.          (InpacketType = ord('S')) or  (InpacketType = ord('I')) or
  207.          (InpacketType = ord('R')) then  (* leave Checkbytes := 1 *)
  208.                               else
  209.          If Checktype = ord('2') then Checkbytes := 2  else
  210.               If Checktype = ord('3') then Checkbytes := 3 ;
  211.  
  212.     SendChar(StartChar) ;                                  (* SOH   *)
  213.     If SOHecho then      (* wait for SOH to be echoed back *)
  214.         While achar <> StartChar do
  215.           if Not Readchar(achar) then achar:=StartChar ;
  216.     If OutDataCount > 94 then OutCount := 0  (* long packet format *)
  217.                          else OutCount := OutDataCount + 2 + Checkbytes ;
  218.     SendChar(OutCount + $20) ;                             (* COUNT *)
  219.       SUM := SUM + OutCount + $20 ;
  220.       If CheckBytes = 3 then CRCheck(OutCount+$20) ;
  221.     SendChar(OUTSEQ+$20) ;                                 (* SEQ   *)
  222.       SUM := SUM + OUTSEQ + $20;
  223.       If CheckBytes = 3 then CRCheck(OUTSEQ+$20);
  224.     SendChar(OUTPACKETTYPE) ;                              (* TYPE  *)
  225.       SUM := SUM + ORD(OUTPACKETTYPE) ;
  226.       If CheckBytes = 3 then CRCheck(Ord(OutpacketType));
  227.  
  228.     If OutDataCount > 94 then (* long packet format *)
  229.          Begin (* send LENX1 LENX2 and HCHECK *)
  230.          LENX1 := Trunc((OutDataCount + Checkbytes ) / 95 ) ;
  231.          SendChar(LENX1+$20) ;                              (* LENX1 *)
  232.             SUM := SUM + LENX1+$20 ;
  233.             If CheckBytes = 3 then CRCheck(LENX1+$20);
  234.          LENX2 := (OutDataCount + Checkbytes ) Mod 95 ;
  235.          SendChar(LENX2+$20) ;                              (* LENX2 *)
  236.             SUM := SUM + LENX2+$20 ;
  237.             If CheckBytes = 3 then CRCheck(LENX2+$20);
  238.          HCHECK := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ;
  239.          SendChar(HCHECK+$20);                              (* HCHECK *)
  240.             SUM := SUM + HCHECK+$20 ;
  241.             If CheckBytes = 3 then CRCheck(HCHECK+$20);
  242.          End ; (* send LENX1 LENX2 and HCHECK *)
  243.     IF OutDataCount > 0 THEN
  244.      FOR I := 1 TO OutDataCount DO
  245.          BEGIN (* Send Data *)
  246.          SendChar(SendData[I]) ;                           (* DATA   *)
  247.          SUM := SUM + SendData[I] ;
  248.          If Checkbytes = 3 then CRCheck(SendData[I]);
  249.          END ; (* Send Data *)
  250.  
  251.  
  252.     If Checkbytes = 1 then
  253.          Begin (* one Checksum *)
  254.          CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ;
  255.          SendChar(CHECKSUM+$20);                           (* CHECKSUM *)
  256.          End   (* one Checksum *)
  257.                      else
  258.     If Checkbytes = 2 then
  259.          Begin (* two Checksum *)
  260.          Checksum := (Sum div $40) and $3F ; (* Bit 11 - 6 *)
  261.          SendChar(Checksum+$20) ;
  262.          Checksum :=  Sum and $3F ;          (* Bit 5 - 0 *)
  263.          SendChar(Checksum+$20) ;
  264.          End  (* two Checksum *)
  265.                       else
  266.     If Checkbytes = 3 then
  267.         Begin (* CRC *)
  268.         SendChar((CRC shr 12 ) and $0F + $20) ;
  269.         SendChar((CRC shr 6  ) and $3F + $20) ;
  270.         SendChar((CRC        ) and $3F + $20) ;
  271.         End ; (* CRC *)
  272.  
  273.     SendChar(rEolChar);                                    (* Cr *)
  274.     If rNumPad > 0 then
  275.         For I := 1 to rNumPad do SendChar(rPadChar);       (* Padding *)
  276.     END ; (* SENDPACKET procedure  *)
  277.  
  278. (* ===============================================================  *)
  279. (* RECVPACKET -This Function returns TRUE if it successfully        *)
  280. (*             recieved a packet and FALSE if it had an error.      *)
  281. (*  Side Effects:                                                   *)
  282. (*       The following global variables will be set.                *)
  283. (*       1. InDataCount - an integer value of the msg char count.   *)
  284. (*       2. INSEQ - an integer value of the sequence count.         *)
  285. (*       3. TYPE  - a  character of message type (Y,N,D,F,etc)      *)
  286. (*       4. RecvData - an array of data bytes to be sent.           *)
  287. (*                                                                  *)
  288. (* ===============================================================  *)
  289. FUNCTION  RECVPACKET : BOOLEAN ;
  290.  VAR
  291.     I,SUM,RESENDS      : INTEGER ;
  292.     INCHAR,Checkbytes  : Byte ;
  293.     dummy              : Boolean ;
  294.  
  295. LABEL EXIT ;
  296.  
  297.     BEGIN (* RECVPACKET procedure *)
  298.     RECVPACKET := false ;    (* assume false until proven otherwise *)
  299.     If GotSOH then begin Inchar := StartChar; GotSOH := false; end
  300.                      else Inchar := $20 ;
  301.     While Inchar <> StartChar Do
  302.          If Readchar(Inchar) then                     (* SOH   *)
  303.                              else goto exit ;
  304.     SUM := 0 ;
  305.     CRC := 0 ;
  306.  
  307.     If not ReadChar (InCount) then goto exit ;        (* COUNT *)
  308.       SUM := SUM + InCount ;
  309.       If CheckBytes = 3 then CRCheck(InCount) ;
  310.       InCount := InCount - $20 ; (* To absolute value *)
  311.  
  312.     if not ReadChar (INSEQ) then  goto exit ;         (* SEQ   *)
  313.       SUM := SUM + INSEQ ;
  314.       If CheckBytes = 3 then CRCheck(INSEQ) ;
  315.       INSEQ := INSEQ - $20 ;
  316.  
  317.     If not ReadChar (INPACKETTYPE ) then goto exit ;  (* TYPE  *)
  318.       SUM := SUM + INPACKETTYPE ;
  319.       If CheckBytes = 3 then CRCheck(InPacketType);
  320.      Checkbytes := 1 ;
  321.      If (OutPacketType = ord('S')) or
  322.          (InpacketType = ord('S')) or
  323.          (InpacketType = ord('R')) then  (* leave Checkbytes := 1 *)
  324.                                    else
  325.          If Checktype = ord('2') then Checkbytes := 2  else
  326.               If Checktype = ord('3') then Checkbytes := 3 ;
  327.  
  328.     If Incount = 0 then
  329.          Begin (* Long Packet format *)
  330.          If not ReadChar (LENX1) then goto exit ;
  331.          SUM := SUM + LENX1 ;
  332.          If CheckBytes = 3 then CRCheck(LENX1) ;
  333.          LENX1 := LENX1 - $20 ;
  334.          If not ReadChar (LENX2) then goto exit ;
  335.          SUM := SUM + LENX2 ;
  336.          If CheckBytes = 3 then CRCheck(LENX2) ;
  337.          LENX2 := LENX2 - $20 ;
  338.          CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ;
  339.          If ReadChar (HCHECK) then
  340.               IF HCHECK <> CHECKSUM+$20  THEN  RECVPACKET := FALSE ;
  341.          SUM := SUM + HCHECK ;
  342.          If Checkbytes = 3 then  CRCheck(HCHECK) ;
  343.          InDataCount := (95*LENX1) +LENX2 - CheckBytes ;
  344.          End  (* Long Packet format *)
  345.                     else
  346.          InDataCount := InCount - 2 - CheckBytes ;
  347.      IF InDataCount >  0 THEN
  348.      FOR I := 1 TO InDataCount  DO
  349.          BEGIN (* Recv Data *)
  350.          If ReadChar (RecvData[I]) then               (* DATA   *)
  351.               Begin (* checksum and CRC *)
  352.               SUM := (SUM and $0FFF) + RecvData[I] ;
  353.               If CheckBytes = 3 then CRCheck(RecvData[I]);
  354.               End  (* checksum and CRC *)
  355.                                    else
  356.               goto exit ;
  357.          END ; (* Revc Data *)
  358.  
  359.     RECVPACKET := True ;    (* Assume Ok until check fails *)
  360.     If Checkbytes = 1 then
  361.          Begin (* one char Checksum *)
  362.          CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ;
  363.          If ReadChar (INCHAR) then
  364.               IF INCHAR <> CHECKSUM+$20  THEN  RECVPACKET := FALSE ;
  365.          End  (* one char Checksum *)
  366.                       else
  367.     If Checkbytes = 2 then
  368.          Begin (* two char Checksum *)
  369.          Checksum := (Sum div $40) and $3F ;
  370.          If ReadChar(Inchar) then
  371.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  372.          Checksum := Sum and $3F ;
  373.          If ReadChar(Inchar) then
  374.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  375.          End   (* two char Checksum *)
  376.                       else
  377.     If Checkbytes = 3 then
  378.          Begin (* CRC char Checksum *)
  379.          Checksum := (CRC shr 12) and $0F ;
  380.          If ReadChar(Inchar) then
  381.           (*  If Inchar <> Checksum+$20 then
  382.                    Writeln('CRC1 ',Inchar,' ',checksum+$20);    *)
  383.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  384.          Checksum := (CRC shr 6 ) and  $3F ;
  385.          If ReadChar(Inchar) then
  386.           (*  If Inchar <> Checksum+$20 then
  387.                Writeln('CRC2 ',Inchar,' ',checksum+$20); *)
  388.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  389.          Checksum := (CRC       ) and  $3F ;
  390.          If ReadChar(Inchar) then
  391.          (*   If Inchar <> Checksum+$20 then
  392.                    Writeln('CRC3 ',Inchar,' ',checksum+$20); *)
  393.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  394.          End;  (* CRC char Checksum *)
  395.  
  396. Exit:
  397.     END ; (* RECVPACKET procedure  *)
  398.  
  399. (* ===============================================================  *)
  400. (* RESENDIT -  This procedure RESENDS the packet if it gets a nak   *)
  401. (*             It calls itself recursively upto the number of times *)
  402. (*             specified in the intial parameter list.              *)
  403. (* Side Effects - If it fails then the STATE in the message is set  *)
  404. (*                to 'A' which means ABORT .                        *)
  405. (*              - Global variable RetryCount is incremented         *)
  406. (* ===============================================================  *)
  407. PROCEDURE RESENDIT ( RETRIES : INTEGER ) ;
  408. VAR I : INTEGER ;
  409.     BEGIN (* RESENDIT procedure *)
  410.     RetryCount := RetryCount + 1 ;
  411.     GotoXY(10,5) ; Write(' Number of Retries      = ',RetryCount,'  ');
  412.     IF RETRIES > 0 THEN
  413.          BEGIN (* Try again *)
  414.          SENDPACKET ;
  415.          IF RECVPACKET THEN
  416.               IF INPACKETTYPE = ord('Y') THEN
  417.                                          ELSE
  418.               IF INPACKETTYPE = ord('E') THEN
  419.                    Begin (* Error Packet *)
  420.                    Writeln(' ') ; Write(' Error Packet >>>> ') ;
  421.                    For I:=1 to InDataCount Do
  422.                        Write(Chr(RecvData[i])) ;
  423.                    STATE := A ;   (* ABORT if not INIT packet *)
  424.                    Writeln('');
  425.                    End   (* Error Packet *)
  426.                                          ELSE  RESENDIT(RETRIES-1)
  427.                        ELSE RESENDIT(RETRIES-1) ;
  428.          END   (* Try again *)
  429.                    ELSE
  430.                    Begin writeln('retries exhausted ');
  431.                    STATE := A ;  (* Retries failed - ABORT *)
  432.                    end ;
  433.     END ; (* RESENDIT procedure  *)
  434.  
  435. (* ------------------------------------------------------------ *)
  436. (*  SendPacketType - Procedure  will send a packet of the       *)
  437. (*            type specified in  the Character  parameter.      *)
  438. (*            i.e. SendPacketType('Y')  an ACK packet           *)
  439. (*                 SendPacketType('N')  an NAK packet           *)
  440. (* ------------------------------------------------------------ *)
  441.      PROCEDURE SendPacketType  (PacketType : char);
  442.          BEGIN (* SEND ACK or NAK or B or Z *)
  443.          OutDataCount := 0 ;
  444.          OUTSEQ := OUTSEQ + 1 ;
  445.          IF OUTSEQ >= 64 THEN OUTSEQ := 0;
  446.          OUTPACKETTYPE := Ord(PacketType) ;
  447.          SENDPACKET ;
  448.          END ; (* SEND ACK or NAK or B or Z *)
  449. (* ------------------------------------------------------------ *)
  450.     PROCEDURE PutInitPacket  ;
  451.          Begin (* Put Parameters into Init Packet *)
  452.          OutDataCount := 9 ;
  453.          OUTSEQ := 0 ;
  454.          (* The values  are tranformed by adding hex 20 to    *)
  455.          (* the true value, making the value a printable char *)
  456.          SendData[1] := sMAXL      + $20 ;  (* Buffsize       *)
  457.          SendData[2] := sTimeout   + $20 ;  (* Time out sec   *)
  458.          SendData[3] := sNumPad    + $20 ;  (* Num padchars   *)
  459.          SendData[4] := sPadChar   + $20 ;  (* Pad char       *)
  460.          SendData[5] := sEolChar   + $20 ;  (* EOL char       *)
  461.          SendData[6] := sCntrlQuote ;      (* Quote character  *)
  462.          (* optional parameters follows *)
  463.          SendData[7] := Bit8Quote ;       (* Quote character  *)
  464.          SendData[8] := CheckType ;       (* Check Type       *)
  465.          SendData[9] := RepChar   ;       (* Repeat Character *)
  466.          SendData[10]:= sCapas + $20 ;    (* Capability field *)
  467.          If Bit8Quote <= $20 then SendData[7] := ord('Y') ;
  468.          If CheckType <= $20 then SendData[8] := ord('1') ;
  469.          If RepChar   <= $20 then OutDataCount := 8 ;
  470.          If ((sCapas and $02) = $02) and (sPacketSize > 94) then
  471.              Begin (* long Packet init *)
  472.              SendData[11] := Windo + $20 ;   (* Window Size *)
  473.              SendData[12] := Trunc(sPacketsize/95) + $20 ;  (* MAXLX1 *)
  474.              SendData[13] := (sPacketSize mod 95 ) + $20 ;  (* MAXLX2 *)
  475.              OutDataCount := 13 ;
  476.              End ; (* long packet init *)
  477.          End ; (* Put Parameters into Init Packet *)
  478. (* ------------------------------------------------------------ *)
  479.     PROCEDURE GetInitPacket ;
  480.          Begin  (* Get init parameters *)
  481.          IF InDataCount >= 1 then  rPacketSize := RecvData[1]-$20 ;
  482.          IF InDataCount >= 2 then  rTimeOut    := RecvData[2]-$20 ;
  483.          IF InDataCount >= 3 then  rNumPad     := RecvData[3]-$20 ;
  484.          IF InDataCount >= 4 then  rPadChar    := RecvData[4]-$20 ;
  485.          IF InDataCount >= 5 then  rEolChar    := (* RecvData[5]-$20 ; *)
  486.                                                   RecvData[5] and $1F ;
  487.          IF InDataCount >= 6 then  rCntrlQuote := RecvData[6] ;
  488.          (* optional parameters *)
  489.          IF InDataCount >= 7 then
  490.               Begin (* Validate bit8Quote *)
  491.               If RecvData[7] = ord('Y') then Bit8Quote := Ord('&')
  492.                                         else
  493.                 If Chr(RecvData[7]) in ['!'..'?','`'..'~']
  494.                      then Bit8Quote := RecvData[7]
  495.                      else Bit8Quote := $20 ;
  496.               End  (* Validate bit8Quote *)
  497.                              else  Bit8Quote  := $20 ;
  498.          IF (InDataCount >= 8) and (chr(RecvData[8]) in ['1','2','3'] )
  499.               then   CheckType  := RecvData[8]
  500.               else   CheckType  := ord('1') ;
  501.          IF InDataCount >= 9 then
  502.              If chr(RecvData[9]) in ['!'..'?','`'..'~']
  503.                    then RepChar := RecvData[9]
  504.                    else RepChar := $20
  505.                              else   RepChar    := $20 ;
  506.          IF InDataCount >= 10 then rCapas := RecvData[10] - $20
  507.                               else rCapas := 0 ;
  508.          If InDataCount >= 11 then Windo := RecvData[11] - $20
  509.                               else Windo := 0 ;
  510.          If (rCapas and $02) = $02 then (* long blocks *)
  511.               If InDataCount >= 13 then
  512.                  rPacketsize := (RecvData[12]-$20)*95 + (RecvData[13]-$20)
  513.                                    else
  514.                  rPacketsize := 500 ;
  515.          End ;  (* Get init parameters *)
  516. (* ------------------------------------------------------------ *)
  517.  Begin  (* Unit Packets *)
  518.  StartChar   := 01 ;     (* Start of Packet char - SOH *)
  519.  (* Default receive Packet settings *)
  520.  rPacketSize := 94 ;     (* PACKET size 94 maximum *)
  521.  rTimeout    := 60 ;     (* Time out in seconds *)
  522.  rNumPad     := 00 ;     (* Number of Pad characters *)
  523.  rPadChar    := 00 ;     (* Padding Character *)
  524.  rEolChar    := 13 ;     (* End of line char - CR *)
  525.  rCntrlQuote := 35 ;     (* # *)
  526.  (* Default send Packet settings *)
  527.  sMAXL       := 94 ;     (* Packet size 94 maximum - no long packets *)
  528.  sPacketSize := 94 ;     (* PACKET size up to MaxPacketsize *)
  529.  sTimeout    := 60 ;     (* Time out in seconds *)
  530.  sNumPad     := 00 ;     (* Number of Pad characters *)
  531.  sPadChar    := 00 ;     (* Padding Character *)
  532.  sEolChar    := 13 ;     (* End of line char - CR *)
  533.  sCntrlQuote := 35 ;     (* # *)
  534.  
  535.  Bit8Quote  := $26 ;     (* & *)
  536.  CheckType  := $31 ;     (* 1 *)
  537.  RepChar    := $7E ;     (* ~ *)
  538.  sCapas     := $02 ;    (* long packets *)
  539.  Windo      := $00 ;     (* window size *)
  540.  End. (* Unit Packets *)
  541.