home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S1.ARC / KOPEN.MOD < prev    next >
Encoding:
Text File  |  1988-03-23  |  8.8 KB  |  234 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Open_File --- Open file for use by Kermit protocol routines  *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Open_File(     File_Mode : Kermit_File_Modes;
  6.                          FileName  : AnyStr;
  7.                      VAR FullName  : AnyStr             );
  8.  
  9. (*----------------------------------------------------------------------*)
  10. (*                                                                      *)
  11. (*     Procedure:  Open_File                                            *)
  12. (*                                                                      *)
  13. (*     Purpose:    Opens file for use by Kermit routines                *)
  14. (*                                                                      *)
  15. (*     Calling Sequence:                                                *)
  16. (*                                                                      *)
  17. (*        Open_File(     File_Mode : Kermit_File_Modes;                 *)
  18. (*                       FileName  : AnyStr;                            *)
  19. (*                   VAR FullName  : AnyStr  );                         *)
  20. (*                                                                      *)
  21. (*           File_Mode --- whether file is to be opened for read or     *)
  22. (*                         write                                        *)
  23. (*           FileName  --- name of file to open                         *)
  24. (*           FullName  --- actual name used in open                     *)
  25. (*                                                                      *)
  26. (*     Calls:                                                           *)
  27. (*                                                                      *)
  28. (*        Adjust_Fn                                                     *)
  29. (*        Open_For_Write                                                *)
  30. (*        Int24Result                                                   *)
  31. (*                                                                      *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. VAR
  35.    Count     : INTEGER;
  36.    Space_Pos : INTEGER;
  37.    New_Name  : AnyStr;
  38.    Err       : INTEGER;
  39.    Save_Name : AnyStr;
  40.    IPos      : INTEGER;
  41.  
  42. (*----------------------------------------------------------------------*)
  43. (*                Open_For_Write --- Open file for output               *)
  44. (*----------------------------------------------------------------------*)
  45.  
  46. PROCEDURE Open_For_Write(     FileName : AnyStr;
  47.                           VAR Open_OK  : BOOLEAN  );
  48.  
  49. VAR
  50.    FSize : LONGINT;
  51.  
  52. BEGIN (* Open_For_Write *)
  53.                                    (* Check if file exists *)
  54.  
  55.    Add_Path( FileName, Download_Dir_Path, FullName );
  56.  
  57.    FSize := Get_File_Size( FullName , Open_OK );
  58.  
  59.                                    (* Error if file exists *)
  60.    IF Open_OK THEN
  61.       Open_OK := FALSE
  62.    ELSE                            (* Otherwise, new file -- open it *)
  63.       BEGIN
  64.  
  65.          ASSIGN ( XFile , FullName );
  66.          REWRITE( XFile , 1        );
  67.  
  68.          IF ( Int24Result <> 0 ) THEN
  69.             Open_OK := FALSE
  70.          ELSE
  71.             BEGIN (* FileName is new file, open it *)
  72.  
  73.                File_Records := 0;
  74.                Open_OK      := TRUE;
  75.                File_Open    := TRUE;
  76.                Buffer_Num   := 0;
  77.  
  78.             END;
  79.  
  80.       END;
  81.  
  82. END    (* Open_For_Write *);
  83.  
  84. (*----------------------------------------------------------------------*)
  85. (*                  Open_For_Read --- Open file for input               *)
  86. (*----------------------------------------------------------------------*)
  87.  
  88. PROCEDURE Open_For_Read(     FileName : AnyStr;
  89.                          VAR Open_OK  : BOOLEAN  );
  90.  
  91. VAR
  92.    DateTim  : LONGINT;
  93.    KDateTim : ARRAY[1..2] OF WORD ABSOLUTE DateTim;
  94.    Save_Date: Date_Format_Type;
  95.    Save_Time: Time_Format_Type;
  96.  
  97. BEGIN (* Open_For_Read *)
  98.                                    (* Append upload path if needed *)
  99.  
  100.    Add_Path( FileName, Upload_Dir_Path, FullName );
  101.  
  102.    File_Records := Get_File_Size( FullName , Open_OK );
  103.  
  104.                                    (* If there, close and open with file *)
  105.                                    (* handle.                            *)
  106.    IF Open_OK THEN
  107.       BEGIN
  108.                                    (* Indicate file opened OK *)
  109.          File_Open    := TRUE;
  110.  
  111.          STR( File_Records , Kermit_CFile_Size );
  112.  
  113.                                    (* Display it if status display on *)
  114.  
  115.          IF Display_Status THEN
  116.             BEGIN
  117.                GoToXY( 25 , 4 );
  118.                WRITE ( Kermit_CFile_Size );
  119.                ClrEol;
  120.             END;
  121.                                    (* No characters sent yet *)
  122.          Buffer_Num   := 0;
  123.                                    (* Open as untyped file *)
  124.  
  125.          FileMode := 0;
  126.  
  127.          ASSIGN( XFile , FullName );
  128.          RESET ( XFile , 1 );
  129.  
  130.          FileMode := 2;
  131.  
  132.          Err := Int24Result;
  133.                                    (* Get file date and time for  *)
  134.                                    (* attribute packet.           *)
  135.  
  136.                                    (* --- Get date/time from DOS  *)
  137.  
  138.          GetFTime( XFile , DateTim );
  139.  
  140.                                    (* --- Save current time/date formats *)
  141.  
  142.          Save_Date := Date_Format;
  143.          Save_Time := Time_Format;
  144.                                    (* --- Set time/date formats we want  *)
  145.          Date_Format := YMD_Style;
  146.          Time_Format := Military_Time;
  147.  
  148.                                    (* --- Get character form of date/time *)
  149.  
  150.          Dir_Convert_Date( KDateTim[1] , Kermit_CFile_Date );
  151.          Dir_Convert_Time( KDateTim[2] , Kermit_CFile_Time );
  152.  
  153.                                    (* --- Restore proper date/time formats *)
  154.  
  155.          Date_Format := Save_Date;
  156.          Time_Format := Save_Time;
  157.                                    (* --- Strip slashes from date      *)
  158.  
  159.          WHILE ( POS( '/' , Kermit_CFile_Date ) > 0 ) DO
  160.             DELETE( Kermit_CFile_Date , POS( '/' , Kermit_CFile_Date ), 1 );
  161.  
  162.          Kermit_CFile_Date := '19' + Kermit_CFile_Date;
  163.  
  164.                                    (* Indicate what file we're sending *)
  165.  
  166.          Write_Log('Sending file ' + FileName , TRUE , FALSE);
  167.          Write_Log('Size of file to send is ' + Kermit_CFile_Size + ' bytes',
  168.                    TRUE , FALSE);
  169.  
  170.       END
  171.    ELSE
  172.       BEGIN
  173.          Open_OK := FALSE;
  174.          Display_Kermit_Message( 'File ' + FileName + ' does not exist.');
  175.       END;
  176.  
  177. END    (* Open_For_Read *);
  178.  
  179. (*----------------------------------------------------------------------*)
  180.  
  181. BEGIN (* Open_File *)
  182.                                    (* Remember original file name    *)
  183.  
  184.    Save_Name := UpperCase( FileName );
  185.    FullName  := '';
  186.                                    (* Select open based upon whether *)
  187.                                    (* file is to be read or written  *)
  188.    CASE File_Mode OF
  189.  
  190.                                    (* Open file for reading *)
  191.  
  192.       Read_Open : Open_For_Read( FileName, Open_OK );
  193.  
  194.                                    (* Open file for writing *)
  195.       Write_Open: BEGIN
  196.                                    (* Ensure legal file name          *)
  197.  
  198.                      FileName := Fix_File_Name( FileName );
  199.  
  200.                                    (* Try opening under provided name *)
  201.  
  202.                      Open_For_Write( FileName, Open_OK );
  203.  
  204.                                    (* If file exists (Open_OK = FALSE), *)
  205.                                    (* then try adjusting name until     *)
  206.                                    (* non-existent name found.          *)
  207.  
  208.                      New_Name := FileName;
  209.  
  210.                      IF ( NOT Open_OK ) THEN
  211.                         IF Kermit_Adjust_File_Name( FileName , New_Name ) THEN
  212.                            Open_For_Write( New_Name , Open_OK );
  213.  
  214.                      IF Open_OK THEN
  215.                         BEGIN
  216.                            IF ( New_Name <> Save_Name ) THEN
  217.                               Display_Kermit_Message_2('Filename ' +
  218.                                                         Save_Name  +
  219.                                                        ' changed to: ' +
  220.                                                         New_Name );
  221.                            Write_Log('Receiving file ' + FileName , TRUE , FALSE);
  222.  
  223.                         END
  224.                      ELSE
  225.                         Display_Kermit_Message_2('Filename ' +
  226.                                                   Save_Name  +
  227.                                                  ' could not be opened.');
  228.  
  229.                   END    (* Write_Open *);
  230.  
  231.    END (* CASE *);
  232.  
  233. END     (* Open_File *);
  234.