home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / modem / wxmodem.arc / WXMOXFER.INC < prev   
Text File  |  1986-11-06  |  40KB  |  1,006 lines
  1. {$U-,C-,R-,K-}
  2.   {   - modified to add CRC xmodem, wxmodem 7/86 - 10/86
  3. Peter Boswell
  4. ADI
  5. Suite 650
  6. 350 N. Clark St.
  7. Chicago, Il 60610
  8. People/Link: Topper
  9. Compuserve : 72247,3671
  10.   }
  11. const
  12.      SOH = 1;                          {Start Of Header}
  13.      EOT = 4;                          {End Of Transmission}
  14.      ACK = 6;                          {ACKnowledge}
  15.      DLE = $10;                        {Data Link Escape}
  16.      XON = $11;                        {X-On}
  17.      XOFF = $13;                       {X-Off}
  18.      NAK = $15;                        {Negative AcKnowledge}
  19.      SYN = $16;                        {Synchronize}
  20.      CAN = $18;                        {CANcel}
  21.      CHARC = $43;                      {C = CRC Xmodem}
  22.      CHARW = $57;                      {W = WXmodem}
  23.      MAXERRS = 10;                     {Maximum allowed errors}
  24.      L = 0;
  25.      H = 1;
  26.      Buflen  = 128;                    {Disk I/O buffer length}
  27.      Bufnum = 64;                      {Disk I/O buffer count}
  28.      Maxwindow = 4;                    {Wxmodem window size}
  29.                                        {CRC byte translation table}
  30.      Crctab: array[0..255] of Integer =
  31.      (0, 4129, 8258, 12387, 16516, 20645, 24774, 28903,
  32.       -32504,-28375,-24246,-20117,-15988,-11859,-7730,-3601,
  33.       4657, 528, 12915, 8786, 21173, 17044, 29431, 25302,
  34.       -27847,-31976,-19589,-23718,-11331,-15460,-3073,-7202,
  35.       9314, 13379, 1056, 5121, 25830, 29895, 17572, 21637,
  36.       -23190,-19125,-31448,-27383,-6674,-2609,-14932,-10867,
  37.       13907, 9842, 5649, 1584, 30423, 26358, 22165, 18100,
  38.       -18597,-22662,-26855,-30920,-2081,-6146,-10339,-14404,
  39.       18628, 22757, 26758, 30887, 2112, 6241, 10242, 14371,
  40.       -13876,-9747,-5746,-1617,-30392,-26263,-22262,-18133,
  41.       23285, 19156, 31415, 27286, 6769, 2640, 14899, 10770,
  42.       -9219,-13348,-1089,-5218,-25735,-29864,-17605,-21734,
  43.       27814, 31879, 19684, 23749, 11298, 15363, 3168, 7233,
  44.       -4690,-625,-12820,-8755,-21206,-17141,-29336,-25271,
  45.       32407, 28342, 24277, 20212, 15891, 11826, 7761, 3696,
  46.       -97,-4162,-8227,-12292,-16613,-20678,-24743,-28808,
  47.       -28280,-32343,-20022,-24085,-12020,-16083,-3762,-7825,
  48.       4224, 161, 12482, 8419, 20484, 16421, 28742, 24679,
  49.       -31815,-27752,-23557,-19494,-15555,-11492,-7297,-3234,
  50.       689, 4752, 8947, 13010, 16949, 21012, 25207, 29270,
  51.       -18966,-23093,-27224,-31351,-2706,-6833,-10964,-15091,
  52.       13538, 9411, 5280, 1153, 29798, 25671, 21540, 17413,
  53.       -22565,-18438,-30823,-26696,-6305,-2178,-14563,-10436,
  54.       9939, 14066, 1681, 5808, 26199, 30326, 17941, 22068,
  55.       -9908,-13971,-1778,-5841,-26168,-30231,-18038,-22101,
  56.       22596, 18533, 30726, 26663, 6336, 2273, 14466, 10403,
  57.       -13443,-9380,-5313,-1250,-29703,-25640,-21573,-17510,
  58.       19061, 23124, 27191, 31254, 2801, 6864, 10931, 14994,
  59.       -722,-4849,-8852,-12979,-16982,-21109,-25112,-29239,
  60.       31782, 27655, 23652, 19525, 15522, 11395, 7392, 3265,
  61.       -4321,-194,-12451,-8324,-20581,-16454,-28711,-24584,
  62.       28183, 32310, 20053, 24180, 11923, 16050, 3793, 7920);
  63.  
  64. {*** variables used as globals in this source segment
  65.      (actually global to whole  source) ***}
  66. var
  67.    checksum     : integer;
  68.    tblks        : integer;
  69.    fname        : bigstring;
  70.    response     : string[1];
  71.    crcval,db,sb : integer;
  72.    packetln     : integer;            {128 + Checksum or 128 + CRC}
  73.    p            : parity_set;
  74.    dbuffer      : array[1..Bufnum,1..Buflen] of byte;
  75.    dcount       : integer;
  76.    Wxmode       : boolean;
  77.    Crcmode      : boolean;
  78.    Openflag     : boolean;
  79.    Windowfl     : boolean;
  80.  
  81.  
  82. procedure updcrc(a : byte);
  83. begin
  84.   {
  85.      crcval := Crctab[hi(crcval) xor a] xor (lo(crcval) shl 8);
  86.   }
  87.      inline(
  88.  
  89.         $A1/crcval/       {mov ax,crcval     AX <- crcval}
  90.         $89/$C2/          {mov dx,ax         DX <- crcval}
  91.         $88/$E0/          {mov al,ah         (AX) crcval >> 8}
  92.         $B4/$00/          {mov ah,0 }
  93.         $36/              {ss:}
  94.         $8B/$8E/a/        {mov cx,[bp+a]     CX <- a}
  95.         $31/$C8/          {xor ax,cx         AX <- (crcval >> 8) xor a}
  96.         $D1/$E0/          {shl ax,1          AX <- AX * 2  (word index)}
  97.         $BB/crctab/       {mov bx,offset crctab   BX <- addr(crctab)}
  98.         $01/$C3/          {add bx,ax         BX <- addr(crctab)+((crcval>>8)xor a)*2 }
  99.         $2E/              {cs:}
  100.         $8B/07/           {mov ax,[bx]       AX <- contents of crctab}
  101.         $88/$D6/          {mov dh,dl         (DX) crcval << 8}
  102.         $B2/$00/          {mov dl,00}
  103.         $31/$D0/          {xor ax,dx         AX <- contents of crctab xor crcval << 8}
  104.         $A3/crcval        {mov crcval,ax     crcval <- AX}
  105.  
  106.           );
  107. end;
  108. { Xmodem transmit window routine
  109.   Peter Boswell, July 1986       }
  110.  
  111. procedure txwindow(opt : integer; in_string : bigstring);
  112.  
  113. begin
  114.    if not displayfl then
  115.       exit;
  116.    case opt of
  117.        1  :     begin                           {initialize}
  118.                    OpenTemp(36,3,78,18,2);
  119.                    Windowfl := true;
  120.                    Clrscr;
  121.                    GotoXY(10,1);
  122.                    write('File - ',in_string);
  123.                    GotoXY(10,2);
  124.                    write('Mode -');
  125.                    GotoXY(4,3);
  126.                    write('Total time -');
  127.                    GotoXY(2,4);
  128.                    write('Total Blocks -');
  129.                    GotoXY(10,5);
  130.                    write('Sent -');
  131.                    GotoXY(9,6);
  132.                    write('ACK''d -');
  133.                    GotoXY(6,7);
  134.                    write('Last NAK -');
  135.                    GotoXY(9,8);
  136.                    write('X-Off - No');
  137.                    GotoXY(8,9);
  138.                    write('Window - 0');
  139.                    GotoXY(4,11);
  140.                    write('Last Error -');
  141.                    GotoXY(8,10);
  142.                    write('Errors -');
  143.                 end;
  144.        2..11  : begin
  145.                    GotoXY(17,opt);
  146.                    ClrEol;
  147.                    write(in_string);
  148.                 end;
  149.        12     : begin
  150.                    GotoXY(3,12);
  151.                    ClrEol;
  152.                    write(in_string);
  153.                 end;
  154.        99     : begin
  155.                    if windowfl then
  156.                       CloseTemp;
  157.                 end;
  158.  
  159.    end;                                         {case}
  160. end;
  161. { Xmodem receive window routine
  162.   Peter Boswell, October 1986       }
  163.  
  164. procedure trwindow(opt : integer; in_string : bigstring);
  165.  
  166. begin
  167.    if not displayfl then
  168.        exit;
  169.    case opt of
  170.        1  :     begin                           {initialize}
  171.                    windowfl := true;
  172.                    OpenTemp(36,3,78,13,2);
  173.                    Clrscr;
  174.                    GotoXY(10,1);
  175.                    write('File - ',in_string);
  176.                    GotoXY(10,2);
  177.                    write('Mode -');
  178.                    GotoXY(6,3);
  179.                    write('Received -');
  180.                    GotoXY(6,4);
  181.                    write('Last NAK -');
  182.                    GotoXY(4,5);
  183.                    write('Last Error -');
  184.                    GotoXY(8,6);
  185.                    write('Errors -');
  186.                 end;
  187.        2..6   : begin
  188.                    GotoXY(17,opt);
  189.                    ClrEol;
  190.                    write(in_string);
  191.                 end;
  192.        8      : begin
  193.                    GotoXY(3,8);
  194.                    ClrEol;
  195.                    write(in_string);
  196.                 end;
  197.        99     : begin
  198.                    if windowfl then
  199.                       CloseTemp;
  200.                 end;
  201.    end;                                         {case}
  202. end;
  203.  
  204. {
  205.   This routine deletes all DLE characters and XOR's the following character
  206.   with 64.  If a SYN character is found then -2 is returned.
  207.     }
  208. function dlecgetc(Tlimit : integer) : integer;
  209. var
  210. savecgetc : integer;
  211. begin
  212.      if wxmode then
  213.      begin
  214.           savecgetc := cgetc(Tlimit);
  215.           if savecgetc = SYN then
  216.              savecgetc := -2
  217.           else
  218.           if savecgetc = DLE then
  219.           begin
  220.                savecgetc := cgetc(Tlimit);
  221.                if savecgetc >= 0 then savecgetc := savecgetc XOR 64;
  222.           end;
  223.           dlecgetc := savecgetc;
  224.      end
  225.      else
  226.      dlecgetc := cgetc(Tlimit);
  227. end;
  228.  
  229. procedure purge;
  230. begin
  231.      while dlecgetc(1) >= 0 do
  232.                      ;
  233. end;
  234.  
  235. procedure SaveCommStatus;
  236. begin
  237.       p := parity;
  238.       db := dbits;
  239.       sb := stop_bits;
  240.       dbits        := 8;
  241.       parity       := none;
  242.       stop_bits    := 1;
  243.       update_uart
  244. end;
  245.  
  246.  
  247. procedure recv_wcp;
  248. {receive a file using Ward Christensen's checksum protocol}
  249. label
  250.      99;
  251. var
  252.    j, firstchar, sectnum, sectcurr, prevchar, lignore, blkcnt,
  253.    toterr, errors, sectcomp, bufcurr, bresult : integer;
  254.    Xtrace, EotFlag, ErrorFlag, Extend : boolean;
  255.    UserKey : byte;
  256.    blkfile : file;
  257.    statstr : bigstring;
  258.    trfile                     : text;
  259. begin
  260.      status(2, 'RECV XMODEM');
  261.      windowfl  := False;
  262.      EotFlag   := False;
  263.      Xtrace    := False;
  264.      Openflag  := False;
  265.      Bufcurr   := 1;
  266.      SaveCommStatus;
  267.      fname     := xmofile;
  268.      Assign(blkfile,fname);
  269.      {$I-} Rewrite(blkfile); {$I+}
  270.      ErrorFlag := (IOresult <> 0);
  271.      if ErrorFlag then
  272.      begin
  273.         writeln(#13,#10,'WXMODEM --- cannot open receive file');
  274.         goto 99;
  275.      end
  276.      else
  277.         openflag := True;
  278.  
  279.      trwindow(1, fname);
  280.      blkcnt := 0;
  281.      sectnum := 0;
  282.      errors := 0;
  283.      toterr := 0;
  284. {    assign(trfile,'trace');}
  285. {    rewrite(trfile);}
  286.      Crcmode  := true;                          {Assume CRC versus Checksum}
  287.      Packetln := 130;                           {128 byte data + 2 byte CRC}
  288.      Wxmode   := true;                          {Assume Wxmodem}
  289.      Lignore  := 0;                             {ignore packets after error}
  290.      i:=0;                                      {Try for Wxmodem 3 times}
  291.      purge;
  292.      if xmotype = 'W' then
  293.      begin
  294.           trwindow(8,'Trying Wxmodem');
  295.           repeat
  296.                send(ord('W'));
  297.                firstchar := cgetc(6);               {6 seconds each}
  298.                if scan(Extend, UserKey) then
  299.                     if UserKey = CAN then goto 99;
  300.                i := i + 1;
  301.           until (firstchar=SYN) or (firstchar=CAN) or (i=7);
  302.           if firstchar=CAN then goto 99;
  303.           if firstchar <> SYN then
  304.                xmotype := 'C';
  305.      end;
  306.      if xmotype = 'C' then
  307.      begin
  308.           trwindow(8,'Trying CRC Xmodem');
  309.           wxmode := false;
  310.           i:=0;                                 {Try CRC xmodem 3 times}
  311.           repeat
  312.                send(ord('C'));
  313.                firstchar := cgetc(4);           {4 seconds each}
  314.                if scan(Extend,UserKey) then
  315.                     if UserKey = CAN then goto 99;
  316.                i := i + 1;
  317.           until (firstchar=SOH) or (firstchar=CAN) or (i=3);
  318.           if firstchar = CAN then goto 99;
  319.           if firstchar <> SOH then
  320.                xmotype := 'X';
  321.      end;
  322.      if xmotype = 'X' then
  323.      begin
  324.           trwindow(5,'Trying Checksum Xmodem');
  325.           wxmode   := false;
  326.           Crcmode  := false;
  327.           Packetln := 129;                 {128 bytes + 1 byte Checksum}
  328.           i:=0;                            {Try Checksum xmodem 4 times}
  329.           repeat
  330.                send(NAK);
  331.                firstchar := cgetc(10);     {10 seconds each}
  332.                if scan(Extend,UserKey) then
  333.                     if UserKey = CAN then goto 99;
  334.                i := i + 1;
  335.           until (firstchar=SOH) or (firstchar=CAN) or (i=4);
  336.      end;                                  {Checksum}
  337.         { firstchar contains the first character and Wxmode and Crcmode
  338.           indicate the type of Xmodem }
  339.  
  340.      If wxmode then
  341.          trwindow(2,'WXmodem');
  342.      If not wxmode and crcmode then
  343.          trwindow(2,'CRC Xmodem');
  344.      if not wxmode and not crcmode then
  345.          trwindow(2,'Checksum Xmodem');
  346.      trwindow(8,'Press ^X to quit');
  347.      prevchar := firstchar;                     {save the firstchar}
  348.      while (EotFlag = false) and (Errors < MAXERRS) do
  349.      begin                                      {locate start of packet}
  350.        if (firstchar=SOH) and
  351.           ((Wxmode and (prevchar=SYN)) or (not Wxmode)) then
  352.        begin                                    {process packet}
  353.           prevchar := -1;
  354.           firstchar := -1;
  355.           sectcurr := dlecgetc(15);
  356. {         writeln(trfile,'sectcurr=',sectcurr:4);}
  357.           sectcomp := dlecgetc(15);
  358.           if sectcurr = (sectcomp xor 255) then
  359.           begin                                 {sequence versus compl 1ood}
  360.                if sectcurr = ((sectnum + 1) and 255) then
  361.                begin                            {in sequence}
  362.                     crcval   := 0;
  363.                     checksum := 0;
  364.                     j        := 1;
  365.                     repeat
  366.                          firstchar := dlecgetc(15);
  367.                          if firstchar >= 0 then
  368.                          begin
  369.                               if j < 129 then
  370.                                  dbuffer[bufcurr,j] := firstchar;
  371.                               if Crcmode then updcrc(firstchar)
  372.                               else checksum := (checksum and 255) + firstchar;
  373.                               j := j + 1;
  374.                          end;
  375.                     until (j > Packetln) or (firstchar < 0);
  376.                     if j > Packetln then        {good packet length}
  377.                     begin
  378.                          if (Crcmode and (crcval=0) or
  379.                          (not Crcmode and ((checksum shr 1) = firstchar)))
  380.                          then
  381.                          begin                  {good crc/checksum}
  382.                               firstchar := -1;  {make sure this byte not used
  383.                                                  for start of packet }                errors  := 0;
  384.                               sectnum := sectcurr;
  385.                               blkcnt  := blkcnt + 1;
  386.                               send(ACK);
  387.                               str(blkcnt:4,statstr);
  388.                               trwindow(3,statstr);
  389.                               if Wxmode then send(sectcurr and 3);
  390. {                             write(trfile,' ACK ');}
  391. {                             if Wxmode then write(trfile,(sectcurr and 3):1);}
  392.                               if errors <> 0 then
  393.                               begin
  394.                                  trwindow(6,'0');
  395.                                  trwindow(5,' ');
  396.                                  errors := 0;
  397.                               end;
  398.                               bufcurr := bufcurr + 1;
  399.                               if bufcurr > bufnum then
  400.                               begin             {Disk write routine}
  401.                                    bufcurr := 1;
  402.                                    if wxmode and pcjrmode then
  403.                                    begin               {if unable to overlap
  404.                                                         disk i/o and comm i/o.}
  405.                                         send(XOFF);    {stop transmitter}
  406.                                         delay(250);    {give it a chance}
  407.                                    end;
  408.                                    BlockWrite(blkfile,dbuffer,bufnum,bresult);
  409.                                    if wxmode and pcjrmode then
  410.                                    begin
  411.                                         flush(blkfile); {complete all i/o}
  412.                                         send(XON);      {restart transmitter}
  413.                                    end;
  414.                                    if bresult <> bufnum then
  415.                                    begin
  416.                                         trwindow(8,'Disk write error');
  417.                                         goto 99;
  418.                                    end;
  419.                               end;              {End of disk write routine}
  420.                          end                    {good crc/checksum}
  421.                          else
  422.                          begin                  {bad crc/checksum}
  423.                               trwindow(5,'CRC/Checksum error');
  424.                               str((blkcnt+1):6,statstr);
  425.                               trwindow(4,statstr);
  426.                               errors := errors + 1;
  427.                               toterr := toterr + 1;
  428.                               str(errors:3,statstr);
  429.                               trwindow(6,statstr);
  430.                               purge;  {clear any garbage coming in}
  431.                               send(NAK);
  432.                               if wxmode then
  433.                               begin
  434.                                    send(sectcurr and 3);
  435.                                    lignore := maxwindow;
  436.                               end;
  437. {                             write(trfile,' NAK CRC ',(sectcurr and 3):1);}
  438.                          end;                   {bad crc/checsum}
  439.                     end                         {good packet length}
  440.                     else
  441.                     begin                       {bad packet length}
  442.                          trwindow(5,'Short block error');
  443.                          str((blkcnt+1):6,statstr);
  444.                          trwindow(4,statstr);
  445.                          errors := errors + 1;
  446.                          str(errors:3,statstr);
  447.                          trwindow(6,statstr);
  448.                          purge;   {clear any garbage}
  449.                          send(NAK);
  450.                          if wxmode then
  451.                          begin
  452.                               send(sectcurr and 3);
  453.                               lignore := maxwindow;
  454.                          end;
  455.                          purge;   {clear any garbage}
  456. {                        write(trfile,' NAK SHORT ',(sectcurr and 3):1);}
  457.                     end;                        {bad packet length}
  458.                end                              {good block sequence number}
  459.                else
  460.                begin                            {invalid sequence number}
  461.                     if lignore <= 0 then        {are we ignoring packets?}
  462.                     begin
  463.                          toterr := toterr + 1;
  464.                          trwindow(5,'Out of sequence');
  465.                          str((blkcnt+1):6,statstr);
  466.                          trwindow(4,statstr);
  467.                          errors := errors + 1;
  468.                          str(errors:3,statstr);
  469.                          trwindow(6,statstr);
  470.                          purge;   {clear any garbage coming in}
  471.                          send(NAK);
  472.                          if wxmode then
  473.                          begin
  474.                               send((sectnum+1) and 3);
  475.                               lignore := Maxwindow;
  476.                          end;
  477.                          purge;   {clear any garbage coming in}
  478. {                        write(trfile,' NAK SEQ ',((sectnum+1) and 3):1);}
  479.                     end
  480.                     else lignore := lignore -1
  481.                end;                             {invalid sequence number}
  482.           end                                   {valid complement}
  483.           else
  484.           begin                                 {invalid complement}
  485.                toterr := toterr + 1;
  486.                trwindow(5,'Sequence complement error');
  487.                str((blkcnt+1):6,statstr);
  488.                trwindow(4,statstr);
  489.                errors := errors + 1;
  490.                str(errors:3,statstr);
  491.                trwindow(6,statstr);
  492.                purge;    {clear any garbage comming in}
  493.                send(NAK);
  494.                if wxmode then
  495.                begin
  496.                     send((sectnum+1) and 3);
  497.                     lignore := Maxwindow;
  498.                end;
  499.                purge;    {clear any garbage comming in}
  500. {              write(trfile,' NAK CMP ',((sectnum + 1) and 3):1);}
  501.           end;                                  {invalid complement}
  502.        end                                      {process packet}
  503.        else                                     {not start of packet}
  504.        begin
  505.             case prevchar of
  506.               EOT:   begin
  507.                           if firstchar=EOT then
  508.                           begin
  509.                                EotFlag := True;
  510.                                send(ACK);
  511.                           end;
  512.                      end;
  513.               CAN:   begin
  514.                           if firstchar=CAN then
  515.                           goto 99;
  516.                      end;
  517.             end;                                {Of case}
  518.             if not EotFlag then
  519.             begin
  520.                  if firstchar=EOT then
  521.                  begin
  522.                       send(NAK);  {first EOT received}
  523.                       trwindow(5,' First EOT received');
  524.                  end;
  525.                  prevchar := firstchar;
  526.                  firstchar := cgetc(15);        {start of packet!!!!}
  527.                  if firstchar=-1 then
  528.                  begin
  529.                       if (prevchar=CAN) or (prevchar=EOT) then
  530.                          firstchar := prevchar  {assume two have been received}
  531.                       else
  532.                       begin
  533.                            trwindow(5,'Timeout on start of packet');
  534.                            str((blkcnt+1):6,statstr);
  535.                            trwindow(4,statstr);
  536.                            errors := errors + 1;
  537.                            str(errors:3,statstr);
  538.                            trwindow(6,statstr);
  539.                            send(XON);
  540.                            toterr := toterr + 1;
  541.                            send(NAK);
  542.                            if wxmode then
  543.                            begin
  544.                                 send((sectnum+1) and 3);
  545.                                 lignore := Maxwindow;
  546.                            end;
  547. {                          write(trfile,' NAK TIM ',((sectnum+1) and 3):1);}
  548.                       end;
  549.                  end;                           {Timeout at start of packet}
  550.                  if scan(Extend,UserKey) then
  551.                       if UserKey = CAN then goto 99;
  552.             end;                                {end of not EotFlag}
  553.          end;                                   {not start of packet}
  554.      end;                                       {xmodem loop}
  555.            {If there are any xmodem packets left in dbuffer, we had best
  556.             write them out}
  557.  
  558.      If EotFlag and (bufcurr>1) then
  559.      begin
  560.           bufcurr := bufcurr - 1;
  561.           trwindow(8,'Writing final blocks');
  562.           if wxmode and pcjrmode then
  563.           begin               {if unable to overlap
  564.                                disk i/o and comm i/o.}
  565.                send(XOFF);    {stop transmitter}
  566.                delay(250);    {give it a chance}
  567.           end;
  568.           BlockWrite(Blkfile,dbuffer,bufcurr,bresult);
  569.           if wxmode and pcjrmode then
  570.           begin
  571.                flush(blkfile); {complete all i/o}
  572.                send(XON);      {restart transmitter}
  573.           end;
  574.           if bufcurr <> bresult then
  575.           begin
  576.                EotFlag := False;                {no longer a 'real' eot}
  577.                trwindow(8,'Disk write error at end of receive');
  578.           end;
  579.      end;
  580.      If Eotflag and Openflag then
  581.      begin
  582.           tblks := blkcnt;
  583.           {$I-} close(blkfile); {$I+}
  584.           If IOresult = 0 then
  585.              good := true
  586.           else writeln('WXMODEM - error closing receive file');
  587.      end;
  588.   99:
  589.      if not Eotflag then
  590.      begin
  591.           if (errors >= Maxerrs) then
  592.                trwindow(8,'Maximum errors exceeded')
  593.           else
  594.           if UserKey = CAN then
  595.           begin
  596.                trwindow(5,'^X entered');
  597.                send(CAN); send(CAN); send(CAN);
  598.           end;
  599.           if (firstchar = CAN) then
  600.                trwindow(5,'Cancel received');
  601.           if openflag then
  602.           begin
  603.                {$I-} close(blkfile) {$I+};
  604.                i := IOresult;                     {clear ioresult}
  605.                {$I-} erase(blkfile); {$I+}
  606.                i := IOresult;                     {clear ioresult}
  607.           end;
  608.      end;
  609.      dbits        := db;
  610.      parity       := p;
  611.      stop_bits    := sb;
  612. {    close(trfile);}
  613.      update_uart;
  614.      trwindow(99,'  ');
  615. end;
  616.  
  617. procedure send_wcp;
  618. Label
  619.   tran,99;
  620. Var
  621.    UserKey                    : byte;
  622.    c, i, j, sectnum, errors   : integer;
  623.    sblks, ackblks, rblks : integer;        {total, sent, ack'd blocks}
  624.    twindow, awindow           : integer;          {transmission window}
  625.    bresult, nblks, prevchar   : integer;
  626.    bflag, canflag, xpause     : boolean;
  627.    extend                     : boolean;
  628.    blkfile                    : file;
  629.    statstr, statstr2          : bigstring;
  630.    xblk, ackseq               : integer;
  631.    trfile                     : text;
  632.  
  633. procedure checkack(tlimit : integer);
  634.  
  635. var
  636. inchar  :   integer;
  637.  
  638. begin
  639.    repeat                                      {until no more data & timelimit}
  640.       inchar := cgetc(0);
  641.       if inchar <> -1 then
  642.       begin                                     {got a character}
  643.          if wxmode then                         {wxmodem}
  644.          begin
  645. {           write(trfile,inchar:4);}
  646.             case inchar of
  647.                XOFF : begin
  648.                          xpause := true;
  649.                          txwindow(8,'Received - waiting');
  650.                       end;
  651.                XON  : begin
  652.                          xpause := false;
  653.                          txwindow(8,'No');
  654.                       end;
  655.                ACK, NAK, CAN : prevchar := inchar;       {save ACK/NAK/CAN}
  656.  
  657.                0..3 : begin                     {valid ACK/NAK sequence number}
  658.                          case prevchar of
  659.                             ACK : begin
  660.                                      ackseq := inchar - (ackblks and twindow);
  661.                                      if ackseq <= 0 then
  662.                                         ackseq := ackseq + maxwindow;
  663.                                      nblks := ackblks + ackseq;
  664.                                      if nblks <= sblks then
  665.                                      begin
  666.                                         ackblks := nblks;
  667.                                         str(ackblks:4,statstr);
  668.                                         txwindow(6,statstr);
  669.                                         if errors <> 0 then
  670.                                         begin
  671.                                            errors := 0;
  672.                                            txwindow(10,'0');
  673.                                         end;
  674.                                      end;
  675. {                                    writeln(trfile,' ACK ',inchar:2,ackblks:5);}
  676.                                      prevchar := -1;
  677.                                   end;                 {case ACK}
  678.                             NAK : begin
  679.                                      ackseq := inchar - (ackblks and twindow);
  680.                                      if ackseq <= 0 then
  681.                                         ackseq := ackseq + maxwindow;
  682.                                      nblks := ackblks + ackseq;
  683.                                      if nblks <= sblks then
  684.                                      begin
  685.                                         sblks := nblks - 1;
  686.                                         if (sblks - ackblks) <= 2 then
  687.                                            ackblks := sblks;
  688.                                         str(nblks:4,statstr);
  689.                                         txwindow(7,statstr);
  690.                                         str(sblks:4,statstr);
  691.                                         txwindow(5,statstr);
  692.                                         errors := errors + 1;
  693.                                         str(errors:3,statstr);
  694.                                         txwindow(10,statstr);
  695.                                      end
  696.                                      else
  697.                                      begin
  698.                                        GotoXY(3,12);
  699.                                        ClrEol;
  700.                                        writeln('Invalid NAK seq ',nblks:4,ackseq:4,inchar:3);
  701.                                      end;
  702. {                                    writeln(trfile,' NAK ',inchar:2,ackblks:5,sblks:5);}
  703.                                      prevchar := -1;
  704.                                   end;                 {case NAK}
  705.                             CAN : begin
  706.                                      if inchar = CAN then
  707.                                         canflag := true;
  708.                                   end;
  709.                          end;                          {of case prevchar}
  710.                       end;                             {case 0..3}
  711.                else                                    {of case inchar}
  712.                   prevchar := -1;       {inchar not XON/XOFF/ACK/NAK/CAN/0/1/2/3}
  713.             end;                                {of case inchar}
  714.          end                                    {wxmodem mode}
  715.          else
  716.          begin                                  {regular xmodem}
  717.             case inchar of
  718.                ACK : begin
  719.                         ackblks := ackblks + 1;
  720.                         errors  := 0;
  721.                      end;
  722.                NAK : begin
  723.                         sblks   := sblks - 1;
  724.                         errors  := errors + 1;
  725.                      end;
  726.                CAN : begin
  727.                         if prevchar = CAN then
  728.                            canflag := true;
  729.                         prevchar   := CAN;
  730.                      end;
  731.             else     prevchar := inchar;
  732.             end;                                {end of case inchar}
  733.          end;                                   {regular xmodem}
  734.       end                                       {end of got a character}
  735.       else                                      {no incoming data, inchar=-1}
  736.       begin
  737.          if tlimit > 0 then
  738.          begin
  739.             delay(1);
  740.             tlimit := tlimit - 1;
  741.          end;
  742.       end;                                      {end no incoming data}
  743.       if scan(Extend,UserKey) then
  744.       begin
  745.          if UserKey = CAN then
  746.          begin
  747.             canflag := true;
  748.             tlimit  := 0;                       {force end of repeat}
  749.             inchar  := -1;                      { "    "   "  "     }
  750.             xpause  := false;
  751.             purge;
  752.          end;
  753.       end;                                      {end of keypressed}
  754.    until (tlimit <= 0) and (inchar = -1);       {repeat until nothing left}
  755. end;                                            {of procedure checkack}
  756.  
  757. procedure ChkXoff;
  758. var
  759.   j : integer;
  760. begin
  761.    j := 0;
  762.    repeat
  763.       checkack(0);
  764.       j := j + 1;
  765.       delay(1);
  766.    until ((xpause = false) or (j = 10000));
  767.    if xpause then                      {but not forever}
  768.       begin
  769.          txwindow(8,'No - Timed Out');
  770.          xpause := false;
  771.       end;
  772. end;
  773.  
  774. procedure dlesend(c:integer);
  775. begin
  776.    if wxmode then
  777.    begin
  778.       if buf_start <> buf_end then              {if there is any incoming data}
  779.          checkack(0);
  780.       if xpause then ChkXoff;                   {X-Off received .. better wait}
  781.       case c of
  782.          SYN, XON, XOFF, DLE :  begin
  783.                                    send(DLE);
  784.                                    send(c xor 64);
  785.                                 end;
  786.                             else   send(c);
  787.       end;
  788.    end
  789.    else send(c);                                {regular xmodem}
  790. end;
  791.  
  792.  
  793. begin
  794.      status(2, 'SEND XMODEM');
  795.      SaveCommStatus;
  796.      Windowfl := false;
  797.      openflag := false;
  798. {    assign(trfile,'trace');}
  799. {    rewrite(trfile);}
  800.     fname := xmofile;
  801.     Assign(Blkfile,fname);
  802.     {I-} Reset(Blkfile); {I+}
  803.     If IOresult <> 0 then
  804.        goto 99;
  805.     openflag := true;
  806.     txwindow(1,fname);
  807.     tblks := Trunc(LongFileSize(Blkfile));
  808.     fmin := Trunc((tblks)*22.3333333/speed);
  809.     str(fmin:3,statstr);
  810.     fsec := Trunc((tblks*22.3333333/speed - fmin) * 60);
  811.     str(fsec:2,statstr2);
  812.     txwindow(3,statstr+':'+statstr2);
  813.     str(tblks:4,statstr);
  814.     txwindow(4,statstr);
  815.     txwindow(12,'Press ^X to abort transfer');
  816.     prevchar := -1;
  817.     sblks   := 0;                               {sent blks}
  818.     ackblks := 0;                               {ack'd blocks}
  819.     rblks   := 0;                               {highest read block}
  820.     errors  := 0;
  821.     canflag := false;                           {not cancelled yet}
  822.     xpause  := false;
  823.     UserKey := 0;
  824.  
  825.                       {Xmodem transmit protocol initialization}
  826.  
  827.     i := 0;
  828.     repeat
  829.       c := cgetc(1);
  830.       if c <> -1 then
  831.       begin                                     {we got a character!}
  832.            i := i + 1;                          {one of our 10 characters}
  833.            case c of
  834.              NAK   :  begin                     {Checksum Xmodem}
  835.                            crcmode := false;
  836.                            wxmode  := false;
  837.                            twindow := 0;
  838.                            txwindow(2,'Checksum Xmodem Send');
  839.                            goto tran;
  840.                       end;
  841.              CHARC :  begin                     {CRC Xmodem}
  842.                            crcmode := true;
  843.                            wxmode  := false;
  844.                            twindow := 0;
  845.                            txwindow(2,'CRC Xmodem Send');
  846.                            goto tran;
  847.                       end;
  848.              CHARW :  begin                     {WXmodem}
  849.                            crcmode := true;
  850.                            wxmode  := true;
  851.                            twindow := Maxwindow - 1;
  852.                            txwindow(2,'WXmodem Send');
  853.                            str(Maxwindow:1,statstr);
  854.                            txwindow(9,statstr);
  855.                            goto tran;
  856.                       end;
  857.  
  858.              CAN   :  begin                     {Cancel request received}
  859.                            if canflag then goto 99
  860.                            else canflag := true;
  861.                       end;
  862.            end;                                 {of case c}
  863.        end;                                     {got a character}
  864.  
  865.        if scan(Extend, UserKey) then ;
  866.     until (i > 10) or (UserKey = CAN);
  867.     if UserKey = CAN then goto 99;
  868.     UserKey := 0;
  869.     txwindow(10,'Could not start: cancelled');
  870.     purge;
  871.     goto 99;
  872.  
  873. tran:                                           {let's send the file!}
  874.     awindow := twindow;
  875.     errors  := 0;
  876.               {Xmodem packet level loop}
  877.  
  878.     while (ackblks < tblks) and (errors <= MAXERRS) do
  879.     begin
  880.        i := 0;
  881.        while (sblks - ackblks) > awindow do     {is the ack window open?}
  882.        begin                                    {no, so wait for ack/nak}
  883.           i := i + 1;
  884.           if i <= 1 then
  885.           begin
  886.              str((awindow+1):1,statstr);
  887.              txwindow(9,concat(statstr,' Closed'));
  888.           end;
  889.           checkack(50);                         {50*2400 = 120 seconds +}
  890.           if canflag then
  891.              goto 99;
  892.           if scan(Extend,UserKey) then
  893.              if UserKey = CAN then
  894.                 goto 99;
  895.           if i > 2400 then
  896.           begin
  897.              txwindow(11,'Timeout for ack');
  898.              sblks := ackblks + 1;
  899.              if sblks > tblks then
  900.                 goto 99;
  901.           end;
  902.           if (sblks - ackblks) <= awindow then
  903.           begin
  904.              str((awindow+1):1,statstr);
  905.              txwindow(9,statstr);
  906.           end;
  907.        end;                                     {window closed}
  908.  
  909.        if sblks < tblks then                    {is there anything left?}
  910.        begin
  911.           awindow := twindow;                   {ack window is transmit window}
  912.                            {disk read routine}
  913.           sblks := sblks + 1;
  914.           xblk  := sblks;
  915.           while (xblk > rblks) or (xblk <= (rblks - bufnum)) do
  916.           begin
  917.              if xblk < (rblks - bufnum) then    {if we got nak'd back}
  918.              begin
  919.                 seek(blkfile,(xblk-1));
  920.              end;
  921.              BlockRead(blkfile,dbuffer,bufnum,bresult);
  922.              rblks := xblk + bufnum - 1;        {note rblks must go past eof}
  923.           end;                                  {end of disk read routine}
  924.  
  925.           j := bufnum - rblks + xblk;           {index of next packet}
  926.  
  927.           crcval := 0;
  928.           checksum := 0;
  929.           if wxmode then
  930.           begin
  931.              if xpause then ChkXoff;
  932.              send(SYN);
  933.           end;
  934.           dlesend(SOH);
  935.           dlesend(xblk and 255);                {block sequence}
  936.           dlesend((xblk and 255) xor 255);      {complement sequence}
  937.           for i := 1 to 128 do
  938.           begin
  939.              c := dbuffer[j,i];
  940.              if crcmode then updcrc(c)
  941.              else checksum := (checksum + c) and 255;
  942.              dlesend(c);
  943.           end;
  944.           if crcmode then
  945.           begin
  946.              dlesend(hi(crcval));
  947.              dlesend(lo(crcval));
  948.           end
  949.           else
  950.              send(checksum);
  951.           if canflag then
  952.              goto 99;
  953.           str(xblk:4,statstr);
  954.           txwindow(5,statstr);
  955. {         writeln(trfile,'SENT ',sblks:5,xblk:5);}
  956.        end                                      {something to send}
  957.        else
  958.        begin                                    {nothing else to send}
  959.           if wxmode then
  960.           begin
  961.              str(awindow:1,statstr);
  962.              txwindow(9,concat(statstr,' -- Closing'));
  963.              awindow := sblks - ackblks - 1;    {wait for final acks}
  964.           end;
  965.        end;
  966.     end;                                        {xmodem send routine}
  967.  
  968.     repeat                                      {end of transmission}
  969.       send(EOT);
  970.       UserKey := 0;
  971.       repeat
  972.         c := cgetc(15);
  973.         if scan(Extend,UserKey) then ;
  974.       until (c <> -1) or (UserKey = CAN);
  975.       if UserKey = CAN then goto 99;
  976.       if c = NAK then
  977.       begin
  978.          errors := errors + 1;
  979.          delay(250);
  980.       end;
  981.     until (c = ACK) or (errors = MAXERRS);
  982.     if errors = MAXERRS then
  983.        txwindow(11,'ACK not received at EOT');
  984.     good := true;       {Yea - we sent it}
  985.     99:
  986. {   close(trfile);}
  987.     if openflag then
  988.     begin
  989.        {$I-} close(blkfile) {$I+} ;
  990.        i := IOresult;                           {clear ioresult}
  991.     end;
  992.     if ((UserKey = CAN) or canflag) and (length(fname) > 0) then
  993.     begin
  994.       repeat
  995.         send(CAN);
  996.         send(CAN);
  997.         purge
  998.       until cgetc(1) = -1
  999.     end;
  1000.     txwindow(99,'  ');
  1001.     dbits        := db;
  1002.     parity       := p;
  1003.     stop_bits    := sb;
  1004.     update_uart
  1005. end;
  1006.