home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PROT100.ZIP / PROTOCOL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-15  |  21.5 KB  |  720 lines
  1. {$A+}{$B-}{$D+}{$G+}{$R-}{$S-}{$V-}
  2. (*
  3.   $A+: Align on word boundaries (for 80x86 processors
  4.   $B-: short circuit boolean evaluation
  5.   $G+: enable 80286 code optimization
  6.   $L : local symbols switch
  7.   $R+- only adds time when an index is used in array or a string
  8.   $S+- checks stack whenever a procedure is called or a dynamic variable
  9.        is created.
  10.   $V+: Controls type-checking on strings passed as variable parameters
  11.  
  12. *)
  13. (*
  14.    PROTOCOL.PAS - protocol unit for NBBS BBS v1.00a
  15.    (c)1989,1990,1993 Eric J. Givler, All Rights Reserved.
  16.  
  17.    History:
  18.  
  19.    Internal Functions and Procedures in this unit include:
  20.    function eltime      - elapsed time calculations of transfers.
  21.    function leap        - return true if year is a leap year
  22.    function octal       - return octal string of a longint
  23.    function since70     - Calculate seconds since 01/01/70
  24.    function sendxmodem  - send xmodem/checksum
  25.    function sendxmodemCRC guess?
  26.    function send1kxmodem- send Xmodem-1K
  27.    function sendymodem  - send true Ymodem (has header info)
  28.    function sendascii   - not done
  29.    function recvascii   - not done
  30.    function recvxmodem  - Receive Xmodem/Checksum
  31.  
  32.    Dispatcher functions (CALLABLE)
  33.    FUNCTION UpLoad(fname: string; using:protocols): boolean;
  34.    FUNCTION DownLoad(fname: string; using:protocols): boolean;
  35.  
  36.  
  37.    FOR A USER WHO DOESN'T HAVE MNP:
  38.    var valid_protocol_set : set of protocol;
  39.  
  40.    valid_protocol_set := protocol_set - MNP_set;
  41.  
  42.    YOU CAN THEN STEP THROUGH THE SET, PRESENT THE USER WITH WHAT PROTOCOLS
  43.    ARE AVAILABLE, AND THEN USE THE UNIT TO INITIATE THE TRANSFER.  LIKE:
  44.  
  45.    var p: protocol;
  46.    p := integer(0);
  47.    repeat
  48.      writeln('How about using ', protocol_name[p]);
  49.      p := succ(p);
  50.    until (p = External);
  51. *)
  52. UNIT PROTOCOL;
  53.  
  54. INTERFACE
  55.  
  56. type protocols = (ASCII, XmodemChkSum, XmodemCRC, Xmodem1K, Ymodem,
  57.                  MegaLink,YmodemG);
  58.  
  59. const protocol_name: array[protocols] of string[12] =
  60.                 ('ASCII','XmodemChkSum','XmodemCRC','Xmodem1K',
  61.                  'Ymodem','MegaLink','YmodemG');
  62.  
  63.       protocol_set : set of protocols = [ASCII..YmodemG];
  64.       batch_set    : set of protocols = [Ymodem,YmodemG,MegaLink];
  65.       MNP_set      : set of protocols = [YmodemG];
  66.  
  67. var errorcode : byte;
  68. {
  69.   0 = No Error, Success
  70.   1 = User/Remote Aborted Transfer
  71.   2 = Local Abort
  72.   3 = Carrier Loss
  73.   4 = Bad CRC
  74.   5 = No ACK on EOT
  75.   6 = File already exists?
  76.   7 = File NOT found
  77. }
  78.    cps : real;  { result of last transfer - Characters Per Second }
  79.  
  80.  
  81. (* protocol dispatchers *)
  82. function Upload(fname: string; using : protocols): boolean;
  83. function Download(fname: string; using : protocols): boolean;
  84.  
  85. (* ------------------------- IMPLEMENTATION ---------------------------- *)
  86. IMPLEMENTATION
  87.  
  88. USES DOS,
  89.      crt,     { Turbo Pascal CRT routines    }
  90.      crcs,    { CRC calculation routines     }
  91.      fos;     { Fossil communication library }
  92.  
  93. CONST NUL  = 00;
  94.       SOH  = #$01;            { Start Of Header (128)   }
  95.       STX  = #$02;            { Start Of Header (1024)  }
  96.       EOT  = #$04;            { End of Transmission     }
  97.       ACK  = #$06;            { Acknowledge (positive)  }
  98.       DLE  = #$10;            { Data Link Escape        }
  99.       NAK  = #$15;            { Negative Acknowledge    }
  100.       SYN  = #$16;            { Synchronous idle        }
  101.       XON  = #$11;            { Transmit On (DC1)       }
  102.       XOFF = #$13;            { Transmit Off (DC3)      }
  103.       CAN  = #$18;            { Cancel                  }
  104.       CPMEOF = #$1A;          { End Of File (padding)^Z }
  105.  
  106.       C   = #$43;
  107.       TAB = 09;
  108.       LF  = #$0A;
  109.       CR  = #$0D;
  110.       Space = ' ';
  111.  
  112.       lastbyte = 127;
  113.       errormax = 5;
  114.       retrymax = 10;             { 10 retries }
  115.  
  116. type  blocktype = array[0..127] of byte;
  117.  
  118. VAR   sector : blocktype;        { array[0..lastbyte] of byte; }
  119.       systicks  : longint absolute $40:$6c;
  120.       tickstart : real;
  121.  
  122.  
  123. function eltime(lesser,greater:real):real;
  124. begin
  125.    if lesser <= greater then
  126.         eltime := greater - lesser
  127.    else eltime := (86400.0 - lesser) + greater;
  128. end; (* eltime (elapsed time) for reals *)
  129.  
  130.  
  131. FUNCTION SENDXMODEM(var f : file): boolean;
  132. { currently no abort local or remote allowed here!! }
  133. var j,                            { for local loops }
  134.     result,
  135.     checksum,
  136.     blocknum,
  137.     ch       : integer;
  138.     lc       : char;              { possible local abort }
  139.     counter  : byte;
  140.     temp     : string[5];
  141. begin
  142.   sendxmodem := false;
  143.   blocknum := 1;
  144.   str((filesize(f) div 128):5,temp);
  145.   writeln('File open:' + temp + ' records.');
  146.   repeat
  147.      counter := 0;
  148.      fillchar(sector,sizeof(sector),CPMEOF);
  149.      blockread(f,sector,sizeof(sector),result);
  150.      repeat
  151.        write(cr,'Sending block: ',blocknum);
  152.        FOS.Send(SOH);                             { Start of Header  }
  153.        FOS.Send(CHR(blocknum));                   { Packet Number    }
  154.        FOS.Send(CHR(-blocknum-1));                { One's complement }
  155.        CHECKSUM := 0;
  156.        FOS.Sendblk(seg(sector[0]),ofs(sector[0]),128);
  157.        for j:= 0 to lastbyte do CHECKSUM:=(CHECKSUM+sector[j]) mod 256;
  158.        send(chr(CHECKSUM));
  159.        purgeline;
  160.        inc(counter);
  161.        ch := readline(10);
  162.        if keypressed then lc := readkey;
  163.      until (ch in [Ord(ACK),Ord(CAN)]) or (counter = retrymax) or (NOT carrier);
  164.      if (ch = Ord(CAN)) or (lc = #27) then
  165.      begin
  166.         errorcode := 1;
  167.         exit;
  168.      end;        
  169.      inc(blocknum);
  170.   until eof(f) or (counter = retrymax) or (not FOS.carrier);
  171.   if counter = retrymax then
  172.   begin
  173.      Writeln(cr,lf,'No ACK on sector');
  174.      errorcode := 1;
  175.   end
  176.   else
  177.   begin
  178.      counter := 0;
  179.      repeat
  180.         send(EOT);
  181.         inc(counter);
  182.      until (readline(10)=ord(ACK)) or (counter=retrymax) or (not carrier);
  183.      if counter = retrymax then
  184.      begin
  185.         WriteLn(cr,lf,'No ACK on EOT');
  186.         errorcode := 1;
  187.      end
  188.      else
  189.      begin
  190.         WriteLn(cr,lf,'Transfer complete');
  191.         errorcode := 0;
  192.         sendxmodem := TRUE;
  193.      end;
  194.   end;
  195. end;
  196.  
  197.  
  198. FUNCTION SendXmodemCRC( var f : file ) : boolean;
  199. VAR  temp    : string[5];
  200.      counter,
  201.      result  : word;
  202.      j,k,blocknum: integer;
  203. BEGIN
  204.    blocknum := 1;
  205.    str((filesize(f) div 128):5,temp);
  206.    writeln('File open:' + temp + ' records.');
  207.    REPEAT
  208.       counter := 0;
  209.       FillChar(sector,SizeOF(sector),CPMEOF);
  210.       {$I-} Blockread(f,sector,sizeof(sector),result); {$I+}
  211.       if IOResult <> 0 THEN
  212.       begin
  213.           WriteLn('Error Reading File: CANCELLED');
  214.           Send(CAN); 
  215.           Send(CAN);
  216.           Exit;
  217.       end;
  218.       REPEAT
  219.          Write(cr,'Sending block# ',blocknum);
  220.          Send(SOH);
  221.          Send(CHR(blocknum));
  222.          Send(CHR(-blocknum-1));
  223.          SendBlk( seg(sector[0]), ofs(sector[0]), 128);
  224.          crc := 0;
  225.          Crca(sector,SizeOf(sector),crc);
  226.          Send(CHR(Hi(crc)));
  227.          Send(CHR(Lo(crc)));           
  228.          PurgeLine;
  229.          inc(counter);
  230.       UNTIL (readline(10) = Ord(ACK)) OR (counter = retrymax);
  231.       Inc(blocknum);
  232.    UNTIL EOF(f) OR (counter = retrymax) OR (NOT Carrier);
  233.    if counter = retrymax THEN
  234.        writeln(cr,lf,'No ACK on sector')
  235.    else 
  236.    begin
  237.       counter := 0;
  238.       repeat
  239.          Send(EOT);
  240.          Inc(counter);
  241.       until (readline(10)=Ord(ACK)) or (counter=retrymax);
  242.       if counter = retrymax then
  243.           writeln(cr,lf,'No ACK on EOT')
  244.       else WriteLn(cr,lf,'Transfer complete');
  245.    end;
  246. END;
  247.  
  248.  
  249. FUNCTION SendAscii(fname:string):boolean;
  250. { establish any flow control before calling this function }
  251. var thefile : TEXT;
  252.     inch,ch,lc : char;
  253. begin
  254.    SendAscii := FALSE;
  255.    ch := ' '; lc := ' ';
  256.    assign(thefile,fname);
  257.    {$I-} Reset(thefile); {$I+}
  258.    if ioresult <> 0 then begin
  259.       errorcode := 7; { file not found }
  260.       exit;
  261.    end;
  262.    repeat
  263.      read(thefile, inch);
  264.      send(inch);
  265.      if serialchar then ch := receive;
  266.      if keypressed then lc := readkey;
  267.      {
  268.      if ch = chr(ord(xoff))) then
  269.         repeat 
  270.            if serialchar then ch := receive;
  271.         until ch = chr(ord(xon));
  272.      }
  273.    until eof(thefile) OR (not carrier) or (ch = ^X) or (lc = #27);
  274.    send(^Z);
  275.    close(thefile);
  276.    SendAscii := TRUE;
  277.    errorcode := 0;
  278.    if not carrier then begin
  279.       errorcode := 3;  SendAscii := FALSE;
  280.    end else if ch = ^X then begin
  281.       errorcode := 1;  SendAscii := FALSE;
  282.    end else if lc = #27 then begin
  283.       errorcode := 2;  SendAscii := FALSE;
  284.    end;
  285. end;
  286.  
  287.  
  288. function octal( t : LongInt) : String;
  289. { FUNCTION  octal   - Returns OCTAL string of a LongInt (seconds) }
  290. var quotient, remainder : longint;
  291.     code : integer;
  292.     os : string;
  293.     ch : string[1];
  294. begin
  295.     os := '';
  296.     ch := ' ';
  297.     quotient := t;
  298.     while (quotient <> 0) do begin
  299.        quotient := quotient DIV 8;
  300.        remainder := t MOD 8;
  301.        t := quotient;
  302.        str(remainder,ch);
  303.        os := ch + os;
  304.    end;
  305.    octal := os;
  306. end;
  307.  
  308.  
  309. function leap( yr : integer) : BOOLEAN;
  310. { FUNCTION  leap    - Returns TRUE if yr is a leapyear. }
  311. begin
  312.    if (((yr mod 4 = 0) and (yr mod 100 <> 0)) or (yr mod 400 = 0)) then 
  313.       leap := TRUE 
  314.    else leap := FALSE;
  315. end;
  316.  
  317.  
  318. function since70(dt : datetime) : longint;
  319. { FUNCTION  since70 - Calculates seconds since 01/01/70 for LAST UPDATE }
  320. const month : array[1..12] of integer = (31,28,31,30,31,30,31,31,30,31,30,31);
  321. var i, leapyrs : integer;
  322.     secs, thisyear : longint;
  323. begin
  324.    leapyrs := 0;
  325.    for i := 1970 to (dt.year - 1) do if leap(i) then inc(leapyrs);
  326.    secs := (dt.year - 1970)*86400*365 + leapyrs*86400;
  327.    thisyear := (longint(dt.hour) * 60 * 60) + (dt.min * 60) + (dt.sec) +
  328.                ((dt.day - 1) * 86400);
  329.    for i := 1 to (dt.month-1) do thisyear := thisyear + (month[i]*86400);
  330.    if leap(dt.year) and (dt.month > 2) then thisyear := thisyear + 86400;
  331.    since70 := secs + thisyear;
  332. end;
  333.  
  334.  
  335. {============================== SendYmodem =============================}
  336. FUNCTION  SENDYMODEM( filename : string; var f : file ) : boolean;
  337. CONST NULL = $0;
  338. VAR block : array[0..1023] of byte; (* byte *)
  339.      temp : string[5];
  340.      j,i  : integer;
  341.     str1  : string;
  342.    ftime  : longint;
  343.    tcrc   : word;
  344.    dt : datetime;
  345.    blocknum,
  346.    counter,
  347.    result : integer;
  348. BEGIN
  349.  
  350.      (* Build Ymodem header block - block 0 *)
  351.      FillChar(sector,SizeOf(sector),NULL); { chr(0) }
  352.      for j := 0 to length(filename)-1 DO sector[j] := Ord(filename[j+1]);
  353.      inc(j);
  354.      str(FileSize(f),str1);
  355.      for i := 1 to length(str1) DO sector[j+i] := Ord(str1[i]);
  356.      j := j + i + 1;
  357.      sector[j] := $20;
  358.      GetFTime(f,ftime);
  359.      UnPackTime(ftime,dt);
  360.      str1 := Octal(Since70(dt));
  361.      For i := 1 to length(str1) do sector[j+i] := Ord(str1[i]);
  362.      sector[j+i+1] := $20;
  363.  
  364.      (* Send header packet *)
  365.      REPEAT
  366.         Send(SOH);
  367.         Send(#0);
  368.         Send(#$FF);
  369.         SendBlk(seg(sector[0]),ofs(sector[0]),128);
  370.         crc := 0;
  371.         crca(Sector,SizeOf(sector),crc);
  372.         Send(CHR(Hi(crc)));
  373.         Send(CHR(Lo(crc)));
  374.         PurgeLine;
  375.      UNTIL (readline(10) = Ord(ACK));
  376.  
  377.      blocknum := 1;
  378.      str((filesize(f) DIV 1024):5,temp);
  379.      WriteLn('File open:' + temp + ' records.');
  380.      REPEAT
  381.         counter := 0;
  382.         FillChar(block,SizeOf(block),CPMEOF);
  383.         {$I-} blockread(f,block,SizeOf(block),result); {$I+}
  384.         if IOResult <> 0 then
  385.         begin
  386.            WriteLn('Error Reading File: CANCELLED');
  387.            FOS.Send(CAN);
  388.            FOS.Send(CAN);
  389.            Exit;
  390.         end;
  391.         REPEAT
  392.            Write(cr,'Sending block: ',blocknum);
  393.            Send(STX);
  394.            Send(CHR(blocknum));
  395.            Send(CHR(-blocknum-1));
  396.            SendBlk(seg(block[0]),ofs(block[0]),1024);
  397.            crc := 0;
  398.            Crca(block,sizeof(block),crc);
  399.            Send(CHR(Hi(crc)));
  400.            Send(CHR(Lo(crc)));
  401.            PurgeLine;
  402.            Inc(counter);
  403.         UNTIL (readline(10) = Ord(ACK)) OR (counter = retrymax);
  404.         inc(blocknum);
  405.      UNTIL EOF(f) OR (counter = retrymax) OR (NOT Carrier);
  406.  
  407.      IF counter = retrymax THEN
  408.          Writeln(CR,LF,'No ACK on sector')
  409.      ELSE
  410.      BEGIN
  411.          counter := 0;
  412.          REPEAT
  413.            Send(EOT);
  414.            Inc(counter);
  415.          UNTIL (readline(10) = Ord(ACK)) or (counter=retrymax);
  416.          IF counter = retrymax THEN
  417.             WriteLn(CR,LF,'No ACK on EOT')
  418.          ELSE WriteLn(CR,LF,'Transfer complete');
  419.      END;
  420.  
  421.      (*  Send a null header block to signify end of transfer! *)
  422.      counter := 0;
  423.      REPEAT
  424.         FillChar(sector,SizeOf(sector),CHR(0));  { NULL := CHR(0) }
  425.         Send(SOH);
  426.         Send(#$00);
  427.         Send(#$FF);
  428.         SendBlk(seg(sector[0]),ofs(sector[0]),128);
  429.         crc := 0;
  430.         crca(Sector, SizeOf(sector), crc);
  431.         Send(CHR(Hi(crc)));
  432.         Send(CHR(Lo(crc)));
  433.         inc(counter);
  434.      UNTIL (Readline(10) = Ord(ACK)) or (counter = retrymax);
  435. END;
  436.  
  437.  
  438. (*  
  439.     PROCEDURE PackDateAndTime(var pd : date; dt : DateTime);
  440.     { Returns the number of seconds since 00:00:00 01/01/1970 }
  441.     CONST TDays : array[boolean,0..12] of word =
  442.            ((0,31,59,90,120,151,181,212,243,273,304,334,365),
  443.            (0,31,60,91,121,152,182,213,244,274,305,335,366));
  444.           diff  = 347155200;
  445.     VAR total,
  446.         temp   : date;
  447.         lyr    : boolean;
  448.     BEGIN
  449.        lyr := (((dt.year mod 4 = 0) and (dt.year mod 100 <>0))
  450.               or (dt.year mod 400 = 0));
  451.        dec(dt.year,1981);
  452.        total := date(dt.sec) + (dt.min * 60) + (date(dt.hour) * 3600);
  453.        temp := date(dt.year) * word(365) + (dt.year div 4);
  454.        inc(temp,TDays[lyr][dt.month-1]);
  455.        inc(temp,dt.day-1);
  456.        pd := total + (temp * 86400) + diff;
  457.     END;  {PackDateAndTime}
  458.  
  459.     crc := 0;
  460.     crca(block, SizeOf(block), crc);
  461.     Send(CHR(Hi(crc)));
  462.     Send(CHR(Lo(crc)));
  463.     BlockCRC(Seg(block),Ofs(block),1023);
  464.     Send(CHR(Hi(crc_reg_hi)));
  465.     Send(CHR(Lo(crc_reg_hi)));
  466.  
  467.     BlockCRC(Seg(sector[0]),ofs(sector[0]),127);
  468.     Send(CHR(Hi(crc_reg_hi)));
  469.     Send(CHR(Lo(crc_reg_hi)));
  470.  
  471.            {FOR j := 0 TO 1023 do begin
  472.                Send(block[j]);
  473.                updcrc(tcrc,block[j]);
  474.            end;
  475.            }
  476. *)
  477.  
  478. FUNCTION SEND1KXMODEM( var f : file ) : boolean;
  479. VAR block  : array[0..1023] of byte;
  480.     temp   : string[5];
  481.     result : word;
  482.     counter,
  483.     blocknum,
  484.     j     : integer;
  485. BEGIN
  486.    blocknum := 1;
  487.    str((filesize(f) DIV 1024):5,temp);
  488.    WriteLn(#13+#10'File open:' + temp + ' records.');
  489.    repeat
  490.      counter := 0;
  491.      FillChar(block,SizeOf(block),CPMEOF);
  492.      {$I-} blockread(f,block,SizeOf(block),result); {$I+}
  493.      if IOResult <> 0 then
  494.      begin
  495.         WriteLn('Error Reading File: CANCELLED');
  496.         Send(CAN);
  497.         Send(CAN);
  498.         Exit;
  499.      end;
  500.      repeat
  501.         Write(cr,'Sending block: ',blocknum);
  502.         Send(STX);                              {  Send(SOH);     }
  503.         Send(CHR(blocknum));
  504.         Send(CHR(-blocknum-1));                 { (-blocknum-1)); }
  505.         For j := 0 to 1023 do Send(CHR(block[j]));
  506.         crc := 0;
  507.         crca(block,1024,crc);
  508.         Send(CHR(Hi(crc)));
  509.         Send(CHR(Lo(crc)));
  510.         PurgeLine;
  511.         Inc(counter);
  512.         { ch := readline(10);  write('ch:',ch,#7); }
  513.      until (readline(10) =Ord(ACK)) OR (counter = retrymax);
  514.      WRITE(COUNTER);
  515.      inc(blocknum);
  516.    until EOF(f) OR (counter = retrymax) OR (NOT FOS.Carrier);
  517.    IF counter = retrymax THEN
  518.       Writeln(cr,lf,'No ACK on sector')
  519.    else
  520.    begin
  521.       counter := 0;
  522.       repeat
  523.          Send(EOT);
  524.          Inc(counter);
  525.       until (readline(10)=Ord(ACK)) or (counter=retrymax);
  526.       IF counter = retrymax THEN
  527.          WriteLn(cr,lf,'No ACK on EOT')
  528.       ELSE WriteLn(cr,lf,'Transfer complete');
  529.    end;
  530. end;
  531.  
  532.  
  533. {====================================================================
  534.  UPLOAD DISPATCHER
  535.  ====================================================================}
  536. FUNCTION UPLOAD(fname: string; using:protocols): boolean;
  537. VAR result   : boolean;
  538.     workfile : file;
  539.     sizeoffile : longint;
  540.     elapsed  : word;
  541. BEGIN
  542.     result := FALSE;
  543.     assign(workfile,fname);
  544.     {$I-} reset(workfile,1); {$I+}
  545.     if ioresult <> 0 then
  546.         errorcode := 7
  547.     else
  548.     begin
  549.         tickstart := systicks / 18.23;
  550.         sizeoffile:= filesize(workfile);
  551.         case using of
  552.            {Ascii       : result := SendAscii(fname);}
  553.            XmodemChkSum : result := SendXmodem( workfile );
  554.            XmodemCRC    : result := SendXmodemCRC( workfile );
  555.            Xmodem1K     : result := Send1KXmodem( workfile );
  556.            Ymodem       : result := SendYmodem(fname, workfile );
  557.         else
  558.            write('Protocol currently unavailable!',#7);
  559.         end;
  560.         close(workfile);
  561.         Upload  := result;
  562.         elapsed := trunc(Eltime( tickstart, (systicks/18.23) ));
  563.         writeln('Elapsed Seconds: ', elapsed );
  564.         cps     := sizeoffile / elapsed;
  565.         writeln('Cps: ', cps:7:2)
  566.     end;
  567. END;
  568.  
  569.  
  570. {==========================================================================
  571.   Receive protocols and dispatcher follow
  572. ===========================================================================}
  573. FUNCTION recvascii(fname:string) : boolean;
  574. var  lc,rc:char;
  575.      textfile : TEXT;
  576. begin
  577.   recvascii := FALSE;
  578.   lc := ' ';
  579.   rc := ' ';
  580.   assign(textfile,fname);
  581.   {$I-} Reset(textfile); {$I+}
  582.   if (IOResult = 0) then begin
  583.      close(textfile);
  584.      errorcode := 6;
  585.      exit;
  586.   end;
  587.   rewrite(textfile);
  588.   SendText('Ends on Ctrl-Z, Abort with Ctrl-X');
  589.   Writeln('Type ^X to exit ASCII receive');
  590.   repeat
  591.     If SerialChar THEN rc := Receive;
  592.     If Keypressed THEN lc := ReadKey;
  593.     Write(textfile,rc);
  594.   until (rc = ^Z) OR (rc = ^X) OR (lc = #27) OR (NOT Carrier);
  595.   close(textfile);
  596.   if rc = ^Z then begin
  597.      errorcode := 0;
  598.      recvascii := TRUE;
  599.      exit;
  600.   end;
  601.   if rc = ^X then errorcode := 1
  602.   else if lc = #27 then errorcode := 2
  603.   else if NOT carrier then errorcode := 3;
  604.   erase(textfile);
  605. end;
  606.  
  607.  
  608. FUNCTION RecvXmodem(fname:string) : boolean;
  609. VAR j,
  610.     firstchar,
  611.     sectornum,
  612.     sectorcurrent,
  613.     sectorcomp,
  614.     errors,
  615.     checksum  : integer;
  616.     errorflag : boolean;
  617.     c         : char;
  618.     workfile  : file;
  619.  
  620. begin
  621.    RecvXmodem := FALSE;
  622.    assign(workfile,fname);
  623.    rewrite(workfile);
  624.    if Ioresult <> 0 then begin
  625.       errorcode := 6;
  626.       exit;
  627.    end;
  628.    sectornum := 0;
  629.    errors := 0;
  630.    send(NAK);
  631.    send(NAK);                       (* send ready characters *)
  632.    repeat
  633.      errorflag := false;
  634.      repeat
  635.        firstchar := readline(20);
  636.      until ((firstchar IN [Ord(SOH),Ord(EOT)]) OR
  637.            (firstchar = timeout)) OR (Not Carrier);
  638.      if NOT Carrier THEN begin
  639.         errorcode := 3;
  640.         exit;
  641.      end;
  642.      IF firstchar = timeout THEN Writeln(cr,lf,'Error - No starting SOH');
  643.      IF firstchar = Ord(SOH) THEN BEGIN
  644.         sectorcurrent := Readline(1);      {real sector number}
  645.         sectorcomp    := Readline(1);      {+ inverse of above}
  646.         IF (sectorcurrent+sectorcomp) = 255 THEN BEGIN {< becomes this #}
  647.            IF (sectorcurrent=sectornum+1) THEN BEGIN
  648.               checksum := 0;
  649.               ReadBlk(seg(sector[0]),ofs(sector[0]),128);
  650.               for j:= 0 to lastbyte do 
  651.                   checksum := (checksum+sector[j]) mod 256;
  652.               IF checksum = Readline(1) THEN BEGIN
  653.                  blockwrite(WorkFile,sector,1);
  654.                  errors := 0;
  655.                  sectornum := sectorcurrent;
  656.                  write(cr,'Received sector ',sectorcurrent);
  657.                  send(ACK)
  658.               END ELSE BEGIN
  659.                  writeln(cr,lf,'Checksum error');
  660.                  errorflag := true
  661.               END
  662.            END ELSE IF (sectorcurrent=sectornum) THEN BEGIN
  663.               REPEAT
  664.               UNTIL Readline(1) = timeout;
  665.               Writeln(cr,lf,'Received duplicate sector ', sectorcurrent);
  666.               Send(ack)
  667.            END ELSE BEGIN
  668.               Writeln(cr,lf,'Synchronization error');
  669.               errorflag := true
  670.            END
  671.         END else BEGIN
  672.            Writeln(cr,lf,'Sector number error');
  673.            errorflag := true
  674.         END
  675.      END;
  676.      IF errorflag THEN BEGIN
  677.         inc(errors);
  678.         REPEAT UNTIL Readline(1) = timeout;
  679.         send(nak)
  680.      END;
  681.    UNTIL ((firstchar = Ord(EOT)) OR (firstchar = timeout)) OR
  682.          (errors = errormax) OR (NOT Carrier);
  683.  
  684.    IF (firstchar = Ord(EOT)) AND (errors < errormax) THEN BEGIN
  685.       send(ack);
  686.       Writeln(cr,lf,'Transfer complete');
  687.       errorcode := 0; recvxmodem := TRUE;
  688.    end else if (errors > errormax) then begin
  689.       Writeln(cr,lf,'Aborting');
  690.       errorcode := 1;
  691.    end else if not carrier then begin
  692.       errorcode := 3;
  693.    end;
  694. end;
  695.  
  696.  
  697. {====================================================================
  698.  DOWNLOAD DISPATCHER
  699.  ====================================================================}
  700. function DownLoad(fname: string; using:protocols): boolean;
  701. var result : boolean;
  702. begin
  703.    result := FALSE;
  704.    case using of
  705.       ascii : result := RecvAscii(fname);
  706.       xmodemchksum : result := RecvXmodem(fname);
  707.      {
  708.      xmodemcrc     : result := RecvXmodemCRC(fname);
  709.      }
  710.    else
  711.       write('protocol currently unavailable');
  712.    end;
  713.    DownLoad := result;
  714. end;
  715.  
  716. { initialization code }
  717. begin
  718.      checkbreak := false;
  719. end.
  720.