home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3sar.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  30KB  |  725 lines
  1. Unit SendRecv ;
  2. Interface
  3.   Uses Dos,Crt,Printer,   (* Standard Turbo Pascal Units *)
  4.        KGlobals,
  5.        ModemPro,
  6.        Packets ;
  7.   (* Global procedures *)
  8.      PROCEDURE SENDFILE (var InParms : String);
  9.      PROCEDURE BreakACK (Achar : Char);
  10.      PROCEDURE RECVFILE (var InParms : String);
  11. Implementation
  12. (* **************************************************************** *)
  13. (* SENDFILE  - This routine handles the sending of a file from    * *)
  14. (*             the micro computer.                                * *)
  15. (* **************************************************************** *)
  16.  
  17.  PROCEDURE SENDFILE (var InParms : String);
  18.  
  19.  VAR
  20.     SENDING, GETREPLY, LastFile, rawfile    : Boolean ;
  21.     abyte, Kchar,Kbchar : byte ;
  22.     DiskDrive : String [2] ;
  23.     MyFiles  : string ;
  24.     FileName,AsFileNames,AsFileName,
  25.     Atoken,Tempname                : string ;
  26.     FileInfo : SearchRec ;
  27.     achar,prevchar : char ;
  28.     ErrorMsg                : String[80];
  29.     IOerror : Integer ;
  30.     PacketCount,i,ix,MaxOutData,RepCount,MarkOutCount  : Integer ;
  31.     Fsize,BytesSent : longint ;
  32.     FileBuffer : array [1..Buffersize] of char ;
  33.     FileToSend : text ;
  34.  
  35. Label subdir,subdir1,GetAsName,GetNextFile,Quoting,Exit ;
  36.  
  37.  
  38.     (* --------------------------------------------------- *)
  39.     (* SENDRAW - This routine send the file in unpacket    *)
  40.     (*           mode, Simply read and send.               *)
  41.     (* --------------------------------------------------- *)
  42.     Procedure SENDRAW ;
  43.     Begin (* SendRaw Procedure *)
  44.     Sending := true ;
  45.     While Sending Do
  46.          Begin (* Send a file *)
  47.          ClrScr; Writeln('       Sending File >>>>>>> ',Filename,' <<<<<<< ');
  48.          Assign(FileToSend,FileName);
  49.          SetTextBuf(FileToSend,FileBuffer);
  50.          RESET(FileToSend) ;
  51.          While not Eof(FileToSend) do
  52.               Begin (* Send data *)
  53.               Read(FileToSend,Achar);
  54.               SendChar(ord(achar));
  55.               If LocalEcho then Write(achar)
  56.                            else If Readchar(abyte) then Write(chr(abyte));
  57.               If XonXoff and (abyte = $0D) then  (* wait for Xon *)
  58.                   While abyte<>XON do
  59.                         If Readchar(abyte) then
  60.                                            else abyte := xon ;
  61.               End ; (* Send data *)
  62.          (*$I- *) CLOSE(FileToSend); (*$I+ *)
  63.          IOerror := IOResult ;
  64.          If (IOerror <> 0) and (IOerror<>103) then
  65.                writeln('Close Error ',IOerror);
  66.    (*     Sending := Nextfile(Myfiles,Filename,FileInfo);  *)
  67.          End ; (* Send a file *)
  68.     Writeln(' ');
  69.     End ; (* SendRaw Procedure *)
  70.  
  71. (* **************************************************************** *)
  72.  
  73.     BEGIN (* SENDFILE procedure *)
  74.     rawfile := false ;
  75.     RetryCount := 0 ;
  76.   (* Check the file to be sent here *)
  77.     If length(InParms) < 1 then
  78.          Begin (* Get name of file to send *)
  79.          Write  (' Enter name of file to be sent >');
  80.          Readln(InParms);
  81.          End;
  82.     MyFiles := '                                     ';
  83.     MyFiles := UpperCase(GetToken(InParms));
  84.     AsFileNames := MyFiles ;
  85.     ix := Pos(':',AsFilenames) ;
  86.     If ix > 1 then delete(AsFilenames,1,ix) ;  (* Eliminate disk prefix *)
  87. subdir1:
  88.  ix := Pos('\',AsFileNames) ;
  89.  If ix > 0 then delete(AsFileNames,1,ix) ;  (* Eliminate sub-dir  prefixs *)
  90.  if ix > 0 then goto subdir1 ;
  91.     (* if As name not specified assume same name without disk specification *)
  92.     Atoken := UpperCase(GetToken(InParms));
  93.     If Atoken = 'AS' then
  94.         If length(InParms)<1  then AsFileNames := MyFiles
  95.                               else AsFileNames := UpperCase(GetToken(InParms))
  96.                      else
  97.         If Atoken = 'RAW' then  rawfile := true
  98.                           else  InParms := Atoken + InParms ;
  99. subdir:
  100.  ix := Pos('\',AsFilenames) ;
  101.  If ix > 1 then delete(AsFilenames,1,ix) ;  (* Eliminate sub-dir  prefixs *)
  102.  if ix > 1 then goto subdir ;
  103.  ix := Pos(':',Myfiles) ;
  104.  If ix = 2 then diskdrive := copy(Myfiles,1,2)
  105.            else diskdrive := '';
  106.  
  107.     FindFirst(Myfiles,Anyfile,FileInfo) ;
  108.     If DosError = 0 then filename := FileInfo.name
  109.                     else
  110.          begin (* No file found *)
  111.          Writeln (' File "',MyFiles,'" not found.');
  112.          Goto Exit ;
  113.          end ; (* No file found *)
  114.     AsFilename := 'Blank' ;
  115.  
  116.     If rawfile then
  117.         begin SendRaw ; goto exit ; end ;
  118.  
  119. GetAsName:
  120.   If NewAsFile(Myfiles,Filename,AsFileNames,AsFileName) then
  121.                                                         else
  122.      begin (* get next file *)
  123.      FindNext(Fileinfo) ;
  124.      filename := FileInfo.name ;
  125.      fsize := FileInfo.size ;
  126.      If DosError = 0 then goto GetAsName
  127.                      else
  128.          begin (* No file found *)
  129.          Writeln (' File "',MyFiles,'" not found on disk.');
  130.          Goto Exit ;
  131.          end ; (* No file found *)
  132.      end ; (* get next file *)
  133.  
  134.     STATE := S ;
  135.     BreakState := NoBreak ;
  136.     GETREPLY := FALSE ;
  137.     LastFile := false ;
  138.     SENDING := TRUE ;
  139.     ClrScr;
  140.     GotoXY(10,4); Write(' Number of Packets Sent = ');
  141.     GotoXY(10,5); Write(' Number of Retries      = ');
  142.     PacketCount := 0 ;
  143.     WHILE SENDING DO
  144.        BEGIN (* Send files *)
  145.        IF GETREPLY THEN
  146.          Begin (* Getreply *)
  147.            IF RECVPACKET THEN
  148.               Begin (* got packet *)
  149.               If INSEQ <> OUTSEQ Then
  150.                         If RECVPACKET THEN
  151.                                       ELSE RESENDIT(10) ;
  152.               IF InPacketType = Ord('Y') THEN
  153.                                     ELSE
  154.               IF InPacketType = Ord('N') THEN RESENDIT(10)
  155.                                     ELSE
  156.               IF InPacketType = Ord('R') THEN STATE := S
  157.                                     ELSE
  158.               IF INPACKETTYPE = Ord('E') THEN
  159.                    Begin (* Error Packet *)
  160.                    Writeln(' ') ; Write(' Error Packet >>>> ') ;
  161.                    For I:=1 to InDataCount Do
  162.                        Write(Chr(RecvData[i])) ;
  163.                    STATE := A ;   (* ABORT if not INIT packet *)
  164.                    Writeln('');
  165.                    End   (* Error Packet *)
  166.                                     ELSE STATE := A
  167.               End  (* got packet *)
  168.                        ELSE  RESENDIT(10) ;
  169.            If (InPacketType = Ord('Y')) and (InDataCount > 1) then
  170.             If RecvData[1] = Ord('X') then  STATE := SZ  else
  171.               If RecvData[1] = Ord('Z') then
  172.                    Begin STATE := SZ ; LastFile := true ;  End ;
  173.          If STATE = SD then
  174.             Case Breakstate of
  175.               NoBreak :  ;
  176.               BC : Sending := False ;
  177.               BE : STATE := A ;
  178.               BX : STATE := SZ ;
  179.               BZ : Begin STATE := SZ ; LastFile := true ;  End ;
  180.             End ; (* Case Breakstate *)
  181.          End ; (* GetReply *)
  182.          GotoXY(36,5); Write (RetryCount);
  183.          GETREPLY := TRUE ;
  184.  
  185.             CASE STATE OF
  186.     S :  BEGIN (* Send INIT packit *)
  187.          OutPacketType := Ord('S') ;
  188.          PutInitPacket ;
  189.          SENDPACKET ;
  190.          STATE := SF ;
  191.          END ; (* Send INIT packit *)
  192.  
  193.     SF:  BEGIN (* Send file header *)
  194.          If OutPacketType = Ord('S') then GetInitPacket ;
  195.          OUTSEQ := OUTSEQ + 1 ;
  196.          IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
  197.          OutPacketType := Ord('F') ;
  198.          TempName := Prefixof(AsFileNames) + AsFileName ;
  199.          OutDataCount := LENGTH(TempName) ;
  200.          For i := 1 to OutDataCount do SendData[i] := Ord(Tempname[i]) ;
  201.          GotoXY(10,2);
  202.          Write(' Sending file ',Filename,' as ',TempName,
  203.                '                                   ');
  204.          Assign(FileToSend,Prefixof(MyFiles)+FileName);
  205.          SetTextBuf(FileToSend,FileBuffer);
  206.          RESET(FileToSend);
  207.          FSize := FileInfo.Size;
  208.          BytesSent := 0 ;
  209.          GotoXY(10,6) ;
  210.          Write(' File size ',FSize,' Bytes' );
  211.          GotoXY(10,7); Write(' Amount Transmitted     = ');
  212.          STATE := SD ;
  213.          SENDPACKET ;
  214.          END ; (* Send file header *)
  215.  
  216.     SD:  BEGIN (* Send data *)
  217.          OutDataCount := 0 ;
  218.          MarkOutCount := 1 ;
  219.          RepCount := 0 ;
  220.          OUTSEQ   := OUTSEQ + 1 ;
  221.          IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
  222.          OutPacketType := Ord('D') ;
  223.          MaxOutData := rPacketSize-3-4 ;
  224.          If rPacketSize > 94 then MaxOutData := MaxOutData - 3 ;
  225.          WHILE (OutDataCount<MaxOutData) AND (BytesSent<FSize) DO
  226.               BEGIN (* Read a char *)
  227.               OutDataCount := OutDataCount + 1 ;
  228.               Read(FileToSend,Achar);
  229.               BytesSent := BytesSent + 1 ;
  230.               SendData[OutDataCount] := ord(achar);
  231.               If (prevchar = achar) and (RepChar > $20) and (BytesSent<FSize)
  232.                     and (RepCount < 92) and (OutDataCount > 1) then
  233.                    Begin (* repeated character *)
  234.                    RepCount := RepCount + 1 ;
  235.                    If RepCount = 1 then goto Quoting
  236.                                    else OutDataCount := OutDataCount - 1 ;
  237.                    End  (* repeated character *)
  238.  
  239.                                                             else
  240.                Begin (* different char *)
  241.                If RepCount > 1 then
  242.                    Begin (* add repeat count prefix *)
  243.                    OutDataCount := MarkOutCount ;
  244.                    SendData[OutDataCount] := RepChar ;
  245.                    SendData[OutDataCount+1] := RepCount + 1 + $20 ;
  246.                    SendData[OutDataCount+2] := ord(prevchar) ;
  247.                    OutDataCount := OutDataCount + 2 ;
  248.                    End ; (* add repeat count prefix *)
  249.                Prevchar := achar ;
  250.                MarkOutCount := OutdataCount ;
  251.                If RepCount = 1 then RepCount := 0 ;
  252.     Quoting :
  253.               IF SendData[OutDataCount] >= $80 THEN
  254.                    IF Bit8Quote = $20 THEN (* No bit8 quoting *)
  255.                         (* Just drop the 8th bit  *)
  256.                         SendData[OutDataCount] := SendData[OutDataCount] -$80
  257.                                        ELSE
  258.                         BEGIN (* BIT8 QUOTING *)
  259.                         SendData[OutDataCount+1] := SendData[OutDataCount]-$80;
  260.                         SendData[OutDataCount] := Bit8Quote ;
  261.                         OutDataCount := OutDataCount + 1 ;
  262.                         END ; (* BIT8 QUOTING *)
  263.               IF SendData[OutDataCount] < $20   THEN
  264.                    BEGIN (* CONTROL QUOTING *)
  265.                    SendData[OutDataCount+1] := SendData[OutDataCount] +$40;
  266.                    SendData[OutDataCount] := sCntrlQuote ;
  267.                    OutDataCount := OutDataCount + 1 ;
  268.                    END ; (* CONTROL QUOTING *)
  269.               IF SendData[OutDataCount] = $7F THEN
  270.                    BEGIN (* DEL QUOTING *)
  271.                    SendData[OutDataCount+1] := $3F ;
  272.                    SendData[OutDataCount] := sCntrlQuote ;
  273.                    OutDataCount := OutDataCount + 1 ;
  274.                    END ; (* DEL QUOTING *)
  275.               IF (SendData[OutDataCount] = sCntrlQuote) OR
  276.                   ( (Bit8Quote > $20) and
  277.                          (SendData[OutDataCount] = Bit8Quote)) OR
  278.                   ( (RepChar > $20) and
  279.                          (SendData[OutDataCount] = RepChar)) THEN
  280.                    BEGIN (* Quote the  quote *)
  281.                    SendData[OutDataCount+1] := SendData[OutDataCount] ;
  282.                    SendData[OutDataCount] := sCntrlQuote ;
  283.                    OutDataCount := OutDataCount + 1 ;
  284.                    END ; (* Quote the  quote *)
  285.               If RepCount > 1 then
  286.                   begin (* reset Repeat count *)
  287.                   RepCount := 0 ;
  288.                   OutDataCount := OutDataCount + 1 ;
  289.                   SendData[OutDataCount] := ord(achar) ;
  290.                   MarkOutCount := OutDataCount ;
  291.                   Goto Quoting ;
  292.                   end ; (* reset Repeat count  *)
  293.  
  294.                    End ; (* different char *)
  295.               END ; (* Read a char *)
  296.  
  297.          PacketCount := PacketCount + 1 ;
  298.          GotoXY(36,4) ;  WRITE (PacketCount);
  299.          GotoXY(36,7) ;  WRITE ( Round((BytesSent/Fsize) * 100),' %   ');
  300.          IF BytesSent>=FSize THEN STATE := SZ ;
  301.          SENDPACKET ;
  302.          END ; (* Send data *)
  303.  
  304.     SZ:  BEGIN (* End of File *)
  305.          (*$I- *) Close(FILETOSEND); (*$I+ *)
  306.          IOerror := IOResult ;
  307.          If (IOerror <> 0) and (IOerror <> 103) then
  308.               writeln('Error File Close -',IOerror);
  309.          GotoXY(10,8) ;
  310.          If BreakState = NoBreak then
  311.            WRITELN ('File ',Filename,' has been sent as ',AsFileName,
  312.                    '                              ')
  313.                                   else
  314.            Writeln('File ',Filename,' Partially sent as ',AsFileName,
  315.                    '                              ');
  316.          If Lastfile then STATE := SB
  317.                      else
  318. GetNextFile:
  319.            Begin (* Get next file  *)
  320.            FindNext(FileInfo) ;
  321.            filename := FileInfo.name ;
  322.            If DosError = 0 then
  323.                If NewAsFile(Myfiles,Filename,AsFilenames,AsFilename)
  324.                      then  STATE := SF
  325.                      else  goto GetNextFile
  326.                            else STATE := SB ;
  327.            End ; (* Get next file  *)
  328.          If Breakstate = BX then Breakstate := NoBreak ;
  329.          SendPacketType('Z') ;
  330.          END ; (* End of File *)
  331.  
  332.     SB:  BEGIN (* Last file sent *)
  333.   (*     WRITELN ('SENT last file completed');  *)
  334.          SendPacketType('B') ;
  335.          STATE := C ;
  336.          END ; (* Last file sent *)
  337.  
  338.      C:  BEGIN (* Completed Sending *)
  339.          GotoXY(10,9) ;
  340.          If BreakState = NoBreak then
  341.               WRITELN ('Sending FILEs completed OK ')
  342.                                  else
  343.               WRITELN ('Sending FILEs terminated due to manual Interruption ');
  344.          SENDING := FALSE ;
  345.          END ; (* Completed Sending *)
  346.  
  347.      A:  BEGIN (* Abort Sending *)
  348.          (*$I- *) Close(FILETOSEND); (*$I+ *)
  349.          IOError := IOResult ;
  350.          If (IOerror <> 0) and (IOerror <> 103) then
  351.                writeln(' Error closing file - ',IOerror);
  352.          GotoXY(10,9) ;
  353.          WRITELN ('SENDing files ABORTED');
  354.          ABORT := BADSF ;
  355.          SENDING := FALSE ;
  356.                (* SEND ERROR packet *)
  357.               OutDataCount := 15 ;
  358.               OUTSEQ   := 0 ;
  359.               ErrorMsg := 'Send file abort' ;
  360.               for i := 1 to OutDataCount do SendData[i] := Ord(ErrorMsg[i]) ;
  361.               OutPacketType := Ord('E');
  362.               SENDPACKET ;
  363.  
  364.          END ; (* Abort Sending *)
  365.               END ; (* CASE of STATE *)
  366.        END ; (* Send files *)
  367. Exit:
  368.     END ; (* SENDFILE procedure *)
  369.  
  370. (* ------------------------------------------------------------ *)
  371. (*  BreakACK - Procedure   will send a ACK  plus a break char   *)
  372. (*              X or Z .                                        *)
  373. (* ------------------------------------------------------------ *)
  374.      PROCEDURE BreakACK (Achar : Char);
  375.          BEGIN (* SEND ACK or NAK *)
  376.          OutDataCount := 1 ;
  377.          OUTSEQ   := OUTSEQ + 1 ;
  378.          IF OUTSEQ >= 64 then OUTSEQ := 0;
  379.          OUTPACKETTYPE := ord('Y');
  380.          SendData[1] := Ord(Achar);
  381.          SENDPACKET ;
  382.          END ; (* SEND ACK or NAK *)
  383. (* ------------------------------------------------------------ *)
  384. (*  RenameDup- Procedure   will check to see if a file is       *)
  385. (*              already present if it is it returns a new       *)
  386. (*              name modified with &.                           *)
  387. (*      Note : this procedure is maybe called recursively.      *)
  388. (* ------------------------------------------------------------ *)
  389.      PROCEDURE RenameDup(var MyFile:String);
  390.      var FileInfo : SearchRec ;
  391.          BEGIN (* RenameDup  *)
  392.          FindFirst(MyFile,AnyFile,FileInfo) ;
  393.          If  DosError = 0 then
  394.               Begin (* change name of file *)
  395.               Insert ('&',Myfile,Pos('.',Myfile));
  396.               if Pos('.',Myfile) > 9 then
  397.                    Delete(Myfile,Pos('&',Myfile)-1,1);
  398.               RenameDup(Myfile);
  399.               End ; (* change name of file *)
  400.          END ; (* RenameDup  *)
  401.  
  402. (* **************************************************************** *)
  403. (* RECVFILE  - This routine handles the Receiving of a file from    *)
  404. (*             the Main frame computer.                             *)
  405. (*                                                                  *)
  406. (* **************************************************************** *)
  407. PROCEDURE RECVFILE (var InParms : string);
  408. CONST buffersize = 1280 ;   (* must be a multiple of 128 *)
  409. VAR
  410.     Receiving,ReplaceFile     : BOOLEAN ;
  411.     Bit8                      : BYTE ;
  412.     Lastseqnum,Retries,i,j,
  413.     ByteCount                 : LONGINT ;
  414.     PacketCount,CharCount     : INTEGER ;
  415.     Filenames,FileName,
  416.     Myfiles,Myfile,Astring,
  417.     ErrorMsg                  : String ;
  418.     FileComing                : Text  ;
  419.     FileBuffer : packed array [1..buffersize] of char ;
  420.  
  421. Label Gotinit;
  422.  
  423.     (* ------------------------------------------------------------ *)
  424.     (*  SENDNAK - Procedure of RECVFILE, will check the number of   *)
  425.     (*            RETRIES , if it is greater than 0 it will send a  *)
  426.     (*            call SendPacketType('N') which send a NAK packet  *)
  427.     (*            and decrements the RETRIES by 1.                  *)
  428.     (*  Side Effect - RETRIES is decremented by 1.                  *)
  429.     (*                STATE is set to A if no more retries.         *)
  430.     (*              - RetryCount is incremented                     *)
  431.     (* ------------------------------------------------------------ *)
  432.      PROCEDURE SENDNAK ;
  433.          BEGIN (* SEND  NAK *)
  434.          RetryCount := RetryCount + 1;
  435.          IF RETRIES > 0 then
  436.               BEGIN  (* Ask for a retransmission *)
  437.               SendPacketType('N');
  438.               OUTSEQ := OUTSEQ - 1 ;
  439.               RETRIES := RETRIES - 1 ;
  440.               END    (* Ask for a retransmission *)
  441.                         else
  442.               BEGIN (* lack of Nak *)
  443.               STATE := A ;
  444.               Writeln(' Last of NAK. No more Retries ');
  445.               END ; (* lack of Nak *)
  446.          END ; (* SEND  NAK *)
  447.  
  448.     BEGIN (* ------- RECVFILE procedure ------- *)
  449.     WRITELN (' RECEIVE file command . ',InParms);
  450.     Packetcount := 0 ;
  451.     ReplaceFile := false ;
  452.     Lastseqnum := 0 ;
  453.  
  454.     (* Scan Parameter string *)
  455.     FileNames := GETTOKEN(InParms);
  456.     j:=Pos(':',FileNames);
  457.     if j = 0 then MyFiles := FileNames
  458.              else MyFiles := Copy(FileNames,j+1,Length(FileNames)-j);
  459.     Astring := Uppercase(GetToken(Inparms));
  460.     If Astring = 'AS' then
  461.          if length(InParms) > 0 then
  462.               Begin (* get AS name *)
  463.               MyFiles := GetToken(Inparms);
  464.               Astring := Uppercase(GetToken(Inparms));
  465.               If Pos(Astring,' REPLACE') = 2 then ReplaceFile := True
  466.                                              else InParms := Astring + InParms;
  467.               End   (* get AS name *)
  468.                                 else MyFiles := FileNames
  469.                       else
  470.          If Pos(Astring,' REPLACE') = 2 then ReplaceFile := True
  471.                                         else InParms := Astring + InParms ;
  472.  
  473.     If FileNames <> '' then
  474.          Begin (* Send a R type packet requesting the file *)
  475.    writeln('Filenames=',Filenames,' length =',length(Filenames));
  476.          OutDataCount := length(Filenames);
  477.          OutSeq := 0 ;
  478.          OutPacketType := ord('R');
  479.          For i := 1 to length(Filenames) do
  480.               SendData[i] := Ord(FileNames[i]) ;
  481.          WaitXon := false ;
  482.          SendPacket ;
  483.          End   (* Send a R type packet requesting the file *)
  484.                       else
  485.          WaitXon := XonXoff ;
  486.     STATE := R ;
  487.     RECEIVING := TRUE ;
  488.     BreakState := NoBreak ;
  489.     RETRIES := 10 ;       (* Up to 10 retries allowed. *)
  490.     RetryCount := 0 ;
  491.     clrscr ;
  492.     GotoXY(10,4) ;
  493.     Write('Number of Data Packets Received = ');
  494.     GotoXY(10,5) ;
  495.     Write('Number of Nak  responses sent   = ');
  496.     GotoXY(10,6) ;
  497.     Write('Number of Bytes received        = ');
  498.     WHILE RECEIVING DO  CASE STATE OF
  499.  
  500.     (* R ------ Initial receive State ------- *)
  501.     (* Valid received msg type  : S           *)
  502.     R : BEGIN (* Initial Receive State  *)
  503.         If InPacketType =Ord('S')  then goto Gotinit;
  504.         IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then  SENDNAK
  505.                                                        else
  506. Gotinit:
  507.         (* Get a packet *)
  508.         IF INPACKETTYPE = Ord('S') then
  509.               BEGIN (* Got INIT packet *)
  510.               GetInitPacket ;  (* Get Init parameters *)
  511.               (* Reply with ACK and init parameters *)
  512.               OutPacketType := Ord('Y');
  513.               PutInitPacket ;
  514.               SENDPACKET ;
  515.               STATE := RF ;
  516.               END   (* Got  INIT  packet *)
  517.                               else
  518.               BEGIN (* Not init packet *)
  519.               IF INPACKETTYPE = Ord('E') then
  520.                    Begin (* Error Packet *)
  521.                    Writeln(' ') ; Write(' Error Packet >>>> ') ;
  522.                    For I:=1 to InDataCount Do
  523.                        Write(Chr(RecvData[i])) ;
  524.                    Writeln('');
  525.                    End ; (* Error Packet *)
  526.               STATE := A ;   (* ABORT if not INIT packet *)
  527.               ABORT := NOT_S ;
  528.               END ; (* Not init packet *)
  529.         END ; (* Initial Receive State  *)
  530.  
  531.  
  532.     (* RF ----- Receive Filename State ------- *)
  533.     (* Valid received msg type  : S,Z,F,B     *)
  534.     RF: IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then  SENDNAK
  535.                                                        else
  536.         (* Get a packet *)
  537.         IF INPACKETTYPE = Ord('S') then STATE:=R             else
  538.         IF INPACKETTYPE = Ord('Z') then SendPacketType('N')  else
  539.         IF INPACKETTYPE = Ord('B') then STATE:=C             else
  540.         IF INPACKETTYPE = Ord('F') then
  541.               BEGIN (* Got file header *)
  542.               For i := 1 to InDataCount do
  543.                    FileName[i] := Chr(RecvData[i]) ;
  544.               FileName[0] := Chr(InDataCount) ;
  545.               If Filenames = '' then
  546.                   Myfile := Filename
  547.                                  else
  548.                   If NewAsfile(Filenames,Filename,MyFiles,Myfile) then;
  549.               GotoXY(10,2);
  550.               If ReplaceFile then (* write over old file *)
  551.                              else ReNameDup(Myfile);
  552.               Writeln('Receiving file ',Filename,' as ',Myfile,
  553.                        '                          ');
  554.               Assign(FileComing,Prefixof(MyFiles)+MyFile);
  555.               SetTextBuf(FileComing,FileBuffer);
  556.               STATE := RD ;
  557.               If not ForPrinter then
  558.                    Begin  (* open disk file *)
  559.                    {$I-} Rewrite(FileComing); {$I+}
  560.                    If IoResult <> 0 then
  561.                         Begin (* IO error *)
  562.                         GotoXY(5,7);
  563.                         Writeln(' Unable to Open output file.       ');
  564.                         Writeln(' Possibly the Directory is  Full   ');
  565.                         STATE := A ;
  566.                         SendPacketType('N');
  567.                         End ; (* IO error *)
  568.                    End ;  (* open disk file *)
  569.               SendPacketType('Y');
  570.               ByteCount := 0 ;
  571.               END   (* Got file header *)
  572.                                    else
  573.          BEGIN (* Not S,F,B,Z packet *)
  574.          IF INPACKETTYPE = Ord('E') then
  575.               Begin (* Error Packet *)
  576.               Writeln(' ') ; Write(' Error Packet >>>> ') ;
  577.               For I:=1 to InDataCount Do
  578.               Write(Chr(RecvData[i])) ;
  579.               Writeln('');
  580.               End ; (* Error Packet *)
  581.          STATE := A ;   (* ABORT if not a S,F,B,Z type packet *)
  582.          ABORT := NOT_SFBZ ;
  583.          END ; (* Not S,F,B,Z packet *)
  584.  
  585.  
  586.     (* RD ----- Receive Data State ------- *)
  587.     (* Valid received msg type  : D,Z      *)
  588.     RD: IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then SENDNAK
  589.                                                        else
  590.         If lastseqnum = inseq then  SendPacketType('Y')
  591.                               else
  592.         BEGIN  (* Got a good packet *)
  593.         RETRIES := 10 ;
  594.         lastseqnum := inseq ;
  595.         IF INPACKETTYPE = Ord('D') then
  596.               BEGIN (* Receive data *)
  597.               PacketCount := PacketCount + 1 ;
  598.               Case Breakstate of
  599.                    NoBreak : SendPacketType('Y');
  600.                    BC : RECEIVING:=false ;
  601.                    BE : SendPacketType('N') ;
  602.                    BX : BreakAck('X') ;
  603.                    BZ : BreakAck('Z') ;
  604.                End; (* Case BreakState *)
  605.               If Breakstate <> NoBreak then
  606.               Writeln('Receiving file ',Filename,' as ',Myfile,' Interrupted');
  607.               If BreakState = BX then Breakstate := NoBreak ;
  608.         (*    WRITELN ('RECEIVE data ');  *)
  609.               I := 1 ;
  610.               WHILE I <= InDataCount DO
  611.                  BEGIN (* Write Data to file  *)
  612.                    IF (RepChar<>$20) and (RecvData[I]=RepChar) then
  613.                         BEGIN (* Repeat char   *)
  614.                         I := I+1 ;
  615.                         charcount := RecvData[I] - 32 ;
  616.                         I := I + 1 ;
  617.                         END    (* Repeat char  *)
  618.                                                                else
  619.                         charcount := 1 ;
  620.                    IF (Bit8Quote<>$20) and (RecvData[I]=Bit8Quote) then
  621.                         BEGIN (* 8TH BIT QUOTING  *)
  622.                         I := I+1 ;
  623.                         BIT8 := $80 ;
  624.                         END   (* 8TH BIT QUOTING  *)
  625.                                             else
  626.                         BIT8 := 0 ;
  627.                    IF RecvData[I] = rCntrlQuote then
  628.                         BEGIN (* CONTROL character *)
  629.                         I := I+1 ;
  630.                         IF RecvData[I] = $3F then   (* Make it a del *)
  631.                                                    RecvData[I] := $7F
  632.                                              else
  633.                         IF (RecvData[I] >= $40) and (RecvData[I]<=$5F) then
  634.                              RecvData[I] := RecvData[I] - $40 ;
  635.                              (* Make it a control *)
  636.                              (* else assume Quote,8bitQ,or RepChar *)
  637.                        END ; (* CONTROL character *)
  638.                    RecvData[I] := RecvData[I] + BIT8 ;
  639.                    For j := 1 to charcount  do
  640.                    If ForPrinter then
  641.                      Write(LST,Chr(RecvData[i]))
  642.                                  else
  643.                      Begin (* Write to file *)
  644.                      {$I-} Write(FileComing,Chr(RecvData[i])); {$I+}
  645.                      If IoResult <> 0 then
  646.                         Begin (* IO error *)
  647.                         Writeln(' Disk is Full or file too large');
  648.                         STATE := A ;
  649.                         SendPacketType('N');
  650.                         End ; (* IO error *)
  651.                      End ;  (* Write to file *)
  652.                    ByteCount := ByteCount + charcount ;
  653.                  I := I + 1 ;
  654.                  END ; (* Write Data to File *)
  655.               GotoXY(44,4) ; Write (PacketCount);
  656.               GotoXY(44,5) ; Write (RetryCount);
  657.               GotoXY(44,6) ; Writeln(ByteCount,'        ');
  658.               END   (* Receive data *)
  659.                               else
  660.          IF INPACKETTYPE = Ord('F') then
  661.               BEGIN (* repeat *)
  662.               OutSeq := OutSeq - 1 ;
  663.               SendPacketType('Y') ;
  664.               END   (* repeat *)
  665.                               else
  666.          IF INPACKETTYPE = Ord('Z') then
  667.               BEGIN (* End of Incoming File *)
  668.               If not ForPrinter then
  669.                      Begin (* Close file *)
  670.                      {$I-} Close(FileComing); {$I+}
  671.                      If IoResult <> 0 then
  672.                         Writeln(' Disk is Full or file too large');
  673.                      End ;  (* Close file *)
  674.               STATE := RF ;
  675.               SendPacketType('Y');
  676.               END   (* End of Incoming File *)
  677.                               else
  678.          BEGIN (* Not D,Z packet *)
  679.          IF INPACKETTYPE = Ord('E') then
  680.               Begin (* Error Packet *)
  681.               Writeln(' ') ; Write(' Error Packet >>>> ') ;
  682.               For I:=1 to InDataCount Do
  683.               Write(Chr(RecvData[i])) ;
  684.               Writeln('');
  685.               End ; (* Error Packet *)
  686.          STATE := A;   (* ABORT - Type not  D,Z, *)
  687.          ABORT := NOT_DZ ;
  688.          END ; (* Not D,Z packet *)
  689.         END ;  (* Got a good packet *)
  690.  
  691.  
  692.     (* C ----- COMPLETED  State ------- *)
  693.      C:  BEGIN (* COMPLETED Receiving *)
  694.          SendPacketType('Y');
  695.          If BreakState = NoBreak then
  696.               Writeln ('Receiving files completed OK.')
  697.                                  else
  698.               Writeln('Receiving Files terminated by manual interruption');
  699.          RECEIVING := FALSE ;
  700.          END ; (* COMPLETED Receiving *)
  701.  
  702.     (* A ----- A B O R T  State ------- *)
  703.      A:  BEGIN (* Abort Sending *)
  704.          Writeln(' ');
  705.          WRITELN ('RECEIVEing file(s)  ',filenames,' ABORTED');
  706.          {$I-} Close(FileComing);{$I+}
  707.          i := IoResult ;
  708.          If (i <> 0) and (i <> 103) then
  709.               Writeln('Close File IoResult =',i);
  710.          RECEIVING := FALSE ;
  711.          (* SEND ERROR packet *)
  712.   (*       OutSeq   := 0 ;
  713.          ErrorMsg :=' RECVfile abort' ;
  714.          OutDataCount := length(ErrorMsg) ;
  715.          For i := 1 to length(ErrorMsg) do
  716.               SendData[i] := Ord(ErrorMsg[i]) ;
  717.          OutPacketType := Ord('E');
  718.          SENDPACKET ;              *)
  719.          END ; (* Abort Sending *)
  720.  
  721.          END ; (* CASE of STATE *)
  722.  
  723.     END ; (* ------- RECVFILE procedure -------*)
  724.  
  725. End. (* SendRecv Unit *)