home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SLINK.ZIP / SLINK.PAS
Encoding:
Pascal/Delphi Source File  |  1988-04-12  |  17.0 KB  |  703 lines
  1. (*$R-,V-,S-*)
  2.  
  3.  
  4. CONST
  5.    progname : STRING  = ''; { the name of the main program - 14 chars max }
  6.    seatalk: BOOLEAN = TRUE;  { display of messages toggle }
  7.    rawblk: INTEGER = 0;
  8.    ackless : INTEGER = 0;
  9.  
  10. TYPE
  11.    zeros = RECORD
  12.               flen,
  13.               fstamp: LONGINT;
  14.               fnam: ARRAY[0..16] OF BYTE;
  15.               prog: ARRAY[0..14] OF BYTE;
  16.               noacks: BYTE;
  17.               fill: ARRAY[0..86] OF BYTE
  18.            END;
  19.    secbuf = ARRAY[0..127] OF BYTE;
  20.  
  21. VAR
  22.    outblk, ackblk, blksnt, ackst, ackrep,
  23.    numnak, chktec, toterr, slide, ackseen: INTEGER;
  24.    starttime, endtime: LONGINT;
  25.  
  26. CONST
  27.    crctab: ARRAY[0..255] OF WORD =(
  28.     $0000,  $1021,  $2042,  $3063,  $4084,  $50a5,  $60c6,  $70e7,
  29.     $8108,  $9129,  $a14a,  $b16b,  $c18c,  $d1ad,  $e1ce,  $f1ef,
  30.     $1231,  $0210,  $3273,  $2252,  $52b5,  $4294,  $72f7,  $62d6,
  31.     $9339,  $8318,  $b37b,  $a35a,  $d3bd,  $c39c,  $f3ff,  $e3de,
  32.     $2462,  $3443,  $0420,  $1401,  $64e6,  $74c7,  $44a4,  $5485,
  33.     $a56a,  $b54b,  $8528,  $9509,  $e5ee,  $f5cf,  $c5ac,  $d58d,
  34.     $3653,  $2672,  $1611,  $0630,  $76d7,  $66f6,  $5695,  $46b4,
  35.     $b75b,  $a77a,  $9719,  $8738,  $f7df,  $e7fe,  $d79d,  $c7bc,
  36.     $48c4,  $58e5,  $6886,  $78a7,  $0840,  $1861,  $2802,  $3823,
  37.     $c9cc,  $d9ed,  $e98e,  $f9af,  $8948,  $9969,  $a90a,  $b92b,
  38.     $5af5,  $4ad4,  $7ab7,  $6a96,  $1a71,  $0a50,  $3a33,  $2a12,
  39.     $dbfd,  $cbdc,  $fbbf,  $eb9e,  $9b79,  $8b58,  $bb3b,  $ab1a,
  40.     $6ca6,  $7c87,  $4ce4,  $5cc5,  $2c22,  $3c03,  $0c60,  $1c41,
  41.     $edae,  $fd8f,  $cdec,  $ddcd,  $ad2a,  $bd0b,  $8d68,  $9d49,
  42.     $7e97,  $6eb6,  $5ed5,  $4ef4,  $3e13,  $2e32,  $1e51,  $0e70,
  43.     $ff9f,  $efbe,  $dfdd,  $cffc,  $bf1b,  $af3a,  $9f59,  $8f78,
  44.     $9188,  $81a9,  $b1ca,  $a1eb,  $d10c,  $c12d,  $f14e,  $e16f,
  45.     $1080,  $00a1,  $30c2,  $20e3,  $5004,  $4025,  $7046,  $6067,
  46.     $83b9,  $9398,  $a3fb,  $b3da,  $c33d,  $d31c,  $e37f,  $f35e,
  47.     $02b1,  $1290,  $22f3,  $32d2,  $4235,  $5214,  $6277,  $7256,
  48.     $b5ea,  $a5cb,  $95a8,  $8589,  $f56e,  $e54f,  $d52c,  $c50d,
  49.     $34e2,  $24c3,  $14a0,  $0481,  $7466,  $6447,  $5424,  $4405,
  50.     $a7db,  $b7fa,  $8799,  $97b8,  $e75f,  $f77e,  $c71d,  $d73c,
  51.     $26d3,  $36f2,  $0691,  $16b0,  $6657,  $7676,  $4615,  $5634,
  52.     $d94c,  $c96d,  $f90e,  $e92f,  $99c8,  $89e9,  $b98a,  $a9ab,
  53.     $5844,  $4865,  $7806,  $6827,  $18c0,  $08e1,  $3882,  $28a3,
  54.     $cb7d,  $db5c,  $eb3f,  $fb1e,  $8bf9,  $9bd8,  $abbb,  $bb9a,
  55.     $4a75,  $5a54,  $6a37,  $7a16,  $0af1,  $1ad0,  $2ab3,  $3a92,
  56.     $fd2e,  $ed0f,  $dd6c,  $cd4d,  $bdaa,  $ad8b,  $9de8,  $8dc9,
  57.     $7c26,  $6c07,  $5c64,  $4c45,  $3ca2,  $2c83,  $1ce0,  $0cc1,
  58.     $ef1f,  $ff3e,  $cf5d,  $df7c,  $af9b,  $bfba,  $8fd9,  $9ff8,
  59.     $6e17,  $7e36,  $4e55,  $5e74,  $2e93,  $3eb2,  $0ed1,  $1ef0
  60. );
  61.  
  62. FUNCTION Com_GetC(tenths: INTEGER): INTEGER;
  63.  
  64. VAR
  65.    n: INTEGER;
  66.  
  67. BEGIN
  68.    tenths := (tenths DIV 10);
  69.    Async_Receive_With_Timeout(tenths,n);
  70.    IF (n >= 256) THEN
  71.       Com_GetC := -1
  72.    ELSE
  73.       Com_GetC := (n AND $00FF)
  74. END;
  75.  
  76. PROCEDURE Com_PutC(b: BYTE);
  77.  
  78. BEGIN
  79.    Async_Send(Chr(b))
  80. END;
  81.  
  82. PROCEDURE Com_Flush;
  83.  
  84. BEGIN
  85.    Async_Flush_Output_Buffer
  86. END;
  87.  
  88. FUNCTION Com_Peek: INTEGER;
  89.  
  90. BEGIN
  91.    Com_Peek := Ord(Async_Peek(0))
  92. END;
  93.  
  94. FUNCTION UpdCrc(cp: BYTE; crc: INTEGER): INTEGER;
  95. BEGIN
  96.    UpdCrc := (crctab[((crc SHR 8) AND 255)] XOR (crc SHL 8) XOR cp)
  97. END;
  98.  
  99.  
  100. PROCEDURE Message(s: STRING; n: INTEGER);
  101.  
  102. BEGIN
  103.    WRITE(#13,'SeaLink - ',s:25);
  104.    IF (n >= 0) THEN
  105.       WRITE(' [ ',n:3,' ] ')
  106.    ELSE
  107.       WRITE('':9)
  108. END;
  109.  
  110. FUNCTION FromAsciiZ(VAR a): STRING;
  111.  
  112. VAR
  113.    s: STRING;
  114.    ar: ARRAY[0..255] OF CHAR ABSOLUTE a;
  115.    p: WORD;
  116.  
  117. BEGIN
  118.    p := 0;
  119.    WHILE (ar[p] <> #0) AND (p <= 255) DO
  120.    BEGIN
  121.       s[p+1] := ar[p];
  122.       Inc(p)
  123.    END;
  124.    s[0] := Chr(p);
  125.    FromAsciiZ := s
  126. END;
  127.  
  128. PROCEDURE ToAsciiZ(VAR a; s: STRING; maxlen: INTEGER);
  129.  
  130. VAR
  131.   ar: ARRAY[0..255] OF CHAR ABSOLUTE a;
  132.   p:  WORD;
  133.  
  134. BEGIN
  135.    IF (maxlen < 0) THEN
  136.       maxlen := 0;
  137.    IF (maxlen > 255) THEN
  138.       maxlen := 255;
  139.    IF (Length(s) > maxlen) THEN
  140.       s[0] := Chr(maxlen);
  141.    FillChar(ar,maxlen,0);
  142.    Move(s[1],ar[0],Length(s))
  143. END;
  144.  
  145. FUNCTION TimerSet(tenths: INTEGER): LONGINT;
  146.  
  147. VAR
  148.    h,m,s,hn: WORD;
  149.  
  150. BEGIN
  151.    GetTime(h,m,s,hn);
  152.    TimerSet := (LONGINT(h)*36000)+(LONGINT(m)*600)+(LONGINT(s)*10)+(LONGINT(tenths))+(LONGINT(hn) DIV 10)
  153. END;
  154.  
  155. FUNCTION TimeUp(time: LONGINT): BOOLEAN;
  156.  
  157. BEGIN
  158.    TimeUp := (TimerSet(0) >= time)
  159. END;
  160.  
  161. PROCEDURE AckChk;
  162.  
  163. VAR
  164.    c: INTEGER;
  165.  
  166. BEGIN
  167.    ackrep := 0;
  168.    c := Com_GetC(20);
  169.    WHILE (c >= 0) DO
  170.    BEGIN
  171.       IF (KeyPressed) THEN
  172.          IF (ReadKey IN [^[,^X]) THEN
  173.          BEGIN
  174.             numnak := 50;
  175.             Exit
  176.          END;
  177.       IF (ackst = 3) OR (ackst = 4) THEN
  178.       BEGIN
  179.          slide := 0;
  180.          IF (rawblk = (c XOR $FF)) THEN
  181.          BEGIN
  182.             rawblk := outblk - ((outblk - rawblk) AND $FF);
  183.             IF (rawblk >= 0) AND (rawblk <= outblk) AND (rawblk > outblk - 128) THEN
  184.             BEGIN
  185.                IF (ackst = 3) THEN
  186.                BEGIN
  187.                   IF (ackblk <= rawblk) THEN
  188.                      ackblk := rawblk;
  189.                   slide := 1;
  190.                   Inc(ackseen);
  191.                   IF (ackless <> 0) AND (ackseen > 10) THEN
  192.                   BEGIN
  193.                      ackless := 0;
  194.                      Message('Overdrive disengaged',0)
  195.                   END;
  196.                   Message('ACK',rawblk)
  197.                END
  198.                ELSE
  199.                BEGIN
  200.                   IF (rawblk < 0) THEN
  201.                      outblk := 0
  202.                   ELSE
  203.                      outblk := rawblk;
  204.                   IF (numnak < 4) THEN
  205.                      slide := 1
  206.                   ELSE
  207.                      slide := 0;
  208.                   Message('NAK',rawblk)
  209.                END;
  210.                ackrep := 1
  211.             END
  212.          END;
  213.          ackst := 0;
  214.          Exit
  215.       END;
  216.       IF (ackst = 1) OR (ackst = 2) THEN
  217.       BEGIN
  218.          rawblk := c;
  219.          Inc(ackst,2)
  220.       END;
  221.       IF (ackst = 0) OR (slide = 0) THEN
  222.       BEGIN
  223.          IF (c = 6) THEN
  224.          BEGIN
  225.             IF (slide = 0) THEN
  226.             BEGIN
  227.                Inc(ackblk);
  228.                ackrep := 1;
  229.                Message('ACK',ackblk)
  230.             END;
  231.             ackst := 1;
  232.             numnak := 0
  233.          END
  234.          ELSE IF (c = Ord('C')) OR (c = 21) THEN
  235.          BEGIN
  236.             IF (chktec > 1) THEN
  237.                IF (c = 21) THEN
  238.                   chktec := 0
  239.                ELSE
  240.                   chktec := 1;
  241.             Com_Flush;
  242.             Delay(6);
  243.             IF (slide = 0) THEN
  244.             BEGIN
  245.                outblk := ackblk + 1;
  246.                ackrep := 1;
  247.                Message('NAK',ackblk+1)
  248.             END;
  249.             ackst := 2;
  250.             Inc(numnak);
  251.             IF (blksnt <> 0) THEN
  252.                Inc(toterr)
  253.          END
  254.       END;
  255.       IF (ackst = 5) THEN
  256.          ackst := 0;
  257.       c := Com_GetC(20)
  258.    END
  259. END;
  260.  
  261. FUNCTION GetBlock(VAR buf: secbuf): STRING;
  262.  
  263. VAR
  264.    ourcrc, hiscrc, c, n, timeout: INTEGER;
  265.  
  266. BEGIN
  267.    ourcrc := 0;
  268.    IF (ackless = 0) THEN
  269.       timeout := 1
  270.    ELSE
  271.       timeout := 20;
  272.    FOR n := 0 TO 127 DO
  273.    BEGIN
  274.       c := Com_GetC(10);
  275.       IF (c = -1) THEN
  276.       BEGIN
  277.          GetBlock := 'Short';
  278.          Exit
  279.       END;
  280.       IF (chktec <> 0) THEN
  281.          ourcrc := UpdCrc(c,ourcrc)
  282.       ELSE
  283.          ourcrc := ourcrc + c;
  284.       buf[n] := BYTE(c)
  285.    END;
  286.    IF (chktec <> 0) THEN
  287.    BEGIN
  288.       c := Com_GetC(10);
  289.       ourcrc := UpdCrc(c,ourcrc);
  290.       c := Com_GetC(10);
  291.       ourcrc := UpdCrc(c,ourcrc);
  292.       IF (ourcrc = 0) THEN
  293.          GetBlock := ''
  294.       ELSE
  295.          GetBlock := 'CRC';
  296.       Exit
  297.    END;
  298.    ourcrc := ourcrc AND $FF;
  299.    hiscrc := Com_GetC(1) AND $FF;
  300.    IF (hiscrc = ourcrc) THEN
  301.       GetBlock := ''
  302.    ELSE
  303.       GetBlock := 'Check'
  304. END;
  305.  
  306. PROCEDURE SendAck(acknak, blknum: INTEGER);
  307.  
  308. BEGIN
  309.    IF (acknak <> 0) THEN
  310.       Com_PutC(6)
  311.    ELSE IF (chktec <> 0) THEN
  312.       Com_PutC(Ord('C'))
  313.    ELSE
  314.       Com_PutC(21);
  315.    Com_PutC(BYTE(blknum));
  316.    Com_PutC(BYTE(blknum XOR $FF))
  317. END;
  318.  
  319. PROCEDURE RxSeaLink(path: STRING; overdrive: BOOLEAN);
  320.  
  321. LABEL
  322.    nakblock, ackblock, nextblock, blockstart, endrcv, abort;
  323.  
  324. VAR
  325.    sr: SearchRec;
  326.    c, tries, blknum, inblk, endblk, n: INTEGER;
  327.    t1, left: LONGINT;
  328.    f: FILE;
  329.    zero: zeros;
  330.    name, pname, stat, why: STRING;
  331.    buff: secbuf;
  332.  
  333. BEGIN
  334.    IF (path[Length(path)] <> '\') THEN
  335.       path := path + '\';
  336.    Assign(f,path+'-TMPFILE.$$$');
  337.    {$I-} ReWrite(f,WORD(1)); {$I+}
  338.    IF (IOresult <> 0) THEN
  339.    BEGIN
  340.       Message('Cannot create '+path+'-TMPFILE.$$$',-1);
  341.       Exit
  342.    END;
  343.    stat := 'Init';
  344.    blknum := 0;
  345.    tries := -10;
  346.    chktec := 1;
  347.    toterr := 0;
  348.    endblk := 0;
  349.    ackless := 0;
  350.    FillChar(zero,128,0);
  351.    starttime := TimerSet(0);
  352.    IF (Com_Peek = 1) THEN
  353.       GOTO nextblock;
  354. nakblock:
  355.    IF (blknum > 1) THEN
  356.       Inc(toterr);
  357.    Inc(tries);
  358.    IF (tries > 10) THEN
  359.    BEGIN
  360.       Message('Too many errors',-1);
  361.       GOTO abort
  362.    END;
  363.    IF (tries = 0) THEN
  364.       chktec := 0;
  365.    SendAck(0,blknum);
  366.    Message('NAK '+stat,blknum);
  367.    IF (ackless <> 0) AND (toterr > 20) THEN
  368.    BEGIN
  369.       ackless := 0;
  370.       Message('Overdrive disengaged',-1)
  371.    END;
  372.    GOTO nextblock;
  373. ackblock:
  374.    IF (ackless = 0) THEN
  375.       Message('ACK',blknum-1)
  376.    ELSE IF ((blknum MOD 10) = 0) THEN
  377.       Message('Got block',blknum);
  378. nextblock:
  379.    stat := '';
  380.    IF (NOT (Async_Carrier_Detect)) THEN
  381.    BEGIN
  382.       Message('Lost carrier',-1);
  383.       GOTO abort
  384.    END;
  385.    IF (KeyPressed) THEN
  386.       IF (ReadKey IN [^X,^[]) THEN
  387.       BEGIN
  388.          Message('Aborted by operator',-1);
  389.          GOTO abort
  390.       END;
  391.    t1 := timerset(30);
  392.    WHILE (NOT (TimeUp(t1))) DO
  393.    BEGIN
  394.       c := Com_GetC(0);
  395.       IF (c = 4) AND ((endblk = 0) OR (endblk = blknum)) THEN
  396.          GOTO endrcv;
  397.       IF (c = 1) THEN
  398.       BEGIN
  399.          inblk := Com_GetC(5);
  400.          IF (Com_GetC(5) = (inblk XOR $FF)) THEN
  401.             GOTO blockstart
  402.       END
  403.    END;
  404.    stat := 'Time';
  405.    GOTO nakblock;
  406. blockstart:
  407.    c := blknum AND $FF;
  408.    IF (inblk = 0) AND (blknum <= 1) THEN
  409.    BEGIN
  410.       why := GetBlock(buff);
  411.       IF (why = '') THEN
  412.       BEGIN
  413.          SendAck(1,inblk);
  414.          Move(buff,zero,128);
  415.          left := zero.flen;
  416.          name := FromAsciiZ(zero.fnam);
  417.          pname := FromAsciiZ(zero.prog);
  418.          ackless := (zero.noacks) AND (BYTE(overdrive));
  419.          IF (left > 0) THEN
  420.             endblk := (left + 127) DIV 128 + 1;
  421.          IF (noacks <> 0) THEN
  422.             Message('Overdrive engaged',-1)
  423.          ELSE
  424.             Message('Overdrive engaged',-1);
  425.          IF (endblk <> 0) AND (seatalk) THEN
  426.          BEGIN
  427.             WRITELN;
  428.             WRITELN('Receiving ',endblk-1,' blocks of ',name,' from ',pname);
  429.          END;
  430.          blknum := 1;
  431.          GOTO ackblock
  432.       END
  433.       ELSE
  434.       BEGIN
  435.          stat := why;
  436.          GOTO nakblock
  437.       END
  438.    END
  439.    ELSE IF (inblk = c) THEN
  440.    BEGIN
  441.       why := GetBlock(buff);
  442.       IF (why = '') THEN
  443.       BEGIN
  444.          IF (ackless = 0) THEN
  445.             SendAck(1,inblk);
  446.          {$I-} BlockWrite(f,buff,128); {$I+}
  447.          left := left - 128;
  448.          IF (IOresult <> 0) THEN
  449.          BEGIN
  450.             Message('Write error (disk full?)',-1);
  451.             Delay(1000);
  452.             GOTO abort
  453.          END;
  454.          tries := 0;
  455.          Inc(blknum);
  456.          GOTO ackblock
  457.       END
  458.       ELSE
  459.       BEGIN
  460.          stat := why;
  461.          GOTO nakblock
  462.       END
  463.    END
  464.    ELSE IF (inblk < c) OR (inblk > c + 100) THEN
  465.    BEGIN
  466.       why := GetBlock(buff);
  467.       SendAck(1,inblk);
  468.       stat := 'Dup';
  469.       GOTO ackblock
  470.    END
  471.    ELSE
  472.       GOTO nextblock;
  473. endrcv:
  474.    SendAck(0,blknum);
  475.    Message('NAK EOT',-1);
  476.    IF (Com_GetC(20) <> 4) THEN
  477.       GOTO nakblock;
  478.    SendAck(1,blknum);
  479.    Message('ACK EOT',-1);
  480.    endtime := zero.flen DIV ((TimerSet(0) - starttime) DIV 10);
  481. abort:
  482.    IF (zero.fstamp > 0) THEN
  483.    BEGIN
  484.       SetFtime(f,zero.fstamp);
  485.       IF (DosError <> 0) THEN
  486.          Message('Unable to date file',-1)
  487.    END;
  488.    {$I-} Close(f); {$I+}
  489.    IF (IOresult = 0) AND (blknum > 1) THEN
  490.    BEGIN
  491.       FindFirst(path+name,AnyFile,sr);
  492.       IF (DosError = 0) THEN
  493.          name[1] := '-';
  494.       {$I-} Rename(f,name); {$I+}
  495.       IF (IOresult <> 0) THEN
  496.          Message('Unable to rename file',-1)
  497.    END;
  498.    IF (blknum = 0) THEN
  499.       Message('No file received',-1)
  500. END;
  501.  
  502. PROCEDURE ShipBlk(VAR blk: secbuf; blknum: INTEGER);
  503.  
  504. VAR
  505.    n, crc: INTEGER;
  506.  
  507. BEGIN
  508.    crc := 0;
  509.    Com_PutC(1);
  510.    Com_PutC(BYTE(blknum));
  511.    Com_PutC(BYTE(blknum) XOR $FF);
  512.    FOR n := 0 TO 127 DO
  513.    BEGIN
  514.       IF (chktec <> 0) THEN
  515.          crc := UpdCrc(blk[n],crc)
  516.       ELSE
  517.          crc := crc + blk[n];
  518.       Com_PutC(blk[n])
  519.    END;
  520.    IF (chktec <> 0) THEN
  521.    BEGIN
  522.       crc := UpdCrc(0,crc);
  523.       crc := UpdCrc(0,crc);
  524.       Com_PutC(BYTE(crc SHR 8));
  525.       Com_PutC(BYTE(crc) AND $FF)
  526.    END
  527.    ELSE
  528.       Com_PutC(BYTE(crc))
  529. END;
  530.  
  531. PROCEDURE SendBlk(VAR f: FILE; blknum: INTEGER);
  532.  
  533. VAR
  534.    buff: secbuf;
  535.    blkloc: LONGINT;
  536.  
  537. BEGIN
  538.    IF (blknum <> (blksnt+1)) THEN
  539.    BEGIN
  540.       blkloc := LONGINT(blknum-1) * LONGINT(128);
  541.       {$I-} Seek(f,blkloc); {$I+}
  542.       IF (IOresult <> 0) THEN
  543.          Message('Error seeking block',blknum-1)
  544.    END;
  545.    blksnt := blknum;
  546.    FillChar(buff,128,0);
  547.    {$I-} BlockRead(f,buff,128); {$I+}
  548.    IF (IOresult <> 0) THEN
  549.       Message('Error reading block',blknum);
  550.    ShipBlk(buff,blknum)
  551. END;
  552.  
  553. PROCEDURE TxSeaLink(pathname: STRING; overdrive: BOOLEAN);
  554.  
  555. LABEL
  556.    abort1;
  557.  
  558. VAR
  559.    f: FILE;
  560.    t1: LONGINT;
  561.    endblk: INTEGER;
  562.    sr: SearchRec;
  563.    zero: zeros;
  564.    buff: secbuf;
  565.  
  566. BEGIN
  567.    IF (pathname <> '') THEN
  568.    BEGIN
  569.       FindFirst(pathname,Archive,sr);
  570.       IF (DosError <> 0) THEN
  571.       BEGIN
  572.          Message('No file found',-1);
  573.          Exit
  574.       END;
  575.       FillChar(zero,128,0);
  576.       WITH sr,zero DO
  577.       BEGIN
  578.          flen := Size;
  579.          fstamp := Time;
  580.          IF (overdrive) THEN
  581.             noacks := 1;
  582.          Move(Name[1],fnam[0],Length(Name));
  583.          IF (Length(progname) >= 14) THEN
  584.             Move(progname[1],prog[0],14)
  585.          ELSE
  586.             Move(progname[1],prog[0],Length(progname));
  587.          Move(zero,buff,128)
  588.       END;
  589.       Assign(f,pathname);
  590.       {$I-} Reset(f,WORD(1)); {$I+}
  591.       IF (IOresult <> 0) THEN
  592.       BEGIN
  593.          Message('Unable to open file',-1);
  594.          Exit
  595.       END;
  596.       endblk := INTEGER((zero.flen + 127) DIV 128) + 1;
  597.       IF (seatalk) THEN
  598.       BEGIN
  599.          WRITELN;
  600.          WRITELN('Ready to send ',endblk-1,' blocks of ',sr.name)
  601.       END
  602.    END
  603.    ELSE
  604.       endblk := 0;
  605.    outblk := 1;
  606.    ackblk := -1;
  607.    blksnt := 0;
  608.    slide := 0;
  609.    ackst := 0;
  610.    numnak := 0;
  611.    toterr := 0;
  612.    ackrep := 0;
  613.    ackseen := 0;
  614.    chktec := 2;
  615.    ackless := BYTE(overdrive);
  616.    t1 := TimerSet(300);
  617.    Message('Waiting',-1);
  618.    WHILE (ackblk < endblk) DO
  619.    BEGIN
  620.       IF (NOT (Async_Carrier_Detect)) THEN
  621.       BEGIN
  622.          Message('Lost carrier',-1);
  623.          GOTO abort1
  624.       END;
  625.       IF (KeyPressed) THEN
  626.          IF (ReadKey IN [^X,^[]) THEN
  627.          BEGIN
  628.             Message('Aborted by operator',-1);
  629.             GOTO abort1
  630.          END;
  631.       IF (TimeUp(t1)) THEN
  632.       BEGIN
  633.          Message('Fatal timeout',-1);
  634.          GOTO abort1
  635.       END;
  636.       IF ((slide <> 0) AND (outblk <= (ackblk + 6))) OR
  637.       ((slide = 0) AND (outblk <= (ackblk + 1))) THEN
  638.       BEGIN
  639.          IF (outblk < endblk) THEN
  640.          BEGIN
  641.             IF (outblk > 0) THEN
  642.                SendBlk(f,outblk)
  643.             ELSE
  644.                ShipBlk(buff,0);
  645.             IF (ackrep <> 0) THEN
  646.                Message('Sending block',outblk);
  647.             IF (ackless <> 0) AND (slide <> 0) THEN
  648.             BEGIN
  649.                IF ((outblk MOD 10) = 0) THEN
  650.                   Message('Passing block',outblk);
  651.                ackblk := outblk
  652.             END
  653.          END
  654.          ELSE IF (outblk = endblk) THEN
  655.          BEGIN
  656.             Com_PutC(4);
  657.             IF (ackrep <> 0) THEN
  658.                Message('Sending EOT',-1)
  659.          END;
  660.          Inc(outblk);
  661.          t1 := TimerSet(30)
  662.       END;
  663.       ackchk;
  664.       IF (numnak > 10) THEN
  665.       BEGIN
  666.          Message('Too many errors',-1);
  667.          GOTO abort1
  668.       END
  669.    END;
  670.    Message('End of file',-1);
  671. abort1:
  672.    IF (endblk <> 0) THEN
  673.    BEGIN
  674.       {$I-} Close(f); {$I+}
  675.       IF (IOresult <> 0) THEN
  676.          {null};
  677.       endtime := zero.flen DIV ((TimerSet(0) - starttime) DIV 10)
  678.    END
  679.    ELSE
  680.    BEGIN
  681.       FOR endblk := 1 TO 5 DO
  682.          Com_PutC(4);
  683.       FOR endblk := 1 TO 5 DO
  684.          Com_PutC(24)
  685.    END
  686. END;
  687.  
  688.  
  689. PROCEDURE RxSeaLink;
  690.  
  691. BEGIN
  692.    GetSeaLink;
  693.    Delay(3000)
  694. END;
  695.  
  696. PROCEDURE TxSeaLink;
  697.  
  698. BEGIN
  699.    PutSeaLink;
  700.    Delay(3000)
  701. END;
  702.  
  703.