home *** CD-ROM | disk | FTP | other *** search
/ The First Hungarian Family / The_First_Hungarian_Family_CD-ROM.bin / internet / offlread / protocol / wxmd / wxtrm / wxtmxfer.inc < prev   
Text File  |  1992-06-10  |  40KB  |  1,083 lines
  1.   {   - originally written by:
  2.   Scott Murphy
  3.   77 So. Adams St. #301
  4.   Denver, CO 80209
  5.   Compuserve 70156,263
  6.   }
  7.   {   - modified to add CRC xmodem, wxmodem 7/86 - 10/86
  8.   Peter Boswell
  9.   ADI
  10.   Suite 650
  11.   350 N. Clark St.
  12.   Chicago, Il 60610
  13.   People/Link: Topper
  14.   Compuserve : 72247,3671
  15.   }
  16.   { converted to Turbo Pascal 5.0/5.5 L.B. Neal June 1990 }
  17.  
  18.  
  19. CONST
  20.   SOH = 1;                    {Start Of Header}
  21.   EOT = 4;                    {End Of Transmission}
  22.   ACK = 6;                    {ACKnowledge}
  23.   DLE = $10;                  {Data Link Escape}
  24.   XON = $11;                  {X-On}
  25.   XOFF = $13;                 {X-Off}
  26.   NAK = $15;                  {Negative AcKnowledge}
  27.   SYN = $16;                  {Synchronize}
  28.   CAN = $18;                  {CANcel}
  29.   CHARC = $43;                {C = CRC Xmodem}
  30.   CHARW = $57;                {W = WXmodem}
  31.   MAXERRS = 10;               {Maximum allowed errors}
  32.   L = 0;
  33.   H = 1;
  34.   BufLen = 128;               {Disk I/O buffer length}
  35.   Bufnum = 64;                {Disk I/O buffer count}
  36.   Maxwindow = 4;              {Wxmodem window size}
  37.  
  38. (* crctab calculated by Mark G. Mendel, Network Systems Corporation *)
  39. CONST crctab: ARRAY[0..255] OF WORD = (
  40.     $0000,  $1021,  $2042,  $3063,  $4084,  $50a5,  $60c6,  $70e7,
  41.     $8108,  $9129,  $a14a,  $b16b,  $c18c,  $d1ad,  $e1ce,  $f1ef,
  42.     $1231,  $0210,  $3273,  $2252,  $52b5,  $4294,  $72f7,  $62d6,
  43.     $9339,  $8318,  $b37b,  $a35a,  $d3bd,  $c39c,  $f3ff,  $e3de,
  44.     $2462,  $3443,  $0420,  $1401,  $64e6,  $74c7,  $44a4,  $5485,
  45.     $a56a,  $b54b,  $8528,  $9509,  $e5ee,  $f5cf,  $c5ac,  $d58d,
  46.     $3653,  $2672,  $1611,  $0630,  $76d7,  $66f6,  $5695,  $46b4,
  47.     $b75b,  $a77a,  $9719,  $8738,  $f7df,  $e7fe,  $d79d,  $c7bc,
  48.     $48c4,  $58e5,  $6886,  $78a7,  $0840,  $1861,  $2802,  $3823,
  49.     $c9cc,  $d9ed,  $e98e,  $f9af,  $8948,  $9969,  $a90a,  $b92b,
  50.     $5af5,  $4ad4,  $7ab7,  $6a96,  $1a71,  $0a50,  $3a33,  $2a12,
  51.     $dbfd,  $cbdc,  $fbbf,  $eb9e,  $9b79,  $8b58,  $bb3b,  $ab1a,
  52.     $6ca6,  $7c87,  $4ce4,  $5cc5,  $2c22,  $3c03,  $0c60,  $1c41,
  53.     $edae,  $fd8f,  $cdec,  $ddcd,  $ad2a,  $bd0b,  $8d68,  $9d49,
  54.     $7e97,  $6eb6,  $5ed5,  $4ef4,  $3e13,  $2e32,  $1e51,  $0e70,
  55.     $ff9f,  $efbe,  $dfdd,  $cffc,  $bf1b,  $af3a,  $9f59,  $8f78,
  56.     $9188,  $81a9,  $b1ca,  $a1eb,  $d10c,  $c12d,  $f14e,  $e16f,
  57.     $1080,  $00a1,  $30c2,  $20e3,  $5004,  $4025,  $7046,  $6067,
  58.     $83b9,  $9398,  $a3fb,  $b3da,  $c33d,  $d31c,  $e37f,  $f35e,
  59.     $02b1,  $1290,  $22f3,  $32d2,  $4235,  $5214,  $6277,  $7256,
  60.     $b5ea,  $a5cb,  $95a8,  $8589,  $f56e,  $e54f,  $d52c,  $c50d,
  61.     $34e2,  $24c3,  $14a0,  $0481,  $7466,  $6447,  $5424,  $4405,
  62.     $a7db,  $b7fa,  $8799,  $97b8,  $e75f,  $f77e,  $c71d,  $d73c,
  63.     $26d3,  $36f2,  $0691,  $16b0,  $6657,  $7676,  $4615,  $5634,
  64.     $d94c,  $c96d,  $f90e,  $e92f,  $99c8,  $89e9,  $b98a,  $a9ab,
  65.     $5844,  $4865,  $7806,  $6827,  $18c0,  $08e1,  $3882,  $28a3,
  66.     $cb7d,  $db5c,  $eb3f,  $fb1e,  $8bf9,  $9bd8,  $abbb,  $bb9a,
  67.     $4a75,  $5a54,  $6a37,  $7a16,  $0af1,  $1ad0,  $2ab3,  $3a92,
  68.     $fd2e,  $ed0f,  $dd6c,  $cd4d,  $bdaa,  $ad8b,  $9de8,  $8dc9,
  69.     $7c26,  $6c07,  $5c64,  $4c45,  $3ca2,  $2c83,  $1ce0,  $0cc1,
  70.     $ef1f,  $ff3e,  $cf5d,  $df7c,  $af9b,  $bfba,  $8fd9,  $9ff8,
  71.     $6e17,  $7e36,  $4e55,  $5e74,  $2e93,  $3eb2,  $0ed1,  $1ef0
  72. );
  73.  
  74. (*
  75.  * updcrc derived from article Copyright (C) 1986 Stephen Satchell.
  76.  *  NOTE: First argument must be in range 0 to 255.
  77.  *        Second argument is referenced twice.
  78.  *
  79.  * Programmers may incorporate any or all code into their programs,
  80.  * giving proper credit within the source. Publication of the
  81.  * source routines is permitted so long as proper credit is given
  82.  * to Stephen Satchell, Satchell Evaluations and Chuck Forsberg,
  83.  * Omen Technology.
  84.  *)
  85.  
  86. VAR
  87.   checksum: Integer;
  88.   fname: bigstring;
  89.   response: Char;   {3.04}
  90.   db,sb: Integer;
  91.   crcval: Word;     {3.05}
  92.   packetln: Integer;         {128 + Checksum or 128 + CRC}
  93.   p: parity_set;
  94.   dbuffer: ARRAY[1..Bufnum, 1..BufLen] OF Byte;
  95.   dcount: Integer;
  96.   Wxmode,Crcmode,Openflag: Boolean;
  97.   xpause,canflag: Boolean; {3.09}
  98.   prevchar,ackseq,ackblks,nblks,sblks: Integer; {3.09}
  99.   twindow, awindow,errors : Integer; {transmission window}
  100.   statstr: BigString; {3.09}
  101.   UserKey: Byte; {3.09}
  102.  
  103. (* -----------------------  now called directly used twice 3.04
  104.   PROCEDURE updcrc(a:Byte);
  105.   BEGIN
  106.    crcval := Crctab[hi(crcval) xor a] xor (lo(crcval) shl 8);
  107.   END;
  108.  ------------------------- *)
  109.  
  110.  (* ---- This method seems to have a problem! -- 3.05 -----
  111.  FUNCTION UpdCrc(cp: BYTE; crc: WORD): WORD;
  112.  BEGIN {UpdCrc}
  113.   UpdCrc := crctab[((crc SHR 8) AND 255)] XOR (crc SHL 8) XOR cp
  114.  END;
  115.  ----------------------------------------------------------- *)
  116.  
  117.   FUNCTION cgetc(TimeLimit: Integer): Integer;
  118.     {if a byte is recieved at COM1/COM2: in less than TimeLimit seconds,
  119.     returns byte as an integer, else returns 0}
  120.   BEGIN
  121.     TimeLimit := TimeLimit SHL 10; {convert TimeLimit to millisecs}
  122.     WHILE (Buffer_Count < 1) AND (TimeLimit > 0) DO
  123.       BEGIN
  124.         Delay(1); DEC(TimeLimit);
  125.       END;
  126.     IF ( (TimeLimit >= 0) AND (Buffer_Count > 0) ) THEN
  127.       BEGIN
  128.        INLINE($FA); {suspend interrupts}
  129.        cgetc := Recv_Buffer[buffer_Tail];
  130.        IF Buffer_Tail < Buffer_End THEN { 3.04 safer this way }
  131.         INC(Buffer_Tail)
  132.        ELSE
  133.         Buffer_Tail := 1;
  134.        DEC(Buffer_Count); 
  135.        INLINE($FB); {resume interrupts}
  136.        Port[$20] := $20; {3.10 kick interrupts}
  137.       END
  138.     ELSE
  139.      cgetc := -1;
  140.   END;
  141.  
  142.   { Xmodem transmit window routine
  143.   Peter Boswell, July 1986       }
  144.  
  145.   PROCEDURE txwindow(opt:Integer; in_string:bigstring);
  146.   BEGIN
  147.    IF opt > 1 THEN INC(opt);   { adjust new window 3.04 }
  148.     CASE opt OF
  149.       1 : BEGIN               {initialize}
  150.             DoBorder(36,3,78,18,False); {3.09}
  151.             GoToXY(10,2);
  152.             Write('File - ', in_string);
  153.             GoToXY(10,3);
  154.             Write('Mode -');
  155.             GoToXY(4,4);
  156.             Write('Total time -');
  157.             GoToXY(2,5);
  158.             Write('Total Blocks -');
  159.             GoToXY(10,6);
  160.             Write('Sent -');
  161.             GoToXY(9,7);
  162.             Write('ACK''d -');
  163.             GoToXY(6,8);
  164.             Write('Last NAK -');
  165.             GoToXY(9,9);
  166.             Write('X-Off - No');
  167.             GoToXY(8,10);
  168.             Write('Window - 0');
  169.             GoToXY(4,12);
  170.             Write('Last Error -');
  171.             GoToXY(8,11);
  172.             Write('Errors -');
  173.           END;
  174.       3..12 : BEGIN {3.04}
  175.                GoToXY(17,opt);
  176.                {ClrEol;}
  177.                Write(in_string);
  178.               END;
  179.       13 : BEGIN{3.04}
  180.             GoToXY(3, 13);
  181.             {ClrEol;}
  182.             Write(in_string);
  183.            END;
  184.      100 : BEGIN ClrScr; Window(1,1,80,24); END;
  185.     END; {case}
  186.   END;
  187.  
  188.   { Xmodem receive window routine
  189.   Peter Boswell, October 1986       }
  190.  
  191.   PROCEDURE trwindow(opt:Integer; in_string:bigstring);
  192.   BEGIN
  193.    IF opt > 1 THEN INC(opt); {3.04}
  194.     CASE opt OF
  195.       1 : BEGIN {initialize}
  196.             DoBorder(36,3,78,13,False);
  197.             GoToXY(10, 2);
  198.             Write('File - ', in_string);
  199.             GoToXY(10, 3);
  200.             Write('Mode -');
  201.             GoToXY(6, 4);
  202.             Write('Received -');
  203.             GoToXY(6, 5);
  204.             Write('Last NAK -');
  205.             GoToXY(4, 6);
  206.             Write('Last Error -');
  207.             GoToXY(8, 7);
  208.             Write('Errors -');
  209.           END;
  210.       3..7 : BEGIN
  211.                GoToXY(17, opt);
  212.                {ClrEol;}
  213.                Write(in_string);
  214.              END;
  215.       9 : BEGIN
  216.            GoToXY(3,9);
  217.            {ClrEol;}
  218.            Write(in_string);
  219.           END;
  220.       100 : BEGIN ClrScr; Window(1,1,80,24); END;
  221.     END;{case}
  222.   END;
  223.  
  224.   { This routine deletes all DLE characters and XOR's the following character
  225.   with 64.  If a SYN character is found then -2 is returned. }
  226.  
  227.   FUNCTION dlecgetc(Tlimit:Integer):Integer;
  228.   VAR savecgetc: Integer;
  229.   BEGIN
  230.    IF wxmode THEN
  231.     BEGIN
  232.      savecgetc := cgetc(Tlimit);
  233.      IF savecgetc = SYN THEN
  234.       savecgetc := -2
  235.      ELSE
  236.       IF savecgetc = DLE THEN
  237.        BEGIN
  238.         savecgetc := cgetc(Tlimit);
  239.         IF savecgetc >= 0 THEN savecgetc := savecgetc XOR 64;
  240.        END;
  241.      dlecgetc := savecgetc;
  242.     END
  243.    ELSE
  244.     dlecgetc := cgetc(Tlimit);
  245.   END;
  246.  
  247.   PROCEDURE purge;
  248.   BEGIN
  249.     WHILE dlecgetc(1) >= 0 DO{NOP};
  250.   END;
  251.  
  252.   PROCEDURE SaveCommStatus;
  253.   BEGIN
  254.     p := parity;
  255.     db := dbits;
  256.     sb := stop_bits;
  257.     dbits := 8;
  258.     parity := none;
  259.     stop_bits := 1;
  260.   END;
  261.  
  262.   PROCEDURE recv_wcp; {receive using Ward Christensen's checksum protocol}
  263.   LABEL Exit_recv_wcp;  {3.04}
  264.   LABEL Exit_recv;      {3.08}
  265.   VAR
  266.     j,firstchar,sectnum,sectcurr,prevchar,lignore,blkcnt,
  267.     toterr,errors,sectcomp,bufcurr,bresult: Integer;
  268.     Xtrace,EotFlag,ErrorFlag,Extend: Boolean;
  269.     UserKey: Byte;
  270.     blkfile: FILE;
  271.     statstr: bigstring;
  272.     trfile: Text;
  273.   BEGIN
  274.     {Gotoxy(2,1); Write('RECV XMODEM');} {3.08}
  275.     ErrorFlag := True;
  276.     EotFlag := False;
  277.     Xtrace := False;
  278.     Openflag := False;
  279.     Bufcurr := 1;
  280.     SaveCommStatus;
  281.     WHILE ErrorFlag DO
  282.       BEGIN
  283.         DoBorder(10,10,60,12,False); {3.09}
  284.         REPEAT
  285.           GotoXy(3,2);
  286.           Write('Enter filename or <cr> abort:'); {Chd 3.08}
  287.           ReadLn(fname);
  288.           supcase(fname);
  289.           IF Length(fname) > 0 THEN
  290.            IF exists(fname) THEN
  291.             BEGIN
  292.              Gotoxy(3,4);
  293.              Write(fname,' Exists. OK to overwrite it(Y/N)?');
  294.              REPEAT
  295.               response := Upcase(ReadKey);
  296.              UNTIL (response = 'Y') OR (response = 'N');
  297.              IF response = 'Y' THEN ErrorFlag := False;
  298.             END
  299.            ELSE ErrorFlag := False
  300.         UNTIL (NOT ErrorFlag) OR (Length(fname) = 0);
  301.  
  302.         BEGIN ClrScr; Window(1,1,80,24); END;
  303.  
  304.         IF Length(fname) > 0 THEN
  305.          BEGIN
  306.           Assign(blkfile, fname);
  307.           {$I-} Rewrite(blkfile); {$I+}
  308.           ErrorFlag := (IOResult <> 0);
  309.           IF ErrorFlag THEN
  310.            BEGIN
  311.             WriteLn(#13, #10, 'WXTERM --- cannot open file.'); {Chd 3.01}
  312.             GOTO Exit_recv_wcp; {3.04}
  313.            END
  314.           ELSE
  315.            openflag := True;
  316.          END
  317.         ELSE
  318.          GOTO Exit_Recv; {3.10}
  319.        {IF Length(fname) = 0 THEN GOTO Exit_recv;} {3.10}
  320.       END; {while}
  321.  
  322.     trwindow(1,fname);
  323.     blkcnt := 0;
  324.     sectnum := 0;
  325.     errors := 0;
  326.     toterr := 0;
  327.     {assign(trfile,'trace');}
  328.     {rewrite(trfile);}
  329.     Crcmode := True;          {Assume CRC versus Checksum}
  330.     Packetln := 130;          {128 byte data + 2 byte CRC}
  331.     Wxmode := True;           {Assume Wxmodem}
  332.     Lignore := 0;             {ignore packets after error}
  333.     i := 0;                   {Try for Wxmodem 3 times}
  334.     dump; {purge;}
  335.     trwindow(8, 'Trying Wxmodem.'); {Chd 3.01}
  336.     REPEAT
  337.       send(ORD('W'));
  338.       firstchar := cgetc(12); {12 seconds each}
  339.       IF Keypressed THEN
  340.        BEGIN
  341.         userkey := ORD(readkey);       
  342.         IF UserKey = CAN THEN GOTO Exit_recv_wcp; {3.04}
  343.        END;
  344.       INC(i);
  345.     UNTIL (firstchar = SYN) OR (firstchar = CAN) OR (i = 3);
  346.     IF firstchar = CAN THEN GOTO Exit_recv_wcp; {3.04}
  347.     IF firstchar <> SYN THEN
  348.       BEGIN
  349.         Wxmode := False;
  350.         i := 0;               {Try CRC xmodem 3 times}
  351.         trwindow(8, 'Trying CRC Xmodem.'); {Chd 3.01}
  352.         REPEAT
  353.           send(ORD('C'));
  354.           firstchar := cgetc(4);             {4 seconds each}
  355.           IF Keypressed THEN
  356.            BEGIN
  357.             UserKey := ORD(readkey);
  358.             IF UserKey = CAN THEN GOTO  Exit_recv_wcp; {3.04}
  359.            END;
  360.           INC(i);
  361.         UNTIL (firstchar = SOH) OR (firstchar = CAN) OR (i = 3);
  362.         IF firstchar = CAN THEN GOTO  Exit_recv_wcp; {3.04}
  363.         IF firstchar <> SOH THEN
  364.           BEGIN
  365.             Crcmode := False;
  366.             Packetln := 129;  {128 bytes + 1 byte Checksum}
  367.             i := 0;           {Try Checksum xmodem 4 times}
  368.             trwindow(5, 'Trying Checksum Xmodem.'); {Chd 3.01}
  369.             REPEAT
  370.               send(NAK);
  371.               firstchar := cgetc(10); {10 seconds each}
  372.               IF KeyPressed THEN
  373.                BEGIN
  374.                 UserKey := ORD(readkey);
  375.                 IF UserKey = CAN THEN GOTO Exit_recv_wcp; {3.04}
  376.                END;
  377.               INC(i);
  378.             UNTIL (firstchar = SOH) OR (firstchar = CAN) OR (i = 4);
  379.           END;                {Checksum}
  380.       END;                    {CRC}
  381.     IF wxmode THEN
  382.       BEGIN
  383.         trwindow(2, 'WXmodem.    '); {Chd 3.01}
  384.       END;
  385.     IF NOT wxmode AND crcmode THEN
  386.       BEGIN
  387.         trwindow(2, 'CRC Xmodem. '); {Chd 3.01}
  388.       END;
  389.     IF NOT wxmode AND NOT crcmode THEN
  390.       BEGIN
  391.         trwindow(2, 'CSUM Xmodem.'); {Chd 3.04}
  392.       END;
  393.     trwindow(8, 'Press ^X to quit');
  394.  
  395.     { firstchar contains the first character and Wxmode and Crcmode
  396.     indicate the type of Xmodem }
  397.  
  398.     prevchar := firstchar;    {save the firstchar}
  399.     WHILE (EotFlag = False) AND (Errors < MAXERRS) DO {3.04}
  400.       BEGIN                   {locate start of packet}
  401.         IF (firstchar = SOH) AND
  402.         ( (Wxmode AND (prevchar = SYN)) OR (NOT Wxmode) ) THEN
  403.           BEGIN {process packet}
  404.             prevchar := -1;
  405.             firstchar := -1;
  406.             sectcurr := dlecgetc(15);
  407.             { writeln(trfile,'sectcurr=',sectcurr:4);}
  408.             sectcomp := dlecgetc(15);
  409.             IF sectcurr = (sectcomp XOR 255) THEN
  410.               BEGIN           {sequence versus compl good}
  411.                 IF sectcurr = ((sectnum+1) AND 255) THEN
  412.                   BEGIN       {in sequence}
  413.                     crcval := 0;
  414.                     checksum := 0;
  415.                     j := 1;
  416.                 {------ Receive Loop Starts ----------}
  417.                     REPEAT
  418.                      firstchar := dlecgetc(15);
  419.                      IF firstchar >= 0 THEN
  420.                       BEGIN
  421.                        IF j < 129 THEN
  422.                         dbuffer[bufcurr,j] := Lo(firstchar); {3.09}
  423.                        IF Crcmode THEN
  424.                         {updcrc(firstchar)} {3.04}
  425.               crcval := Crctab[hi(crcval) XOR firstchar] XOR (lo(crcval) SHL 8)
  426.                        ELSE
  427.                         checksum := (checksum AND 255)+firstchar;
  428.                        INC(j);
  429.                       END;
  430.                     UNTIL (j > Packetln) OR (firstchar < 0);
  431.                 {------ End Receive Loop -----------------}
  432.                     IF j > Packetln THEN {good packet length}
  433.                       BEGIN
  434.                         IF (Crcmode AND (crcval = 0) OR
  435.                         (NOT Crcmode AND ((checksum SHR 1) = firstchar)))
  436.                         THEN
  437.                           BEGIN {good crc/checksum}
  438.                             firstchar := -1; {make sure this byte not used
  439.                             for start of packet } errors := 0;
  440.                             sectnum := sectcurr;
  441.                             INC(blkcnt);
  442.                             send(ACK);
  443.                             IF Wxmode THEN send(sectcurr AND 3);
  444.                           { write(trfile,' ACK ');}
  445.                           { if Wxmode then write(trfile,(sectcurr and 3):1);}
  446.                             Str(blkcnt:4, statstr);
  447.                             trwindow(3, statstr);
  448.                             IF errors <> 0 THEN
  449.                               BEGIN
  450.                                 errors := 0;
  451.                                 trwindow(6, '0');
  452.                                 trwindow(5, ' ');
  453.                               END;
  454.                             INC(bufcurr);
  455.                             IF bufcurr > bufnum THEN
  456.                               BEGIN                     {Disk write routine}
  457.                                 bufcurr := 1;
  458.                                 BlockWrite(blkfile, dbuffer, bufnum, bresult);
  459.                                 IF bresult <> bufnum THEN
  460.                                   BEGIN
  461.                                     trwindow(8, 'Disk write error');
  462.                                     GOTO  Exit_recv_wcp; {3.04}
  463.                                   END;
  464.                               END; {End of disk write routine}
  465.                           END {good crc/checksum}
  466.                         ELSE
  467.                           BEGIN {bad crc/checksum}
  468.                             trwindow(5, 'CRC/Checksum error');
  469.                             Str((blkcnt+1):6, statstr);
  470.                             trwindow(4, statstr);
  471.                             errors := errors+1;
  472.                             Str(errors:3, statstr);
  473.                             trwindow(6, statstr);
  474.                             toterr := toterr+1;
  475.                             Dump; {purge;} {clear any garbage coming in}
  476.                             send(NAK);
  477.                             IF wxmode THEN
  478.                               BEGIN
  479.                                send(sectcurr AND 3);
  480.                                lignore := maxwindow;
  481.                               END;
  482.                             {write(trfile,' NAK CRC ',(sectcurr and 3):1);}
  483.                           END; {bad crc/checsum}
  484.                       END     {good packet length}
  485.                     ELSE
  486.                       BEGIN   {bad packet length}
  487.                         trwindow(5, 'Short block error.'); {Chd 3.01}
  488.                         Str((blkcnt+1):6, statstr);
  489.                         trwindow(4, statstr);
  490.                         errors := errors+1;
  491.                         Str(errors:3, statstr);
  492.                         trwindow(6, statstr);
  493.                         INC(toterr);
  494.                         Dump; {purge;} {clear any garbage}
  495.                         send(NAK);
  496.                         IF wxmode THEN
  497.                          BEGIN
  498.                           send(sectcurr AND 3);
  499.                           lignore := maxwindow;
  500.                          END;
  501.                         dump; {purge;} {clear any garbage}
  502.                         {write(trfile,' NAK SHORT ',(sectcurr and 3):1);}
  503.                       END; {bad packet length}
  504.                   END {good block sequence number}
  505.                 ELSE
  506.                   BEGIN {invalid sequence number}
  507.                     IF lignore <= 0 THEN {are we ignoring packets?}
  508.                       BEGIN
  509.                         trwindow(5, 'Out of sequence.'); {Chd 3.01}
  510.                         Str((blkcnt+1):6, statstr);
  511.                         trwindow(4, statstr);
  512.                         INC(errors);
  513.                         Str(errors:3, statstr);
  514.                         trwindow(6, statstr);
  515.                         INC(toterr);
  516.                         dump; {purge;} {clear any garbage coming in}
  517.                         send(NAK);
  518.                         IF wxmode THEN
  519.                          BEGIN
  520.                           send((sectnum+1) AND 3);
  521.                           lignore := Maxwindow;
  522.                          END;
  523.                         dump; {purge;} {clear any garbage coming in}
  524.                         {write(trfile,' NAK SEQ ',((sectnum+1) and 3):1);}
  525.                       END
  526.                     ELSE
  527.                      DEC(lignore); {3.04}
  528.                   END; {invalid sequence number}
  529.               END {valid complement}
  530.             ELSE
  531.               BEGIN {invalid complement}
  532.                 trwindow(5, 'Sequence complement error.'); {Chd 3.01}
  533.                 Str((blkcnt+1):6, statstr);
  534.                 trwindow(4, statstr);
  535.                 INC(errors);
  536.                 Str(errors:3, statstr);
  537.                 trwindow(6, statstr);
  538.                 INC(toterr);
  539.                 dump; {purge;}        {clear any garbage comming in}
  540.                 send(NAK);
  541.                 IF wxmode THEN
  542.                  BEGIN
  543.                   send((sectnum+1) AND 3);
  544.                   lignore := Maxwindow;
  545.                  END;
  546.                 dump; {purge;}        {clear any garbage comming in}
  547.                 {write(trfile,' NAK CMP ',((sectnum + 1) and 3):1);}
  548.               END;{invalid complement}
  549.           END {process packet}
  550.         ELSE {not start of packet}
  551.           BEGIN
  552.             CASE prevchar OF
  553.               EOT : BEGIN
  554.                      IF firstchar = EOT THEN
  555.                       BEGIN
  556.                        EotFlag := True;
  557.                        send(ACK);
  558.                       END;
  559.                     END;
  560.               CAN : BEGIN
  561.                      IF firstchar = CAN THEN
  562.                       GOTO Exit_recv_wcp; {3.04}
  563.                     END;
  564.             END;{Of case}
  565.             IF NOT EotFlag THEN
  566.               BEGIN
  567.                 IF firstchar = EOT THEN
  568.                   BEGIN
  569.                     send(NAK); {first EOT received}
  570.                     trwindow(5, ' First EOT received.'); {Chd 3.01}
  571.                   END;
  572.                 prevchar := firstchar;
  573.                 firstchar := cgetc(15); {start of packet!!!!}
  574.                 IF firstchar = -1 THEN
  575.                   BEGIN
  576.                     IF (prevchar = CAN) OR (prevchar = EOT) THEN
  577.                       firstchar := prevchar {assume two have been received}
  578.                     ELSE
  579.                       BEGIN
  580.                         trwindow(5, 'Timeout on start of packet.'); {Chd 3.01}
  581.                         Str((blkcnt+1):6, statstr);
  582.                         trwindow(4, statstr);
  583.                         INC(errors);
  584.                         Str(errors:3, statstr);
  585.                         trwindow(6, statstr);
  586.                         send(XON);
  587.                         INC(toterr);
  588.                         send(NAK);
  589.                         IF wxmode THEN
  590.                          BEGIN
  591.                           send((sectnum+1) AND 3);
  592.                           lignore := Maxwindow;
  593.                          END;
  594.                         { write(trfile,' NAK TIM ',((sectnum+1) and 3):1);}
  595.                       END;
  596.                   END; {Timeout at start of packet}
  597.                 IF KeyPressed THEN
  598.                  BEGIN
  599.                   UserKey := ORD(ReadKey);
  600.                   IF UserKey = CAN THEN GOTO Exit_recv_wcp; {3.04}
  601.                  END;
  602.               END;{end of not EotFlag}
  603.           END;{not start of packet}
  604.       END;{xmodem loop}
  605.  
  606.     {If there are any xmodem packets left in dbuffer, we had best
  607.     write them out}
  608.  
  609.     IF EotFlag AND (bufcurr > 1) THEN
  610.       BEGIN
  611.        DEC(bufcurr);           { 3.04 }
  612.        trwindow(8, 'Writing final blocks.'); {Chd 3.01}
  613.        BlockWrite(Blkfile, dbuffer, bufcurr, bresult);
  614.        IF bufcurr <> bresult THEN
  615.         BEGIN
  616.          trwindow(8, 'Disk write error at end of receive.'); {Chd 3.01}
  617.          EotFlag := False; {no longer a 'real' eot}
  618.         END;
  619.       END;
  620.  
  621.  Exit_recv_wcp:                      { exit routine }
  622.  
  623.     IF NOT Eotflag THEN
  624.       BEGIN
  625.         IF errors >= Maxerrs THEN
  626.          trwindow(8, 'Maximum errors exceeded.') {Chd 3.01}
  627.         ELSE
  628.          IF UserKey = CAN THEN
  629.           BEGIN
  630.            trwindow(5,'^X entered.'); {Chd 3.01}
  631.            REPEAT                 {3.04}
  632.             FOR i := 1 TO 6 DO send(CAN); {3.04a}
  633.             Purge;                {3.04a}
  634.            UNTIL (cgetc(1) = -1); {3.04}
  635.           END;
  636.         IF firstchar = CAN THEN
  637.           trwindow(5, 'Cancel received.'); {Chd 3.01}
  638.         IF openflag THEN
  639.          BEGIN
  640.           {$I-} Close(blkfile) {$I+} ;
  641.           i := IOResult;    {clear ioresult}
  642.           {$I-} Erase(blkfile); {$I+}
  643.           i := IOResult;    {clear ioresult}
  644.          END;
  645.       END;
  646.  
  647.  
  648.     trwindow(99,' '); {3.08 clear the transfer window }
  649.     StatusLine; {3.08}
  650.  
  651. Exit_Recv: {3.08}
  652.  
  653.     dbits := db;
  654.     parity := p;
  655.     stop_bits := sb;
  656.     {close(trfile);}
  657.     {update_uart;}
  658.   END;{recv_wcp}
  659.  
  660. {-------- Start Send Routine --------------}
  661.     PROCEDURE checkack(tlimit: Integer);
  662.     VAR inchar: Integer;
  663.     BEGIN
  664.       REPEAT {until no more data & timelimit}
  665.         inchar := cgetc(0);
  666.         IF inchar <> -1 THEN
  667.           BEGIN               {got a character}
  668.             IF wxmode THEN    {wxmodem}
  669.               BEGIN
  670.                 {write(trfile,inchar:4);}
  671.                 CASE inchar OF
  672.                   XOFF : BEGIN
  673.                           xpause := True;
  674.                           txwindow(8, 'Received - waiting.'); {Chd 3.01}
  675.                          END;
  676.                   XON : BEGIN
  677.                          xpause := False;
  678.                          txwindow(8, 'No');
  679.                         END;
  680.                   ACK, NAK, CAN : prevchar := inchar; {save ACK/NAK/CAN}
  681.                   0..3 : BEGIN {valid ACK/NAK sequence number}
  682.                            CASE prevchar OF
  683.                              ACK : BEGIN
  684.                                      ackseq := inchar-(ackblks AND twindow);
  685.                                      IF ackseq <= 0 THEN
  686.                                        ackseq := ackseq+maxwindow;
  687.                                      nblks := ackblks+ackseq;
  688.                                      IF nblks <= sblks THEN
  689.                                        BEGIN
  690.                                          ackblks := nblks;
  691.                                          Str(ackblks:4, statstr);
  692.                                          txwindow(6, statstr);
  693.                                          IF errors <> 0 THEN
  694.                                           BEGIN
  695.                                            errors := 0;
  696.                                            txwindow(10, '0');
  697.                                           END;
  698.                                        END;
  699.                                      { writeln(trfile,' ACK ',inchar:2,ackblks:5);}
  700.                                      prevchar := -1;
  701.                                    END; {case ACK}
  702.                              NAK : BEGIN
  703.                                      ackseq := inchar-(ackblks AND twindow);
  704.                                      IF ackseq <= 0 THEN
  705.                                        ackseq := ackseq+maxwindow;
  706.                                      nblks := ackblks+ackseq;
  707.                                      IF nblks <= sblks THEN
  708.                                        BEGIN
  709.                                          sblks := nblks-1;
  710.                                          IF (sblks-ackblks) <= 2 THEN
  711.                                            ackblks := sblks;
  712.                                          Str(nblks:4, statstr);
  713.                                          txwindow(7, statstr);
  714.                                          Str(sblks:4, statstr);
  715.                                          txwindow(5, statstr);
  716.                                          INC(errors);
  717.                                          Str(errors:3, statstr);
  718.                                          txwindow(10, statstr);
  719.                                        END
  720.                                      ELSE
  721.                                        BEGIN
  722.                                          GoToXY(3, 12);
  723.                                          {ClrEol;}
  724.                                          WriteLn('Invalid NAK seq ', nblks:4, ackseq:4, inchar:3);
  725.                                        END;
  726.                                      {writeln(0tile,' NAK ',inchar:2,ackblks:5,sblks:5);}
  727.                                      prevchar := -1;
  728.                                    END; {case NAK}
  729.                              CAN : BEGIN
  730.                                      IF inchar = CAN THEN canflag := True;
  731.                                    END;
  732.                            END; {of case prevchar}
  733.                          END; {case 0..3}
  734.                 ELSE{of case inchar}
  735.                   prevchar := -1; {inchar not XON/XOFF/ACK/NAK/CAN/0/1/2/3}
  736.                 END;{of case inchar}
  737.               END{wxmodem mode}
  738.             ELSE
  739.               BEGIN {regular xmodem}
  740.                 CASE inchar OF
  741.                   ACK : BEGIN
  742.                          ackblks := ackblks+1;
  743.                          errors := 0;
  744.                         END;
  745.                   NAK : BEGIN
  746.                          DEC(sblks);  {3.04}
  747.                          INC(errors); {3.04}
  748.                         END;
  749.                   CAN : BEGIN
  750.                          IF prevchar = CAN THEN canflag := True;
  751.                          prevchar := CAN;
  752.                         END;
  753.                 ELSE prevchar := inchar;
  754.                 END; {end of case inchar}
  755.               END; {regular xmodem}
  756.           END {end of got a character}
  757.         ELSE {no incoming data, inchar=-1}
  758.           BEGIN
  759.             IF tlimit > 0 THEN
  760.              BEGIN
  761.               Delay(1);
  762.               DEC(tlimit); {3.04}
  763.              END;
  764.           END; {end no incoming data}
  765.         IF KeyPressed THEN
  766.          BEGIN
  767.           UserKey := ORD(ReadKey);
  768.           IF UserKey = CAN THEN
  769.            BEGIN
  770.             canflag := True;
  771.             tlimit := 0;  {force end of repeat}
  772.             inchar := -1; { "    "   "  "     }
  773.             xpause := False;
  774.             dump; {purge;}
  775.            END;
  776.          END;                {end of keypressed}
  777.       UNTIL (tlimit <= 0) AND (inchar = -1); {repeat until nothing left}
  778.     END; {of procedure checkack}
  779.  
  780.     PROCEDURE dlesend(c: Integer);
  781.     VAR j: Integer;
  782.     BEGIN
  783.      IF wxmode THEN
  784.       BEGIN
  785.        IF Buffer_Count > 0 THEN {if there is any incoming data}
  786.         checkack(0);
  787.        WHILE xpause DO     {X-Off received .. better wait}
  788.         BEGIN
  789.          j := 0;
  790.          REPEAT
  791.           checkack(0);
  792.           INC(j);
  793.           Delay(1);
  794.          UNTIL ((xpause = False) OR (j >= 10000)); {3.09}
  795.          IF xpause THEN  {but not forever}
  796.           BEGIN
  797.            txwindow(8, 'No - Timed Out.'); {Chd 3.01}
  798.            xpause := False;
  799.           END;
  800.         END;
  801.        CASE c OF
  802.         SYN, XON, XOFF, DLE : BEGIN
  803.                                send(DLE);
  804.                                send(c XOR 64);
  805.                               END;
  806.         ELSE
  807.          BEGIN {3.09}
  808.           WHILE (Port[CdetPort] AND $10) = 0 DO {NOP}; {3.09}
  809.           WHILE (port[outport] AND 32) = 0 DO {NOP};
  810.           port[base] := LO(c); {3.09}
  811.          END;
  812.        END;{case}
  813.       END
  814.      ELSE
  815.       BEGIN {3.09}
  816.        WHILE (Port[CdetPort] AND $10) = 0 DO {NOP}; {3.09}
  817.        WHILE (port[outport] AND 32) = 0 DO {NOP};
  818.        port[base] := LO(c); {3.09}
  819.       END;
  820.     END;{dlesend}
  821.  
  822.   PROCEDURE send_wcp;
  823.   LABEL Exit_send_wcp,TransMit,Exit_send; {3.08}
  824.   VAR
  825.     c,i,j,sectnum,tblks, rblks : Integer; {total, sent, ack'd blocks}
  826.     bresult,xblk: Integer;
  827.     bflag,extend: Boolean;
  828.     blkfile : FILE;
  829.     trfile : Text;
  830.  
  831.   BEGIN
  832.     SaveCommStatus;
  833.     openflag := False;
  834.     DoBorder(10,10,60,12,False); {3.09}
  835.  
  836.     REPEAT
  837.       Gotoxy(3,2);
  838.       Write('Enter filename <cr> to abort:'); {Chd 3.08}
  839.       ReadLn(fname);
  840.       supcase(fname);
  841.       IF Length(fname) > 0 THEN
  842.        BEGIN
  843.         bflag := exists(fname);
  844.         IF NOT bflag THEN
  845.          BEGIN
  846.           Gotoxy(3,4);
  847.           Write('Could not open file: ', fname); {Chd 3.01}
  848.           Gotoxy(3,5);
  849.           Write('(Spelling or drive designation wrong?)');
  850.          END;
  851.        END;
  852.     UNTIL bflag OR (Length(fname) = 0);
  853.  
  854.     BEGIN ClrScr; Window(1,1,80,24); END;
  855.  
  856.     IF Length(fname) = 0 THEN GOTO Exit_send; {3.08}
  857.  
  858.     Assign(Blkfile, fname);
  859.     {$I-} Reset(Blkfile,1); {$I+}
  860.     IF IOResult <> 0 THEN GOTO Exit_send_wcp;
  861.     openflag := True;
  862.     txwindow(1, fname);
  863.     tblks := (FileSize(Blkfile)) DIV 128;
  864.     IF tblks MOD 128 <> 0 THEN INC(Tblks); { is another partial block}
  865.     {$I-} Close(BlkFile);{$I+}
  866.     IF IORESULT = 0 THEN
  867.      Reset(BlkFile)                        { reset to have 128k blocks}
  868.     ELSE
  869.      GOTO Exit_send_wcp;
  870.     Str((tblks)*22.3333333/speed:6:2, statstr);
  871.     txwindow(3, statstr);
  872.     Str(tblks:4, statstr);
  873.     txwindow(4, statstr);
  874.     txwindow(12, 'Press ^X to abort transfer.'); {Chd 3.01}
  875.     prevchar := -1;
  876.     sblks := 0;               {sent blks}
  877.     ackblks := 0;             {ack'd blocks}
  878.     rblks := 0;               {highest read block}
  879.     errors := 0;
  880.     canflag := False;         {not cancelled yet}
  881.     xpause := False;
  882.     UserKey := 0;
  883.  
  884.     {Xmodem transmit protocol initialization}
  885.  
  886.     i := 0;
  887.     REPEAT
  888.       c := cgetc(1);
  889.       IF c <> -1 THEN
  890.         BEGIN                 {we got a character!}
  891.           INC(i);             {one of our 10 characters }
  892.           CASE c OF
  893.             NAK : BEGIN       {Checksum Xmodem}
  894.                     crcmode := False;
  895.                     wxmode := False;
  896.                     twindow := 0;
  897.                     txwindow(2, 'Checksum Xmodem Send.'); {Chd 3.01}
  898.                     GOTO TransMit; {3.04}
  899.                   END;
  900.             CHARC : BEGIN     {CRC Xmodem}
  901.                       crcmode := True;
  902.                       wxmode := False;
  903.                       twindow := 0;
  904.                       txwindow(2, 'CRC Xmodem Send.') {Chd 3.01};
  905.                       GOTO TransMit; {3.04}
  906.                     END;
  907.             CHARW : BEGIN     {WXmodem}
  908.                       crcmode := True;
  909.                       wxmode := True;
  910.                       twindow := Maxwindow-1;
  911.                       txwindow(2, 'WXmodem Send.'); {Chd 3.01}
  912.                       Str(Maxwindow:1, statstr);
  913.                       txwindow(9, statstr);
  914.                       GOTO TransMit; {3.04}
  915.                     END;
  916.             CAN : BEGIN       {Cancel request received}
  917.                     IF canflag THEN
  918.                      GOTO Exit_send_wcp
  919.                     ELSE
  920.                      canflag := True;
  921.                   END;
  922.           END; {of case c}
  923.         END;{got a character}
  924.  
  925.       IF KeyPressed THEN UserKey := ORD(ReadKey);
  926.  
  927.     UNTIL (i > 10) OR (UserKey = CAN);
  928.  
  929.     IF UserKey = CAN THEN GOTO Exit_send_wcp;
  930.     UserKey := 0;
  931.     txwindow(10, 'Could not start: cancelled.'); {Chd 3.01}
  932.     dump; {purge;}
  933.     GOTO Exit_send_wcp;
  934.  
  935. TransMit:                         {let's send the file!}
  936.     awindow := twindow;
  937.     errors := 0;
  938.     {Xmodem packet level loop}
  939.  
  940.     WHILE (ackblks < tblks) AND (errors <= MAXERRS) DO
  941.       BEGIN
  942.         i := 0;
  943.         WHILE (sblks-ackblks) > awindow DO {is the ack window open?}
  944.           BEGIN {no, so wait for ack/nak}
  945.             INC(i);
  946.             IF i <= 1 THEN
  947.              BEGIN
  948.               Str((awindow+1):1, statstr);
  949.               txwindow(9, Concat(statstr, ' Closed.')); {Chd 3.01}
  950.              END;
  951.             checkack(50);     {50*2400 = 120 seconds +}
  952.             IF canflag THEN GOTO Exit_send_wcp;
  953.             IF KeyPressed THEN
  954.              BEGIN
  955.               UserKey := ORD(ReadKey);
  956.               IF UserKey = CAN THEN GOTO Exit_send_wcp;
  957.              END;
  958.             IF i > 2400 THEN
  959.               BEGIN
  960.                 txwindow(11, 'Timeout for ack.'); {Chd 3.01}
  961.                 sblks := ackblks+1;
  962.                 IF sblks > tblks THEN GOTO Exit_send_wcp;
  963.               END;
  964.             IF (sblks-ackblks) <= awindow THEN
  965.               BEGIN
  966.                 Str((awindow+1):1, statstr);
  967.                 txwindow(9, statstr);
  968.               END;
  969.           END;{window closed}
  970.  
  971.         IF sblks < tblks THEN {is there anything left?}
  972.           BEGIN
  973.             awindow := twindow; {ack window is transmit window}
  974.             {disk read routine}
  975.             INC(sblks);
  976.             xblk := sblks;
  977.             WHILE (xblk > rblks) OR (xblk <= (rblks-bufnum)) DO
  978.               BEGIN
  979.                 IF xblk < (rblks-bufnum) THEN {if we got nak'd back}
  980.                   BEGIN
  981.                     Seek(blkfile, (xblk-1));
  982.                   END;
  983.                 BlockRead(blkfile, dbuffer, bufnum, bresult);
  984.                 rblks := xblk+bufnum-1; {note rblks must go past eof}
  985.               END; {end of disk read routine}
  986.  
  987.             j := bufnum-rblks+xblk; {index of next packet}
  988.  
  989.             crcval := 0;
  990.             checksum := 0;
  991.             Str(xblk:4, statstr);
  992.             txwindow(5, statstr);
  993.             IF wxmode THEN
  994.              BEGIN
  995.               WHILE xpause DO
  996.                BEGIN
  997.                 checkack(15);
  998.                 xpause := False;
  999.                 txwindow(8, 'No');
  1000.                END;
  1001.               send(SYN);
  1002.              END;
  1003.             dlesend(SOH);
  1004.             dlesend(xblk AND 255); {block sequence}
  1005.             dlesend((xblk AND 255) XOR 255); {complement sequence}
  1006.  
  1007. {---------- Send Loop  3.09 Major Rewrite ----------}
  1008.             i := 1; {3.09}
  1009.             REPEAT
  1010.               c := dbuffer[j,i];
  1011.               IF crcmode THEN
  1012.                crcval := Crctab[hi(crcval) XOR c] XOR (lo(crcval) SHL 8)
  1013.               ELSE
  1014.                checksum := (checksum+c) AND 255;
  1015.               dlesend(c);
  1016.              INC(i);
  1017.             UNTIL i > 128;
  1018. {---------- End Send Loop --------------------------}
  1019.  
  1020.             IF crcmode THEN        { here we send the CRC or checksum }
  1021.              BEGIN
  1022.               dlesend(Hi(crcval)); dlesend(Lo(crcval));
  1023.              END
  1024.             ELSE
  1025.              send(checksum);
  1026.             IF canflag THEN GOTO Exit_send_wcp;
  1027.             {writeln(trfile,'SENT ',sblks:5,xblk:5);}
  1028.           END {something to send}
  1029.         ELSE
  1030.           BEGIN {nothing else to send}
  1031.            IF wxmode THEN
  1032.             BEGIN
  1033.              awindow := sblks-ackblks-1; {wait for final acks}
  1034.              Str(awindow:1, statstr);
  1035.              txwindow(9, Concat(statstr, ' -- Closing'));
  1036.             END;
  1037.           END;
  1038.       END;{xmodem send routine}
  1039.  
  1040.     REPEAT {end of transmission}
  1041.       send(EOT);
  1042.       UserKey := 0;
  1043.       REPEAT
  1044.        c := cgetc(15);
  1045.        IF keypressed THEN UserKey := ORD(ReadKey);
  1046.       UNTIL (c <> -1) OR (UserKey = CAN);
  1047.  
  1048.       IF UserKey = CAN THEN GOTO Exit_send_wcp;
  1049.       IF c = NAK THEN
  1050.        BEGIN
  1051.         INC(errors);
  1052.         Delay(250);
  1053.        END;
  1054.     UNTIL (c = ACK) OR (errors = MAXERRS);
  1055.     IF errors = MAXERRS THEN
  1056.       txwindow(11, 'ACK not received at EOT.'); {Chd 3.01}
  1057.  
  1058. Exit_send_wcp: 
  1059.  
  1060.     { close(trfile);}
  1061.     IF openflag THEN
  1062.       BEGIN
  1063.         {$I-} Close(blkfile); {$I+}
  1064.         i := IOResult;
  1065.       END;
  1066.     IF ((UserKey = CAN) OR canflag) AND (Length(fname) > 0) THEN
  1067.       BEGIN
  1068.         txwindow(11, 'Send Canceled...'); {Chd 3.01}
  1069.         REPEAT                 {3.09}
  1070.          FOR i := 1 TO 6 DO send(CAN);
  1071.          Dump; {Purge;}
  1072.         UNTIL (cgetc(1) = -1); {3.04}
  1073.       END;
  1074.     Txwindow(99,' '); {Clear Tx window 3.08}
  1075.     StatusLine; {3.08}
  1076. Exit_send:
  1077.     dbits := db;
  1078.     parity := p;
  1079.     stop_bits := sb;
  1080.     {update_uart;}
  1081.   END;{send_wcp}
  1082.  
  1083.