home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPKERMIT / RECVFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-25  |  14KB  |  328 lines
  1. (* +FILE+ RECVFILE.PASMSCPM *)
  2. (* ------------------------------------------------------------ *)
  3. (*  BreakACK - Procedure   will send a ACK  plus a break char   *)
  4. (*              X or Z .                                        *)
  5. (* ------------------------------------------------------------ *)
  6.      PROCEDURE BreakACK (Achar : Char);
  7.          BEGIN (* SEND ACK or NAK *)
  8.          OutDataCount := 1 ;
  9.          OUTSEQ   := OUTSEQ + 1 ;
  10.          IF OUTSEQ >= 64 then OUTSEQ := 0;
  11.          OUTPACKETTYPE := ord('Y');
  12.          SendData[1] := Ord(Achar);
  13.          SENDPACKET ;
  14.          END ; (* SEND ACK or NAK *)
  15. (* ------------------------------------------------------------ *)
  16. (*  RenameDup- Procedure   will check to see if a file is       *)
  17. (*              already present if it is it returns a new       *)
  18. (*              name modified with &.                           *)
  19. (*      Note : this procedure is maybe called recursively.      *)
  20. (* ------------------------------------------------------------ *)
  21.      PROCEDURE RenameDup(var MyFile:comstring);
  22.          BEGIN (* RenameDup  *)
  23.          If Firstfile(MyFile,MyFile) then
  24.               Begin (* change name of file *)
  25.               Insert ('&',Myfile,Pos('.',Myfile));
  26.               if Pos('.',Myfile) > 9 then
  27.                    Delete(Myfile,Pos('&',Myfile)-1,1);
  28.               RenameDup(Myfile);
  29.               End ; (* change name of file *)
  30.          END ; (* RenameDup  *)
  31.  
  32. (* **************************************************************** *)
  33. (* RECVFILE  - This routine handles the Receiving of a file from    *)
  34. (*             the Main frame computer.                             *)
  35. (*                                                                  *)
  36. (* **************************************************************** *)
  37.  PROCEDURE RECVFILE (var InParms : comstring);
  38. VAR
  39.     Bit8                      : BYTE ;
  40.     Lastseqnum                : INTEGER ;
  41.     Receiving,ReplaceFile     : BOOLEAN ;
  42.     Retries,PacketCount,
  43.     CharCount,i,j             : INTEGER ;
  44.     Filenames,FileName,
  45.     Myfiles,Myfile,Astring    : ComString ;
  46.     ErrorMsg                  : ComString ;
  47.     FileComing                : TEXT ;
  48.  
  49. Label Gotinit;
  50.  
  51.     (* ------------------------------------------------------------ *)
  52.     (*  SENDNAK - Procedure of RECVFILE, will check the number of   *)
  53.     (*            RETRIES , if it is greater than 0 it will send a  *)
  54.     (*            call SendPacketType('N') which send a NAK packet  *)
  55.     (*            and decrements the RETRIES by 1.                  *)
  56.     (*  Side Effect - RETRIES is decremented by 1.                  *)
  57.     (*                STATE is set to A if no more retries.         *)
  58.     (*              - RetryCount is incremented                     *)
  59.     (* ------------------------------------------------------------ *)
  60.      PROCEDURE SENDNAK ;
  61.          BEGIN (* SEND  NAK *)
  62.          RetryCount := RetryCount + 1;
  63.          IF RETRIES > 0 then
  64.               BEGIN  (* Ask for a retransmission *)
  65.               SendPacketType('N');
  66.               RETRIES := RETRIES - 1 ;
  67.               END    (* Ask for a retransmission *)
  68.                         else
  69.               STATE := A ;
  70.          END ; (* SEND  NAK *)
  71.  
  72.  
  73.  
  74.     BEGIN (* ------- RECVFILE procedure ------- *)
  75.     WRITELN (' RECEIVE file command . ',InParms);
  76.     Packetcount := 0 ;
  77.     ReplaceFile := false ;
  78.     Lastseqnum := 0 ;
  79.  
  80.     (* Scan Parameter string *)
  81.     FileNames := GETTOKEN(InParms);
  82.     MyFiles := FileNames ;
  83.     Astring := Uppercase(GetToken(Inparms));
  84.     If Astring = 'AS' then
  85.          if length(InParms) > 0 then
  86.               Begin (* get AS name *)
  87.               MyFiles := GetToken(Inparms);
  88.               Astring := Uppercase(GetToken(Inparms));
  89.               If Pos(Astring,' REPLACE') = 2 then ReplaceFile := True
  90.                                              else InParms := Astring + InParms;
  91.               End   (* get AS name *)
  92.                                 else MyFiles := FileNames
  93.                       else
  94.          If Pos(Astring,' REPLACE') = 2 then ReplaceFile := True
  95.                                         else InParms := Astring + InParms ;
  96.  
  97.     If FileNames <> '' then
  98.          Begin (* Send a R type packet requesting the file *)
  99.          OutDataCount := length(Filenames);
  100.          OutSeq := 0 ;
  101.          OutPacketType := ord('R');
  102.          For i := 1 to length(Filenames) do
  103.               SendData[i] := Ord(FileNames[i]) ;
  104.          WaitXon := false ;
  105.          SendPacket ;
  106.          End   (* Send a R type packet requesting the file *)
  107.                       else
  108.          WaitXon := XonXoff ;
  109.     STATE := R ;
  110.     RECEIVING := TRUE ;
  111.     BreakState := NoBreak ;
  112.     RETRIES := 10 ;       (* Up to 10 retries allowed. *)
  113.     RetryCount := 0 ;
  114.     clrscr ;
  115.     GotoXY(10,4) ;
  116.     Write('Number of Data Packets Received = ');
  117.     GotoXY(10,5) ;
  118.     Write('Number of Nak  responses sent   = ');
  119.     WHILE RECEIVING DO  CASE STATE OF
  120.  
  121.     (* R ------ Initial receive State ------- *)
  122.     (* Valid received msg type  : S           *)
  123.     R : BEGIN (* Initial Receive State  *)
  124.         If InPacketType =Ord('S')  then goto Gotinit;
  125.         IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then  SENDNAK
  126.                                                        else
  127. Gotinit:
  128.         (* Get a packet *)
  129.         IF INPACKETTYPE = Ord('S') then
  130.               BEGIN (* Got INIT packet *)
  131.               GetInitPacket ;  (* Get Init parameters *)
  132.               (* Reply with ACK and init parameters *)
  133.               OutPacketType := Ord('Y');
  134.               PutInitPacket ;
  135.               SENDPACKET ;
  136.               STATE := RF ;
  137.               END   (* Got  INIT  packet *)
  138.                               else
  139.               BEGIN (* Not init packet *)
  140.               STATE := A ;   (* ABORT if not INIT packet *)
  141.               ABORT := NOT_S ;
  142.               END ; (* Not init packet *)
  143.         END ; (* Initial Receive State  *)
  144.  
  145.  
  146.     (* RF ----- Receive Filename State ------- *)
  147.     (* Valid received msg type  : S,Z,F,B     *)
  148.     RF: IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then  SENDNAK
  149.                                                        else
  150.         (* Get a packet *)
  151.         IF INPACKETTYPE = Ord('S') then STATE:=R             else
  152.         IF INPACKETTYPE = Ord('Z') then SendPacketType('N')  else
  153.         IF INPACKETTYPE = Ord('B') then STATE:=C             else
  154.         IF INPACKETTYPE = Ord('F') then
  155.               BEGIN (* Got file header *)
  156.               For i := 1 to InDataCount do
  157.                    FileName[i] := Chr(RecvData[i]) ;
  158.               FileName[0] := Chr(InDataCount) ;
  159.               If Filenames = '' then
  160.                   Myfile := Filename
  161.                                  else
  162.                   If NewAsfile(Filenames,Filename,MyFiles,Myfile) then;
  163.               GotoXY(10,2);
  164.               If ReplaceFile then (* write over old file *)
  165.                              else ReNameDup(Myfile);
  166.               Writeln('Receiving file ',Filename,' as ',Myfile,
  167.                        '                          ');
  168.               Assign(FileComing,Prefixof(Filenames)+MyFile);
  169.               STATE := RD ;
  170.               If not ForPrinter then
  171.                      Begin {$I-}
  172.                      REWRITE(FileComing);
  173.                      If IOresult <> 0 then
  174.                         Begin (* IO error *)
  175.                         Writeln(' Directory Full ');
  176.                         STATE := A ;
  177.                         SendPacketType('N');
  178.                         End ; (* IO error *)
  179.                      End ; {$I+}
  180.               SendPacketType('Y');
  181.               END   (* Got file header *)
  182.                                    else
  183.          BEGIN (* Not S,F,B,Z packet *)
  184.          STATE := A ;   (* ABORT if not a S,F,B,Z type packet *)
  185.          ABORT := NOT_SFBZ ;
  186.          END ; (* Not S,F,B,Z packet *)
  187.  
  188.  
  189.     (* RD ----- Receive Data State ------- *)
  190.     (* Valid received msg type  : D,Z      *)
  191.     RD: IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then SENDNAK
  192.                                                        else
  193.         If lastseqnum = inseq then  SendPacketType('Y')
  194.                               else
  195.         BEGIN  (* Got a good packet *)
  196.         lastseqnum := inseq ;
  197.         IF INPACKETTYPE = Ord('D') then
  198.               BEGIN (* Receive data *)
  199.         (*    WRITELN ('RECEIVE data ');  *)
  200.               PacketCount := PacketCount + 1 ;
  201.               GotoXY(44,4) ; Write (PacketCount);
  202.               GotoXY(44,5) ; Writeln(RetryCount);
  203.               I := 1 ;
  204.               WHILE I <= InDataCount DO
  205.                  BEGIN (* Write Data to file  *)
  206.                    IF RecvData[I] = RepChar   then
  207.                         BEGIN (* Repeat char   *)
  208.                         I := I+1 ;
  209.                         charcount := RecvData[I] - 32 ;
  210.                         I := I + 1 ;
  211.                         For j := 1 to charcount - 1 do
  212.                             If ForPrinter then  Write(LST,Chr(RecvData[i]))
  213.                                           else
  214.                      Begin {$I-}
  215.                      Write(FileComing,Chr(RecvData[i]));
  216.                      If IOresult <> 0 then
  217.                         Begin (* IO error *)
  218.                         Writeln(' Disk is Full or file too large');
  219.                         STATE := A ;
  220.                         SendPacketType('N');
  221.                         End ; (* IO error *)
  222.                      End ; {$I+}
  223.  
  224.                         END ;  (* Repeat char  *)
  225.                    IF RecvData[I] = Bit8Quote then
  226.                         BEGIN (* 8TH BIT QUOTING  *)
  227.                         I := I+1 ;
  228.                         BIT8 := $80 ;
  229.                         END   (* 8TH BIT QUOTING  *)
  230.                                             else
  231.                         BIT8 := 0 ;
  232.                    IF RecvData[I] = CntrlQuote then
  233.                         BEGIN (* CONTROL character *)
  234.                         I := I+1 ;
  235.                         IF RecvData[I] = $3F then   (* Make it a del *)
  236.                                                    RecvData[I] := $7F
  237.                                              else
  238.                         IF RecvData[I] >= 64 then   (* Make it a control *)
  239.                                           RecvData[I] := RecvData[I] - 64 ;
  240.  
  241.                        END ; (* CONTROL character *)
  242.                    RecvData[I] := RecvData[I] + BIT8 ;
  243.                    If ForPrinter then  Write(LST,Chr(RecvData[i]))
  244.                                  else
  245.                      Begin {$I-}
  246.                      Write(FileComing,Chr(RecvData[i]));
  247.                      If IOresult <> 0 then
  248.                         Begin (* IO error *)
  249.                         Writeln(' Disk is Full or file too large');
  250.                         STATE := A ;
  251.                         SendPacketType('N');
  252.                         End ; (* IO error *)
  253.                      End ; {$I+}
  254.                  I := I + 1 ;
  255.                  END ; (* Write Data to File *)
  256.               Case Breakstate of
  257.                    NoBreak : SendPacketType('Y');
  258.                    BC : RECEIVING:=false ;
  259.                    BE : SendPacketType('N') ;
  260.                    BX : BreakAck('X') ;
  261.                    BZ : BreakAck('Z') ;
  262.                End; (* Case BreakState *)
  263.               If Breakstate <> NoBreak then
  264.               Writeln('Receiving file ',Filename,' as ',Myfile,' Interrupted');
  265.               If BreakState = BX then Breakstate := NoBreak ;
  266.               END   (* Receive data *)
  267.                               else
  268.          IF INPACKETTYPE = Ord('F') then
  269.               BEGIN (* repeat *)
  270.               OutSeq := OutSeq - 1 ;
  271.               SendPacketType('Y') ;
  272.               END   (* repeat *)
  273.                               else
  274.          IF INPACKETTYPE = Ord('Z') then
  275.               BEGIN (* End of Incoming File *)
  276.               If not ForPrinter then
  277.                      Begin {$I-}
  278.                      CLOSE(FileComing);
  279.                      If IOresult <> 0 then
  280.                         Begin (* IO error *)
  281.                         Writeln(' Disk is Full or file too large');
  282.                         End ; (* IO error *)
  283.                      End ; {$I+}
  284.               STATE := RF ;
  285.               SendPacketType('Y');
  286.               END   (* End of Incoming File *)
  287.                               else
  288.          BEGIN (* Not D,Z packet *)
  289.          STATE := A;   (* ABORT - Type not  D,Z, *)
  290.          ABORT := NOT_DZ ;
  291.          END ; (* Not D,Z packet *)
  292.         END ;  (* Got a good packet *)
  293.  
  294.  
  295.     (* C ----- COMPLETED  State ------- *)
  296.      C:  BEGIN (* COMPLETED Receiving *)
  297.          SendPacketType('Y');
  298.          If BreakState = NoBreak then
  299.               Writeln ('Receiving files completed OK.')
  300.                                  else
  301.               Writeln('Receiving Files terminated by manual interruption');
  302.          RECEIVING := FALSE ;
  303.          END ; (* COMPLETED Receiving *)
  304.  
  305.     (* A ----- A B O R T  State ------- *)
  306.      A:  BEGIN (* Abort Sending *)
  307.          {$I-}
  308.          CLOSE(FileComing);
  309.          If IOresult <> 0 then
  310.                  Writeln(' Unable to close file, is DISK FULL ');
  311.          {$I+}
  312.          WRITELN ('RECEIVEing files ABORTED');
  313.          RECEIVING := FALSE ;
  314.          (* SEND ERROR packet *)
  315.          OutSeq   := 0 ;
  316.          ErrorMsg :=' RECVfile abort' ;
  317.          OutDataCount := length(ErrorMsg) ;
  318.          For i := 1 to length(ErrorMsg) do
  319.               SendData[i] := Ord(ErrorMsg[i]) ;
  320.          OutPacketType := Ord('E');
  321.          SENDPACKET ;
  322.          END ; (* Abort Sending *)
  323.  
  324.          END ; (* CASE of STATE *)
  325.  
  326.     END ; (* ------- RECVFILE procedure -------*)
  327.  
  328.