home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPKERMIT / SENDFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-25  |  11KB  |  269 lines
  1. (* +FILE+ SENDFILE.PASMS *)
  2. (* **************************************************************** *)
  3. (* SENDFILE  - This routine handles the sending of a file from    * *)
  4. (*             the micro computer.                                * *)
  5. (*                                                                * *)
  6. (* **************************************************************** *)
  7.  PROCEDURE SENDFILE (var InParms : ComString);
  8.  
  9.  VAR
  10.     MyFiles,FileName,AsFileNames,AsFileName,Atoken   : Comstring ;
  11.     SENDING, GETREPLY, LastFile, rawfile    : Boolean ;
  12.     abyte, Kchar,Kbchar : byte ;
  13.     ErrorMsg            : String[80];
  14.     PacketCount,i,ix       : Integer ;
  15.     FILETOSEND          : File of byte ;
  16.  
  17. Label Subdir,GetAsName,GetNextFile,Exit ;
  18.  
  19.  
  20.     (* --------------------------------------------------- *)
  21.     (* SENDRAW - This routine send the file in unpacket    *)
  22.     (*           mode, Simply read and send.               *)
  23.     (* --------------------------------------------------- *)
  24.     Procedure SENDRAW ;
  25.     Begin (* SendRaw Procedure *)
  26.     Sending := true ;
  27.     While Sending Do
  28.          Begin (* Send a file *)
  29.          ClrScr; Writeln('       Sending File >>>>>>> ',Filename,' <<<<<<< ');
  30.          Assign(FileToSend,Prefixof(Myfiles)+FileName);
  31.          RESET(FileToSend);
  32.          While not EOF(FileToSend) do
  33.               Begin (* Send data *)
  34.               Read(FileToSend,abyte);
  35.               SendChar(abyte);
  36.               If LocalEcho then Write(chr(abyte))
  37.                            else If Readchar(abyte) then Write(chr(abyte));
  38.               If XonXoff and (abyte = $0D) then  (* wait for Xon *)
  39.                   While abyte<>XON do
  40.                         If Readchar(abyte) then
  41.                                            else abyte := xon ;
  42.               End ; (* Send data *)
  43.          CLOSE(FileToSend);
  44.          Sending := Nextfile(Myfiles,Filename);
  45.          End ; (* Send a file *)
  46.     Writeln(' ');
  47.     End ; (* SendRaw Procedure *)
  48.  
  49. (* **************************************************************** *)
  50.  
  51.     BEGIN (* SENDFILE procedure *)
  52.     rawfile := false ;
  53.     RetryCount := 0 ;
  54.   (* Check the file to be sent here *)
  55.     If length(InParms) < 1 then
  56.          Begin (* Get name of file to send *)
  57.          Write  (' Enter name of file to be sent >');
  58.          Readln(InParms);
  59.          End;
  60.     MyFiles := '                                     ';
  61.     MyFiles := UpperCase(GetToken(InParms));
  62.     AsFileNames := MyFiles ;
  63.     Atoken := UpperCase(GetToken(InParms));
  64.     If Atoken = 'AS' then
  65.         If length(InParms)<1  then AsFileNames := MyFiles
  66.                               else AsFileNames := UpperCase(GetToken(InParms))
  67.                      else
  68.         If Atoken = 'RAW' then  rawfile := true
  69.                           else  InParms := Atoken + InParms ;
  70. subdir:
  71.  ix := Pos('\',AsFilenames) ;
  72.  If ix > 1 then delete(AsFilenames,1,ix) ;  (* Eliminate sub-dir  prefixs *)
  73.  if ix > 1 then goto subdir ;
  74.  
  75.     If FirstFile(Myfiles,Filename) then
  76.                                    else
  77.          begin (* No file found *)
  78.          Writeln (' File "',MyFiles,'" not found.');
  79.          Goto Exit ;
  80.          end ; (* No file found *)
  81.     AsFilename := 'Blank' ;
  82.  
  83.     If rawfile then
  84.         begin SendRaw ; goto exit ; end ;
  85.  
  86. GetAsName:
  87. writeln('Filename is =',Filename);
  88.   If NewAsFile(Myfiles,Filename,AsFileNames,AsFileName) then
  89.                                                         else
  90.                  If NextFile(Myfiles,Filename) then goto GetAsName
  91.                                                else
  92.          begin (* No file found *)
  93.          Writeln (' File "',MyFiles,'" not found on disk.');
  94.          Goto Exit ;
  95.          end ; (* No file found *)
  96.  
  97.     STATE := S ;
  98.     BreakState := NoBreak ;
  99.     GETREPLY := FALSE ;
  100.     LastFile := false ;
  101.     SENDING := TRUE ;
  102.     ClrScr;
  103.     GotoXY(10,4); Write(' Number of Packets Sent = ');
  104.     GotoXY(10,5); Write(' Number of Retries      = ');
  105.     PacketCount := 0 ;
  106.     WHILE SENDING DO
  107.        BEGIN (* Send files *)
  108.        IF GETREPLY THEN
  109.            IF RECVPACKET THEN
  110.               IF InPacketType = Ord('Y') THEN
  111.                                     ELSE
  112.               IF InPacketType = Ord('N') THEN RESENDIT(10)
  113.                                     ELSE
  114.               IF InPacketType = Ord('R') THEN STATE := S
  115.                                     ELSE STATE := A
  116.                        ELSE  RESENDIT(10) ;
  117.          GotoXY(36,5); Write (RetryCount);
  118.          GETREPLY := TRUE ;
  119.          If (InPacketType = Ord('Y')) and (InDataCount > 1) then
  120.               If RecvData[1] = Ord('X') then  STATE := SZ  else
  121.               If RecvData[1] = Ord('Z') then
  122.                    Begin STATE := SZ ; LastFile := true ;  End ;
  123.          If STATE = SD then
  124.           Case Breakstate of
  125.             NoBreak :  ;
  126.             BC : Sending := False ;
  127.             BE : STATE := A ;
  128.             BX : STATE := SZ ;
  129.             BZ : Begin STATE := SZ ; LastFile := true ;  End ;
  130.          End ; (* Case Breakstate *)
  131.  
  132.             CASE STATE OF
  133.     S :  BEGIN (* Send INIT packit *)
  134.          OutPacketType := Ord('S') ;
  135.          PutInitPacket ;
  136.          SENDPACKET ;
  137.          STATE := SF ;
  138.          END ; (* Send INIT packit *)
  139.  
  140.     SF:  BEGIN (* Send file header *)
  141. (*       If InDataCount = 0 then
  142.               Begin    Not a Init packet, Resend our Init Packet
  143.               GetReply := False;
  144.               State := S ;
  145.               End
  146.                          Else      *)
  147.               Begin  (* Got Init packet, Get init parameters *)
  148.               If InDataCount > 1 then GetInitPacket ;
  149.               OUTSEQ := OUTSEQ + 1 ;
  150.               IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
  151.               OutPacketType := Ord('F') ;
  152.               OutDataCount := LENGTH(AsFileName);
  153.               For i := 1 to OutDataCount do SendData[i] := Ord(AsFilename[i]) ;
  154.               GotoXY(10,2);
  155.               Write(' Sending file ',Filename,' as ',AsFileName,
  156.                      '                                   ');
  157.               Assign(FileToSend,Prefixof(MyFiles)+FileName);
  158.               RESET(FILETOSEND);
  159.               STATE := SD ;
  160.               SENDPACKET ;
  161.               End  (* Got Init packet, Get init parameters *)
  162.          END ; (* Send file header *)
  163.  
  164.     SD:  BEGIN (* Send data *)
  165.          OutDataCount := 0 ;
  166.          OUTSEQ   := OUTSEQ + 1 ;
  167.          IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
  168.          OutPacketType := Ord('D') ;
  169.          WHILE (OutDataCount<PacketSize-3-4) AND (NOT EOF(FILETOSEND)) DO
  170.               BEGIN (* Read a char *)
  171.               OutDataCount := OutDataCount + 1 ;
  172.               READ(FILETOSEND,abyte);
  173.               SendData[OutDataCount] := abyte;
  174.               IF SendData[OutDataCount] >= $80 THEN
  175.                    IF Bit8Quote = $00 THEN (* No bit8 quoting *)
  176.                         (* Just drop the 8th bit  *)
  177.                         SendData[OutDataCount] := SendData[OutDataCount]-$80
  178.                                        ELSE
  179.                         BEGIN (* BIT8 QUOTING *)
  180.                         SendData[OutDataCount+1] := SendData[OutDataCount]-$80;
  181.                         SendData[OutDataCount] := Bit8Quote ;
  182.                         OutDataCount := OutDataCount + 1 ;
  183.                         END ; (* BIT8 QUOTING *)
  184.               IF SendData[OutDataCount] < $20   THEN
  185.                    BEGIN (* CONTROL QUOTING *)
  186.                    SendData[OutDataCount+1] := SendData[OutDataCount] + $40 ;
  187.                    SendData[OutDataCount] := CntrlQuote ;
  188.                    OutDataCount := OutDataCount + 1 ;
  189.                    END ; (* CONTROL QUOTING *)
  190.               IF SendData[OutDataCount] = $7F THEN
  191.                    BEGIN (* DEL QUOTING *)
  192.                    SendData[OutDataCount+1] := $3F ;
  193.                    SendData[OutDataCount] := CntrlQuote ;
  194.                    OutDataCount := OutDataCount + 1 ;
  195.                    END ; (* DEL QUOTING *)
  196.               IF (SendData[OutDataCount] = CntrlQuote) OR
  197.                          (SendData[OutDataCount] = Bit8Quote) THEN
  198.                    BEGIN (* Quote the  quote *)
  199.                    SendData[OutDataCount+1] := SendData[OutDataCount] ;
  200.                    SendData[OutDataCount] := CntrlQuote ;
  201.                    OutDataCount := OutDataCount + 1 ;
  202.                    END ; (* Quote the  quote *)
  203.               END ; (* Read a char *)
  204.  
  205.          PacketCount := PacketCount + 1 ;
  206.          GotoXY(36,4) ;  WRITE (PacketCount);
  207.          IF EOF(FILETOSEND) THEN STATE := SZ ;
  208.          SENDPACKET ;
  209.          END ; (* Send data *)
  210.  
  211.     SZ:  BEGIN (* End of File *)
  212.      (*  WRITELN ('end of file');  *)
  213.          Close(FILETOSEND);
  214.          GotoXY(10,6) ;
  215.          If BreakState = NoBreak then
  216.            WRITELN ('File ',Filename,' has been sent as ',AsFileName,
  217.                    '                              ')
  218.                                   else
  219.            Writeln('File ',Filename,' Partially sent as ',AsFileName,
  220.                    '                              ');
  221.          If Lastfile then STATE := SB
  222.                      else
  223. GetNextFile:
  224.          (* Get next file  *)
  225.          If Nextfile(Myfiles,Filename)  then
  226.             If NewAsFile(Myfiles,Filename,AsFilenames,AsFilename)
  227.                      then  STATE := SF
  228.                      else  goto GetNextFile
  229.                                         else STATE := SB ;
  230.         If Breakstate = BX then Breakstate := NoBreak ;
  231.          SendPacketType('Z') ;
  232.          END ; (* End of File *)
  233.  
  234.     SB:  BEGIN (* Last file sent *)
  235.   (*     WRITELN ('SENT last file completed');  *)
  236.          SendPacketType('B') ;
  237.          STATE := C ;
  238.          END ; (* Last file sent *)
  239.  
  240.      C:  BEGIN (* Completed Sending *)
  241.          GotoXY(10,7) ;
  242.          If BreakState = NoBreak then
  243.               WRITELN ('Sending FILEs completed OK ')
  244.                                  else
  245.               WRITELN ('Sending FILEs terminated due to manual Interruption ');
  246.          SENDING := FALSE ;
  247.          END ; (* Completed Sending *)
  248.  
  249.      A:  BEGIN (* Abort Sending *)
  250.          Close(FILETOSEND);
  251.          GotoXY(10,7) ;
  252.          WRITELN ('SENDing files ABORTED');
  253.          ABORT := BADSF ;
  254.          SENDING := FALSE ;
  255.                (* SEND ERROR packet *)
  256.               OutDataCount := 15 ;
  257.               OUTSEQ   := 0 ;
  258.               ErrorMsg := 'Send file abort' ;
  259.               for i := 1 to OutDataCount do SendData[i] := Ord(ErrorMsg[i]) ;
  260.               OutPacketType := Ord('E');
  261.               SENDPACKET ;
  262.  
  263.          END ; (* Abort Sending *)
  264.               END ; (* CASE of STATE *)
  265.        END ; (* Send files *)
  266. Exit:
  267.     END ; (* SENDFILE procedure *)
  268.  
  269.