home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / PROTOCOL / WXTRM305.ZIP / WXTMXFER.INC < prev   
Text File  |  1991-08-12  |  41KB  |  1,110 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.   crcval, db, sb : Integer;
  91.   packetln : Integer;         {128 + Checksum or 128 + CRC}
  92.   p : parity_set;
  93.   dbuffer : ARRAY[1..Bufnum, 1..BufLen] OF Byte;
  94.   dcount : Integer;
  95.   Wxmode,Crcmode,Openflag : Boolean;
  96.  
  97. (* -----------------------     now called directly used twice 3.04
  98.   PROCEDURE updcrc(a:Byte);
  99.   BEGIN
  100.     crcval := Crctab[hi(crcval) xor a] xor (lo(crcval) shl 8);
  101.   END;
  102.  ------------------------- *)
  103.  
  104.  
  105.   {$R-,S-}
  106.   FUNCTION cgetc(TimeLimit: Integer): Integer;
  107.     {if a byte is recieved at COM1/COM2: in less than TimeLimit seconds,
  108.     returns byte as an integer, else returns 0}
  109.  
  110.   BEGIN
  111.     TimeLimit := TimeLimit SHL 10; {convert TimeLimit to millisecs}
  112.     WHILE (Buffer_Count < 1) AND (TimeLimit > 0) DO
  113.       BEGIN
  114.         Delay(1); DEC(TimeLimit);
  115.       END;
  116.     IF ( (TimeLimit >= 0) AND (Buffer_Count > 0) ) THEN
  117.       BEGIN
  118.        INLINE($FA); {suspend interrupts}
  119.        cgetc := Recv_Buffer[buffer_Tail];
  120.        IF Buffer_Tail < Buffer_End THEN { 3.04 safer this way }
  121.         INC(Buffer_Tail)
  122.        ELSE
  123.         Buffer_Tail := 1;
  124.        DEC(Buffer_Count); 
  125.        INLINE($FB); {resume interrupts}
  126.       END
  127.     ELSE
  128.      cgetc := -1;
  129.   END;
  130.  
  131.   { Xmodem transmit window routine
  132.   Peter Boswell, July 1986       }
  133.  
  134.   PROCEDURE txwindow(opt:Integer; in_string:bigstring);
  135.   BEGIN
  136.    IF opt > 1 THEN INC(opt);   { adjust new window 3.04 }
  137.     CASE opt OF
  138.       1 : BEGIN               {initialize}
  139.             DoBorder(36,3,78,18);
  140.             GoToXY(10,2);
  141.             Write('File - ', in_string);
  142.             GoToXY(10,3);
  143.             Write('Mode -');
  144.             GoToXY(4,4);
  145.             Write('Total time -');
  146.             GoToXY(2,5);
  147.             Write('Total Blocks -');
  148.             GoToXY(10,6);
  149.             Write('Sent -');
  150.             GoToXY(9,7);
  151.             Write('ACK''d -');
  152.             GoToXY(6,8);
  153.             Write('Last NAK -');
  154.             GoToXY(9,9);
  155.             Write('X-Off - No');
  156.             GoToXY(8,10);
  157.             Write('Window - 0');
  158.             GoToXY(4,12);
  159.             Write('Last Error -');
  160.             GoToXY(8,11);
  161.             Write('Errors -');
  162.           END;
  163.       3..12 : BEGIN {3.04}
  164.                GoToXY(17,opt);
  165.                {ClrEol;}
  166.                Write(in_string);
  167.               END;
  168.       13 : BEGIN{3.04}
  169.             GoToXY(3, 13);
  170.             {ClrEol;}
  171.             Write(in_string);
  172.            END;
  173.      100 : BEGIN ClrScr; Window(1,1,80,24); END;
  174.     END; {case}
  175.   END;
  176.  
  177.   { Xmodem receive window routine
  178.   Peter Boswell, October 1986       }
  179.  
  180.   PROCEDURE trwindow(opt:Integer; in_string:bigstring);
  181.   BEGIN
  182.    IF opt > 1 THEN INC(opt); {3.04}
  183.     CASE opt OF
  184.       1 : BEGIN {initialize}
  185.             DoBorder(36,3,78,13);
  186.             GoToXY(10, 2);
  187.             Write('File - ', in_string);
  188.             GoToXY(10, 3);
  189.             Write('Mode -');
  190.             GoToXY(6, 4);
  191.             Write('Received -');
  192.             GoToXY(6, 5);
  193.             Write('Last NAK -');
  194.             GoToXY(4, 6);
  195.             Write('Last Error -');
  196.             GoToXY(8, 7);
  197.             Write('Errors -');
  198.           END;
  199.       3..7 : BEGIN
  200.                GoToXY(17, opt);
  201.                {ClrEol;}
  202.                Write(in_string);
  203.              END;
  204.       9 : BEGIN
  205.            GoToXY(3,9);
  206.            {ClrEol;}
  207.            Write(in_string);
  208.           END;
  209.       100 : BEGIN ClrScr; Window(1,1,80,24); END;
  210.     END;{case}
  211.   END;
  212.  
  213.   { This routine deletes all DLE characters and XOR's the following character
  214.   with 64.  If a SYN character is found then -2 is returned. }
  215.  
  216.   FUNCTION dlecgetc(Tlimit:Integer):Integer;
  217.   VAR savecgetc : Integer;
  218.   BEGIN
  219.    IF wxmode THEN
  220.     BEGIN
  221.      savecgetc := cgetc(Tlimit);
  222.      IF savecgetc = SYN THEN
  223.       savecgetc := -2
  224.      ELSE
  225.       IF savecgetc = DLE THEN
  226.        BEGIN
  227.         savecgetc := cgetc(Tlimit);
  228.         IF savecgetc >= 0 THEN savecgetc := savecgetc XOR 64;
  229.        END;
  230.      dlecgetc := savecgetc;
  231.     END
  232.    ELSE
  233.     dlecgetc := cgetc(Tlimit);
  234.   END;
  235.  
  236.  
  237.   PROCEDURE purge;
  238.   BEGIN
  239.     WHILE dlecgetc(1) >= 0 DO{NOP};
  240.   END;
  241.  
  242.   PROCEDURE SaveCommStatus;
  243.   BEGIN
  244.     p := parity;
  245.     db := dbits;
  246.     sb := stop_bits;
  247.     dbits := 8;
  248.     parity := none;
  249.     stop_bits := 1;
  250.     {update_uart;}
  251.   END;
  252.  
  253.   PROCEDURE recv_wcp; {receive using Ward Christensen's checksum protocol}
  254.   LABEL Exit_recv_wcp;  {3.04}
  255.   VAR
  256.     j, firstchar, sectnum, sectcurr, prevchar, lignore, blkcnt,
  257.      toterr, errors, sectcomp, bufcurr, bresult : Integer;
  258.     Xtrace, EotFlag, ErrorFlag, Extend : Boolean;
  259.     UserKey : Byte;
  260.     blkfile : FILE;
  261.     statstr : bigstring;
  262.     trfile : Text;
  263.   BEGIN
  264.     Gotoxy(2,1); Write('RECV XMODEM');
  265.     ErrorFlag := True;
  266.     EotFlag := False;
  267.     Xtrace := False;
  268.     Openflag := False;
  269.     Bufcurr := 1;
  270.     SaveCommStatus;
  271.     WHILE ErrorFlag DO
  272.       BEGIN
  273.         DoBorder(1,3,80,8);
  274.         REPEAT
  275.           GotoXy(3,2);
  276.           Write('Enter download filename or <cr> abort:'); {Chd 3.01}
  277.           ReadLn(fname);
  278.           supcase(fname);
  279.           IF Length(fname) > 0 THEN
  280.             IF exists(fname) THEN
  281.               BEGIN
  282.                 Gotoxy(3,4); 
  283.                 Write(fname,' Exists. OK to overwrite it(Y/N)?');
  284.                 REPEAT
  285.                  response := Upcase(ReadKey);
  286.                 UNTIL (response = 'Y') OR (response = 'N');
  287.                 IF response = 'Y' THEN ErrorFlag := False;
  288.               END
  289.             ELSE ErrorFlag := False
  290.         UNTIL (NOT ErrorFlag) OR (Length(fname) = 0);
  291.  
  292.         BEGIN ClrScr; Window(1,1,80,24); END;
  293.         IF Length(fname) > 0 THEN
  294.           BEGIN
  295.             Assign(blkfile, fname);
  296.             {$I-} Rewrite(blkfile); {$I+}
  297.             ErrorFlag := (IOResult <> 0);
  298.             IF ErrorFlag THEN
  299.              BEGIN
  300.               WriteLn(#13, #10, 'WXTERM --- cannot open file.'); {Chd 3.01}
  301.               GOTO Exit_recv_wcp; {3.04}
  302.              END
  303.             ELSE
  304.              openflag := True;
  305.           END;
  306.         IF Length(fname) = 0 THEN
  307.           BEGIN
  308.             WriteLn(#13, #10, 'WXTERM --- user aborted receive.'); {Chd 3.01}
  309.             GOTO Exit_recv_wcp; {3.04}
  310.           END;
  311.       END;                    {while}
  312.     trwindow(1,fname);
  313.     blkcnt := 0;
  314.     sectnum := 0;
  315.     errors := 0;
  316.     toterr := 0;
  317.     {assign(trfile,'trace');}
  318.     {rewrite(trfile);}
  319.     Crcmode := True;          {Assume CRC versus Checksum}
  320.     Packetln := 130;          {128 byte data + 2 byte CRC}
  321.     Wxmode := True;           {Assume Wxmodem}
  322.     Lignore := 0;             {ignore packets after error}
  323.     i := 0;                   {Try for Wxmodem 3 times}
  324.     dump; {purge;}
  325.     trwindow(8, 'Trying Wxmodem.'); {Chd 3.01}
  326.     REPEAT
  327.       send(ORD('W'));
  328.       firstchar := cgetc(12); {12 seconds each}
  329.       IF Keypressed THEN
  330.        BEGIN
  331.         userkey := ORD(readkey);       
  332.         IF UserKey = CAN THEN GOTO Exit_recv_wcp; {3.04}
  333.        END;
  334.       INC(i);
  335.     UNTIL (firstchar = SYN) OR (firstchar = CAN) OR (i = 3);
  336.     IF firstchar = CAN THEN GOTO Exit_recv_wcp; {3.04}
  337.     IF firstchar <> SYN THEN
  338.       BEGIN
  339.         Wxmode := False;
  340.         i := 0;               {Try CRC xmodem 3 times}
  341.         trwindow(8, 'Trying CRC Xmodem.'); {Chd 3.01}
  342.         REPEAT
  343.           send(ORD('C'));
  344.           firstchar := cgetc(4);             {4 seconds each}
  345.           IF Keypressed THEN
  346.            BEGIN
  347.             UserKey := ORD(readkey);
  348.             IF UserKey = CAN THEN GOTO  Exit_recv_wcp; {3.04}
  349.            END;
  350.           INC(i);
  351.         UNTIL (firstchar = SOH) OR (firstchar = CAN) OR (i = 3);
  352.         IF firstchar = CAN THEN GOTO  Exit_recv_wcp; {3.04}
  353.         IF firstchar <> SOH THEN
  354.           BEGIN
  355.             Crcmode := False;
  356.             Packetln := 129;  {128 bytes + 1 byte Checksum}
  357.             i := 0;           {Try Checksum xmodem 4 times}
  358.             trwindow(5, 'Trying Checksum Xmodem.'); {Chd 3.01}
  359.             REPEAT
  360.               send(NAK);
  361.               firstchar := cgetc(10); {10 seconds each}
  362.               IF KeyPressed THEN
  363.                BEGIN
  364.                 UserKey := ORD(readkey);
  365.                 IF UserKey = CAN THEN GOTO Exit_recv_wcp; {3.04}
  366.                END;
  367.               INC(i);
  368.             UNTIL (firstchar = SOH) OR (firstchar = CAN) OR (i = 4);
  369.           END;                {Checksum}
  370.       END;                    {CRC}
  371.     IF wxmode THEN
  372.       BEGIN
  373.         trwindow(2, 'WXmodem.    '); {Chd 3.01}
  374.       END;
  375.     IF NOT wxmode AND crcmode THEN
  376.       BEGIN
  377.         trwindow(2, 'CRC Xmodem. '); {Chd 3.01}
  378.       END;
  379.     IF NOT wxmode AND NOT crcmode THEN
  380.       BEGIN
  381.         trwindow(2, 'CSUM Xmodem.'); {Chd 3.04}
  382.       END;
  383.     trwindow(8, 'Press ^X to quit');
  384.  
  385.     { firstchar contains the first character and Wxmode and Crcmode
  386.     indicate the type of Xmodem }
  387.  
  388.     prevchar := firstchar;    {save the firstchar}
  389.     WHILE (EotFlag = False) AND (Errors < MAXERRS) DO {3.04}
  390.       BEGIN                   {locate start of packet}
  391.         IF (firstchar = SOH) AND
  392.         ( (Wxmode AND (prevchar = SYN)) OR (NOT Wxmode) ) THEN
  393.           BEGIN {process packet}
  394.             prevchar := -1;
  395.             firstchar := -1;
  396.             sectcurr := dlecgetc(15);
  397.             { writeln(trfile,'sectcurr=',sectcurr:4);}
  398.             sectcomp := dlecgetc(15);
  399.             IF sectcurr = (sectcomp XOR 255) THEN
  400.               BEGIN           {sequence versus compl good}
  401.                 IF sectcurr = ((sectnum+1) AND 255) THEN
  402.                   BEGIN       {in sequence}
  403.                     crcval := 0;
  404.                     checksum := 0;
  405.                     j := 1;
  406.                     REPEAT
  407.                       firstchar := dlecgetc(15);
  408.                       IF firstchar >= 0 THEN
  409.                         BEGIN
  410.                           IF j < 129 THEN
  411.                             dbuffer[bufcurr, j] := firstchar;
  412.                           IF Crcmode THEN
  413.                            {updcrc(firstchar)} {3.04}
  414.               crcval := Crctab[hi(crcval) xor firstchar] xor (lo(crcval) shl 8)
  415.                           ELSE
  416.                            checksum := (checksum AND 255)+firstchar;
  417.                           INC(j);
  418.                         END;
  419.                     UNTIL (j > Packetln) OR (firstchar < 0);
  420.                     IF j > Packetln THEN {good packet length}
  421.                       BEGIN
  422.                         IF (Crcmode AND (crcval = 0) OR
  423.                         (NOT Crcmode AND ((checksum SHR 1) = firstchar)))
  424.                         THEN
  425.                           BEGIN {good crc/checksum}
  426.                             firstchar := -1; {make sure this byte not used
  427.                             for start of packet } errors := 0;
  428.                             sectnum := sectcurr;
  429.                             INC(blkcnt);
  430.                             send(ACK);
  431.                             IF Wxmode THEN send(sectcurr AND 3);
  432.                           { write(trfile,' ACK ');}
  433.                           { if Wxmode then write(trfile,(sectcurr and 3):1);}
  434.                             Str(blkcnt:4, statstr);
  435.                             trwindow(3, statstr);
  436.                             IF errors <> 0 THEN
  437.                               BEGIN
  438.                                 errors := 0;
  439.                                 trwindow(6, '0');
  440.                                 trwindow(5, ' ');
  441.                               END;
  442.                             INC(bufcurr);
  443.                             IF bufcurr > bufnum THEN
  444.                               BEGIN                     {Disk write routine}
  445.                                 bufcurr := 1;
  446.                              (* --------------------------
  447.                                 IF wxmode AND pcjrmode THEN
  448.                                   BEGIN {can't overlap disk i/o and comm i/o.}
  449.                                     send(XOFF);         {stop transmitter}
  450.                                     Delay(250);         {give it a chance}
  451.                                   END;
  452.                               ----------------------------- *)
  453.                                 BlockWrite(blkfile, dbuffer, bufnum, bresult);
  454.                               (* -------------------------
  455.                                 IF wxmode AND pcjrmode THEN
  456.                                   BEGIN
  457.                                     {Flush(blkfile);} {complete all i/o}
  458.                                     send(XON);      {restart transmitter}
  459.                                   END;
  460.                                --------------------------- *)
  461.                                 IF bresult <> bufnum THEN
  462.                                   BEGIN
  463.                                     trwindow(8, 'Disk write error');
  464.                                     GOTO  Exit_recv_wcp; {3.04}
  465.                                   END;
  466.                               END; {End of disk write routine}
  467.                           END {good crc/checksum}
  468.                         ELSE
  469.                           BEGIN {bad crc/checksum}
  470.                             trwindow(5, 'CRC/Checksum error');
  471.                             Str((blkcnt+1):6, statstr);
  472.                             trwindow(4, statstr);
  473.                             errors := errors+1;
  474.                             Str(errors:3, statstr);
  475.                             trwindow(6, statstr);
  476.                             toterr := toterr+1;
  477.                             Dump; {purge;} {clear any garbage coming in}
  478.                             send(NAK);
  479.                             IF wxmode THEN
  480.                               BEGIN
  481.                                send(sectcurr AND 3);
  482.                                lignore := maxwindow;
  483.                               END;
  484.                             {write(trfile,' NAK CRC ',(sectcurr and 3):1);}
  485.                           END; {bad crc/checsum}
  486.                       END     {good packet length}
  487.                     ELSE
  488.                       BEGIN   {bad packet length}
  489.                         trwindow(5, 'Short block error.'); {Chd 3.01}
  490.                         Str((blkcnt+1):6, statstr);
  491.                         trwindow(4, statstr);
  492.                         errors := errors+1;
  493.                         Str(errors:3, statstr);
  494.                         trwindow(6, statstr);
  495.                         INC(toterr);
  496.                         Dump; {purge;} {clear any garbage}
  497.                         send(NAK);
  498.                         IF wxmode THEN
  499.                          BEGIN
  500.                           send(sectcurr AND 3);
  501.                           lignore := maxwindow;
  502.                          END;
  503.                         dump; {purge;} {clear any garbage}
  504.                         {write(trfile,' NAK SHORT ',(sectcurr and 3):1);}
  505.                       END; {bad packet length}
  506.                   END {good block sequence number}
  507.                 ELSE
  508.                   BEGIN {invalid sequence number}
  509.                     IF lignore <= 0 THEN {are we ignoring packets?}
  510.                       BEGIN
  511.                         trwindow(5, 'Out of sequence.'); {Chd 3.01}
  512.                         Str((blkcnt+1):6, statstr);
  513.                         trwindow(4, statstr);
  514.                         INC(errors);
  515.                         Str(errors:3, statstr);
  516.                         trwindow(6, statstr);
  517.                         INC(toterr);
  518.                         dump; {purge;} {clear any garbage coming in}
  519.                         send(NAK);
  520.                         IF wxmode THEN
  521.                          BEGIN
  522.                           send((sectnum+1) AND 3);
  523.                           lignore := Maxwindow;
  524.                          END;
  525.                         dump; {purge;} {clear any garbage coming in}
  526.                         {write(trfile,' NAK SEQ ',((sectnum+1) and 3):1);}
  527.                       END
  528.                     ELSE
  529.                      DEC(lignore); {3.04}
  530.                   END; {invalid sequence number}
  531.               END {valid complement}
  532.             ELSE
  533.               BEGIN {invalid complement}
  534.                 trwindow(5, 'Sequence complement error.'); {Chd 3.01}
  535.                 Str((blkcnt+1):6, statstr);
  536.                 trwindow(4, statstr);
  537.                 INC(errors);
  538.                 Str(errors:3, statstr);
  539.                 trwindow(6, statstr);
  540.                 INC(toterr);
  541.                 dump; {purge;}        {clear any garbage comming in}
  542.                 send(NAK);
  543.                 IF wxmode THEN
  544.                  BEGIN
  545.                   send((sectnum+1) AND 3);
  546.                   lignore := Maxwindow;
  547.                  END;
  548.                 dump; {purge;}        {clear any garbage comming in}
  549.                 {write(trfile,' NAK CMP ',((sectnum + 1) and 3):1);}
  550.               END;{invalid complement}
  551.           END {process packet}
  552.         ELSE {not start of packet}
  553.           BEGIN
  554.             CASE prevchar OF
  555.               EOT : BEGIN
  556.                      IF firstchar = EOT THEN
  557.                       BEGIN
  558.                        EotFlag := True;
  559.                        send(ACK);
  560.                       END;
  561.                     END;
  562.               CAN : BEGIN
  563.                      IF firstchar = CAN THEN
  564.                       GOTO Exit_recv_wcp; {3.04}
  565.                     END;
  566.             END;{Of case}
  567.             IF NOT EotFlag THEN
  568.               BEGIN
  569.                 IF firstchar = EOT THEN
  570.                   BEGIN
  571.                     send(NAK); {first EOT received}
  572.                     trwindow(5, ' First EOT received.'); {Chd 3.01}
  573.                   END;
  574.                 prevchar := firstchar;
  575.                 firstchar := cgetc(15); {start of packet!!!!}
  576.                 IF firstchar = -1 THEN
  577.                   BEGIN
  578.                     IF (prevchar = CAN) OR (prevchar = EOT) THEN
  579.                       firstchar := prevchar {assume two have been received}
  580.                     ELSE
  581.                       BEGIN
  582.                         trwindow(5, 'Timeout on start of packet.'); {Chd 3.01}
  583.                         Str((blkcnt+1):6, statstr);
  584.                         trwindow(4, statstr);
  585.                         INC(errors);
  586.                         Str(errors:3, statstr);
  587.                         trwindow(6, statstr);
  588.                         send(XON);
  589.                         INC(toterr);
  590.                         send(NAK);
  591.                         IF wxmode THEN
  592.                          BEGIN
  593.                           send((sectnum+1) AND 3);
  594.                           lignore := Maxwindow;
  595.                          END;
  596.                         { write(trfile,' NAK TIM ',((sectnum+1) and 3):1);}
  597.                       END;
  598.                   END; {Timeout at start of packet}
  599.                 IF KeyPressed THEN
  600.                  BEGIN
  601.                   UserKey := ORD(ReadKey);
  602.                   IF UserKey = CAN THEN GOTO Exit_recv_wcp; {3.04}
  603.                  END;
  604.               END;{end of not EotFlag}
  605.           END;{not start of packet}
  606.       END;{xmodem loop}
  607.  
  608.     {If there are any xmodem packets left in dbuffer, we had best
  609.     write them out}
  610.  
  611.     IF EotFlag AND (bufcurr > 1) THEN
  612.       BEGIN
  613.        DEC(bufcurr);           { 3.04 }
  614.        trwindow(8, 'Writing final blocks.'); {Chd 3.01}
  615.       (* -------------------------
  616.         IF wxmode AND pcjrmode THEN
  617.           BEGIN               {if unable to overlap
  618.                               disk i/o and comm i/o.}
  619.             send(XOFF);       {stop transmitter}
  620.             Delay(250);       {give it a chance}
  621.           END;
  622.        --------------------------- *)
  623.         BlockWrite(Blkfile, dbuffer, bufcurr, bresult);
  624.     (* ----------------------------
  625.         IF wxmode AND pcjrmode THEN
  626.           BEGIN
  627.             {Flush(blkfile);}   {complete all i/o}
  628.             send(XON);        {restart transmitter}
  629.           END;
  630.       ----------------------------- *)
  631.         IF bufcurr <> bresult THEN
  632.          BEGIN
  633.           trwindow(8, 'Disk write error at end of receive.'); {Chd 3.01}
  634.           EotFlag := False; {no longer a 'real' eot}
  635.          END;
  636.       END;
  637.  
  638.  Exit_recv_wcp:                      { exit routine }
  639.  
  640.     IF NOT Eotflag THEN
  641.       BEGIN
  642.         IF errors >= Maxerrs THEN
  643.          trwindow(8, 'Maximum errors exceeded.') {Chd 3.01}
  644.         ELSE
  645.          IF UserKey = CAN THEN
  646.           BEGIN
  647.            trwindow(5, '^X entered.'); {Chd 3.01}
  648.            REPEAT                 {3.04}
  649.             FOR i := 1 TO 6 DO send(CAN); {3.04a}
  650.             Purge;                {3.04a}
  651.            UNTIL (cgetc(1) = -1); {3.04}
  652.           END;
  653.         IF firstchar = CAN THEN
  654.           trwindow(5, 'Cancel received.'); {Chd 3.01}
  655.         IF openflag THEN
  656.          BEGIN
  657.           {$I-} Close(blkfile) {$I+} ;
  658.           i := IOResult;    {clear ioresult}
  659.           {$I-} Erase(blkfile); {$I+}
  660.           i := IOResult;    {clear ioresult}
  661.          END;
  662.       END;
  663.     trwindow(8, 'Press any key to continue.');
  664.     REPEAT UNTIL KeyPressed;
  665.     trwindow(8, '                          '); {Added 3.01}
  666.     junk := ReadKey;
  667.     trwindow(99,'  ');
  668.  
  669.     ClrScr;                { clear the transfer window }
  670.     Window(1,25,80,25);
  671.     Gotoxy(19,1);
  672.     IF carrier THEN
  673.      Write('On-Line/Ready ')
  674.     ELSE
  675.      Write('Off-Line/Ready');
  676.     Window(1,1,80,24);
  677.  
  678.     dbits := db;
  679.     parity := p;
  680.     stop_bits := sb;
  681.     {close(trfile);}
  682.     {update_uart;}
  683.   END;{recv_wcp}
  684.  
  685.  
  686.   PROCEDURE send_wcp;
  687.   LABEL Exit_send_wcp,TransMit; {3.04}
  688.   VAR
  689.     UserKey : Byte;
  690.     c, i, j, sectnum, errors : Integer;
  691.     tblks, sblks, ackblks, rblks : Integer; {total, sent, ack'd blocks}
  692.     twindow, awindow : Integer; {transmission window}
  693.     bresult, nblks, prevchar : Integer;
  694.     bflag, canflag, xpause : Boolean;
  695.     extend : Boolean;
  696.     blkfile : FILE;
  697.     statstr : bigstring;
  698.     xblk, ackseq : Integer;
  699.     trfile : Text;
  700.  
  701.     PROCEDURE checkack(tlimit : Integer);
  702.     VAR inchar : Integer;
  703.     BEGIN
  704.       REPEAT {until no more data & timelimit}
  705.         inchar := cgetc(0);
  706.         IF inchar <> -1 THEN
  707.           BEGIN               {got a character}
  708.             IF wxmode THEN    {wxmodem}
  709.               BEGIN
  710.                 {write(trfile,inchar:4);}
  711.                 CASE inchar OF
  712.                   XOFF : BEGIN
  713.                           xpause := True;
  714.                           txwindow(8, 'Received - waiting.'); {Chd 3.01}
  715.                          END;
  716.                   XON : BEGIN
  717.                          xpause := False;
  718.                          txwindow(8, 'No');
  719.                         END;
  720.                   ACK, NAK, CAN : prevchar := inchar; {save ACK/NAK/CAN}
  721.                   0..3 : BEGIN {valid ACK/NAK sequence number}
  722.                            CASE prevchar OF
  723.                              ACK : BEGIN
  724.                                      ackseq := inchar-(ackblks AND twindow);
  725.                                      IF ackseq <= 0 THEN
  726.                                        ackseq := ackseq+maxwindow;
  727.                                      nblks := ackblks+ackseq;
  728.                                      IF nblks <= sblks THEN
  729.                                        BEGIN
  730.                                          ackblks := nblks;
  731.                                          Str(ackblks:4, statstr);
  732.                                          txwindow(6, statstr);
  733.                                          IF errors <> 0 THEN
  734.                                           BEGIN
  735.                                            errors := 0;
  736.                                            txwindow(10, '0');
  737.                                           END;
  738.                                        END;
  739.                                      { writeln(trfile,' ACK ',inchar:2,ackblks:5);}
  740.                                      prevchar := -1;
  741.                                    END; {case ACK}
  742.                              NAK : BEGIN
  743.                                      ackseq := inchar-(ackblks AND twindow);
  744.                                      IF ackseq <= 0 THEN
  745.                                        ackseq := ackseq+maxwindow;
  746.                                      nblks := ackblks+ackseq;
  747.                                      IF nblks <= sblks THEN
  748.                                        BEGIN
  749.                                          sblks := nblks-1;
  750.                                          IF (sblks-ackblks) <= 2 THEN
  751.                                            ackblks := sblks;
  752.                                          Str(nblks:4, statstr);
  753.                                          txwindow(7, statstr);
  754.                                          Str(sblks:4, statstr);
  755.                                          txwindow(5, statstr);
  756.                                          INC(errors);
  757.                                          Str(errors:3, statstr);
  758.                                          txwindow(10, statstr);
  759.                                        END
  760.                                      ELSE
  761.                                        BEGIN
  762.                                          GoToXY(3, 12);
  763.                                          {ClrEol;}
  764.                                          WriteLn('Invalid NAK seq ', nblks:4, ackseq:4, inchar:3);
  765.                                        END;
  766.                                      {writeln(0tile,' NAK ',inchar:2,ackblks:5,sblks:5);}
  767.                                      prevchar := -1;
  768.                                    END; {case NAK}
  769.                              CAN : BEGIN
  770.                                      IF inchar = CAN THEN canflag := True;
  771.                                    END;
  772.                            END; {of case prevchar}
  773.                          END; {case 0..3}
  774.                 ELSE{of case inchar}
  775.                   prevchar := -1; {inchar not XON/XOFF/ACK/NAK/CAN/0/1/2/3}
  776.                 END;{of case inchar}
  777.               END{wxmodem mode}
  778.             ELSE
  779.               BEGIN {regular xmodem}
  780.                 CASE inchar OF
  781.                   ACK : BEGIN
  782.                          ackblks := ackblks+1;
  783.                          errors := 0;
  784.                         END;
  785.                   NAK : BEGIN
  786.                          DEC(sblks);  {3.04}
  787.                          INC(errors); {3.04}
  788.                         END;
  789.                   CAN : BEGIN
  790.                          IF prevchar = CAN THEN canflag := True;
  791.                          prevchar := CAN;
  792.                         END;
  793.                 ELSE prevchar := inchar;
  794.                 END; {end of case inchar}
  795.               END; {regular xmodem}
  796.           END {end of got a character}
  797.         ELSE {no incoming data, inchar=-1}
  798.           BEGIN
  799.             IF tlimit > 0 THEN
  800.              BEGIN
  801.               Delay(1);
  802.               DEC(tlimit); {3.04}
  803.              END;
  804.           END; {end no incoming data}
  805.         IF KeyPressed THEN
  806.          BEGIN
  807.           UserKey := ORD(ReadKey);
  808.           IF UserKey = CAN THEN
  809.            BEGIN
  810.             canflag := True;
  811.             tlimit := 0;  {force end of repeat}
  812.             inchar := -1; { "    "   "  "     }
  813.             xpause := False;
  814.             dump; {purge;}
  815.            END;
  816.          END;                {end of keypressed}
  817.       UNTIL (tlimit <= 0) AND (inchar = -1); {repeat until nothing left}
  818.     END; {of procedure checkack}
  819.  
  820.     PROCEDURE dlesend(c : Integer);
  821.     VAR j : Integer;
  822.     BEGIN
  823.       IF wxmode THEN
  824.         BEGIN
  825.           IF Buffer_Count > 0 THEN {if there is any incoming data}
  826.             checkack(0);
  827.           WHILE xpause DO     {X-Off received .. better wait}
  828.             BEGIN
  829.               j := 0;
  830.               REPEAT
  831.                 checkack(0);
  832.                 INC(j);
  833.                 Delay(1);
  834.               UNTIL ((xpause = False) OR (j = 10000));
  835.               IF xpause THEN  {but not forever}
  836.                BEGIN
  837.                 txwindow(8, 'No - Timed Out.'); {Chd 3.01}
  838.                 xpause := False;
  839.                END;
  840.             END;
  841.           CASE c OF
  842.             SYN, XON, XOFF, DLE : BEGIN
  843.                                     send(DLE);
  844.                                     send(c XOR 64);
  845.                                   END;
  846.           ELSE send(c);
  847.           END;{case}
  848.         END
  849.       ELSE send(c); {regular xmodem}
  850.     END;
  851.  
  852.  
  853.   BEGIN
  854.     Gotoxy(3,2); Write('SEND WXMODEM');
  855.     SaveCommStatus;
  856.     openflag := False;
  857.     {assign(trfile,'trace');}
  858.     {rewrite(trfile);}
  859.     DoBorder(1,3,80,8);
  860.  
  861.     REPEAT
  862.       Gotoxy(3,2);
  863.       Write('Enter upload filename <cr> to abort:'); {Chd 3.04}
  864.       ReadLn(fname);
  865.       supcase(fname);
  866.       IF Length(fname) > 0 THEN
  867.        BEGIN
  868.         bflag := exists(fname);
  869.         IF NOT bflag THEN
  870.          BEGIN
  871.           Gotoxy(3,4);
  872.           Write('Could not open file: ', fname); {Chd 3.01}
  873.           Gotoxy(3,5);
  874.           Write('(Spelling or drive designation wrong?)');
  875.          END;
  876.        END;
  877.     UNTIL bflag OR (Length(fname) = 0);
  878.  
  879.     BEGIN ClrScr; Window(1,1,80,24); END;
  880.     IF Length(fname) = 0 THEN GOTO Exit_send_wcp;  
  881.     Assign(Blkfile, fname);
  882.     {$I-} Reset(Blkfile); {$I+}
  883.     IF IOResult <> 0 THEN GOTO Exit_send_wcp;
  884.     openflag := True;
  885.     txwindow(1, fname);
  886.     tblks := Trunc(LongFileSize(Blkfile));
  887.     Str((tblks)*22.3333333/speed:6:2, statstr);
  888.     txwindow(3, statstr);
  889.     Str(tblks:4, statstr);
  890.     txwindow(4, statstr);
  891.     txwindow(12, 'Press ^X to abort transfer.'); {Chd 3.01}
  892.     prevchar := -1;
  893.     sblks := 0;               {sent blks}
  894.     ackblks := 0;             {ack'd blocks}
  895.     rblks := 0;               {highest read block}
  896.     errors := 0;
  897.     canflag := False;         {not cancelled yet}
  898.     xpause := False;
  899.     UserKey := 0;
  900.  
  901.     {Xmodem transmit protocol initialization}
  902.  
  903.     i := 0;
  904.     REPEAT
  905.       c := cgetc(1);
  906.       IF c <> -1 THEN
  907.         BEGIN                 {we got a character!}
  908.           INC(i);             {one of our 10 characters }
  909.           CASE c OF
  910.             NAK : BEGIN       {Checksum Xmodem}
  911.                     crcmode := False;
  912.                     wxmode := False;
  913.                     twindow := 0;
  914.                     txwindow(2, 'Checksum Xmodem Send.'); {Chd 3.01}
  915.                     GOTO TransMit; {3.04}
  916.                   END;
  917.             CHARC : BEGIN     {CRC Xmodem}
  918.                       crcmode := True;
  919.                       wxmode := False;
  920.                       twindow := 0;
  921.                       txwindow(2, 'CRC Xmodem Send.') {Chd 3.01};
  922.                       GOTO TransMit; {3.04}
  923.                     END;
  924.             CHARW : BEGIN     {WXmodem}
  925.                       crcmode := True;
  926.                       wxmode := True;
  927.                       twindow := Maxwindow-1;
  928.                       txwindow(2, 'WXmodem Send.'); {Chd 3.01}
  929.                       Str(Maxwindow:1, statstr);
  930.                       txwindow(9, statstr);
  931.                       GOTO TransMit; {3.04}
  932.                     END;
  933.             CAN : BEGIN       {Cancel request received}
  934.                     IF canflag THEN
  935.                      GOTO Exit_send_wcp
  936.                     ELSE
  937.                      canflag := True;
  938.                   END;
  939.           END; {of case c}
  940.         END;{got a character}
  941.  
  942.       IF KeyPressed THEN UserKey := ORD(ReadKey);
  943.  
  944.     UNTIL (i > 10) OR (UserKey = CAN);
  945.  
  946.     IF UserKey = CAN THEN GOTO Exit_send_wcp;
  947.     UserKey := 0;
  948.     txwindow(10, 'Could not start: cancelled.'); {Chd 3.01}
  949.     dump; {purge;}
  950.     GOTO Exit_send_wcp;
  951.  
  952. TransMit:                         {let's send the file!}
  953.     awindow := twindow;
  954.     errors := 0;
  955.     {Xmodem packet level loop}
  956.  
  957.     WHILE (ackblks < tblks) AND (errors <= MAXERRS) DO
  958.       BEGIN
  959.         i := 0;
  960.         WHILE (sblks-ackblks) > awindow DO {is the ack window open?}
  961.           BEGIN {no, so wait for ack/nak}
  962.             INC(i);
  963.             IF i <= 1 THEN
  964.              BEGIN
  965.               Str((awindow+1):1, statstr);
  966.               txwindow(9, Concat(statstr, ' Closed.')); {Chd 3.01}
  967.              END;
  968.             checkack(50);     {50*2400 = 120 seconds +}
  969.             IF canflag THEN GOTO Exit_send_wcp;
  970.             IF KeyPressed THEN
  971.              BEGIN
  972.               UserKey := ORD(ReadKey);
  973.               IF UserKey = CAN THEN GOTO Exit_send_wcp;
  974.              END;
  975.             IF i > 2400 THEN
  976.               BEGIN
  977.                 txwindow(11, 'Timeout for ack.'); {Chd 3.01}
  978.                 sblks := ackblks+1;
  979.                 IF sblks > tblks THEN GOTO Exit_send_wcp;
  980.               END;
  981.             IF (sblks-ackblks) <= awindow THEN
  982.               BEGIN
  983.                 Str((awindow+1):1, statstr);
  984.                 txwindow(9, statstr);
  985.               END;
  986.           END;{window closed}
  987.  
  988.         IF sblks < tblks THEN {is there anything left?}
  989.           BEGIN
  990.             awindow := twindow; {ack window is transmit window}
  991.             {disk read routine}
  992.             INC(sblks);
  993.             xblk := sblks;
  994.             WHILE (xblk > rblks) OR (xblk <= (rblks-bufnum)) DO
  995.               BEGIN
  996.                 IF xblk < (rblks-bufnum) THEN {if we got nak'd back}
  997.                   BEGIN
  998.                     Seek(blkfile, (xblk-1));
  999.                   END;
  1000.                 BlockRead(blkfile, dbuffer, bufnum, bresult);
  1001.                 rblks := xblk+bufnum-1; {note rblks must go past eof}
  1002.               END; {end of disk read routine}
  1003.  
  1004.             j := bufnum-rblks+xblk; {index of next packet}
  1005.  
  1006.             crcval := 0;
  1007.             checksum := 0;
  1008.             Str(xblk:4, statstr);
  1009.             txwindow(5, statstr);
  1010.             IF wxmode THEN
  1011.              BEGIN
  1012.               WHILE xpause DO
  1013.                BEGIN
  1014.                 checkack(15);
  1015.                 xpause := False;
  1016.                 txwindow(8, 'No');
  1017.                END;
  1018.               send(SYN);
  1019.              END;
  1020.             dlesend(SOH);
  1021.             dlesend(xblk AND 255); {block sequence}
  1022.             dlesend((xblk AND 255) XOR 255); {complement sequence}
  1023.  
  1024.             FOR i := 1 TO 128 DO  { main send loop is here }
  1025.              BEGIN
  1026.               c := dbuffer[j,i];
  1027.               IF crcmode THEN
  1028.                {updcrc(c)}
  1029.              crcval := Crctab[hi(crcval) XOR c] XOR (lo(crcval) SHL 8)
  1030.               ELSE
  1031.                checksum := (checksum+c) AND 255;
  1032.               dlesend(c);
  1033.              END;
  1034.  
  1035.             IF crcmode THEN        { here we send the CRC or checksum }
  1036.              BEGIN
  1037.               dlesend(Hi(crcval)); dlesend(Lo(crcval));
  1038.              END
  1039.             ELSE
  1040.              send(checksum);
  1041.             IF canflag THEN GOTO Exit_send_wcp;
  1042.             {writeln(trfile,'SENT ',sblks:5,xblk:5);}
  1043.           END {something to send}
  1044.         ELSE
  1045.           BEGIN {nothing else to send}
  1046.            IF wxmode THEN
  1047.             BEGIN
  1048.              awindow := sblks-ackblks-1; {wait for final acks}
  1049.              Str(awindow:1, statstr);
  1050.              txwindow(9, Concat(statstr, ' -- Closing'));
  1051.             END;
  1052.           END;
  1053.       END;{xmodem send routine}
  1054.  
  1055.     REPEAT {end of transmission}
  1056.       send(EOT);
  1057.       UserKey := 0;
  1058.       REPEAT
  1059.        c := cgetc(15);
  1060.        IF keypressed THEN UserKey := ORD(ReadKey);
  1061.       UNTIL (c <> -1) OR (UserKey = CAN);
  1062.  
  1063.       IF UserKey = CAN THEN GOTO Exit_send_wcp;
  1064.       IF c = NAK THEN
  1065.        BEGIN
  1066.         INC(errors);
  1067.         Delay(250);
  1068.        END;
  1069.     UNTIL (c = ACK) OR (errors = MAXERRS);
  1070.     IF errors = MAXERRS THEN
  1071.       txwindow(11, 'ACK not received at EOT.'); {Chd 3.01}
  1072.  
  1073. Exit_send_wcp: 
  1074.  
  1075.     { close(trfile);}
  1076.     IF openflag THEN
  1077.       BEGIN
  1078.         {$I-} Close(blkfile); {$I+}
  1079.         i := IOResult;
  1080.       END;
  1081.     IF ((UserKey = CAN) OR canflag) AND (Length(fname) > 0) THEN
  1082.       BEGIN
  1083.         txwindow(11, 'Canceled - at your request.'); {Chd 3.01}
  1084.         REPEAT
  1085.           send(CAN); send(CAN);
  1086.           dump; {purge;}
  1087.         UNTIL cgetc(1) = -1;
  1088.       END;
  1089.     txwindow(12, 'Press any key to continue.');   {Chd 3.01}
  1090.     REPEAT UNTIL (KeyPressed);
  1091.     txwindow(12, '                          ');   {Added 3.01}
  1092.     junk := ReadKey;
  1093.     txwindow(99, '  ');
  1094.  
  1095.     Window(1,25,80,25);
  1096.     Gotoxy(19,1);
  1097.     IF carrier THEN
  1098.      Write('On-Line/Ready ')
  1099.     ELSE
  1100.      Write('Off-Line/Ready');
  1101.     Window(1,1,80,24);
  1102.  
  1103.     dbits := db;
  1104.     parity := p;
  1105.     stop_bits := sb;
  1106.     {update_uart;}
  1107.   END;{send_wcp}
  1108.   {$R+,S+}
  1109.  
  1110.