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