home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s2.arc / PIBFMANS.MOD < prev    next >
Text File  |  1988-03-16  |  31KB  |  866 lines
  1. (*----------------------------------------------------------------------*)
  2. (*      View_Directory --- List files in current directory              *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE View_Directory;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  View_Directory                                       *)
  10. (*                                                                      *)
  11. (*     Purpose:    Lists files in current MSDOS directory               *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        View_Directory;                                               *)
  16. (*                                                                      *)
  17. (*     Calls:   View_Prompt                                             *)
  18. (*              Save_Screen                                             *)
  19. (*              Restore_Screen_And_Colors                               *)
  20. (*              Draw_Titled_Box                                         *)
  21. (*              GetDir                                                  *)
  22. (*              ChDir                                                   *)
  23. (*              FindFirst                                               *)
  24. (*              FindNext                                                *)
  25. (*                                                                      *)
  26. (*----------------------------------------------------------------------*)
  27.  
  28. VAR
  29.    Drive_Ch            : CHAR;
  30.    File_Entry          : SearchRec;
  31.    S_File_Time         : STRING[8];
  32.    S_File_Date         : STRING[8];
  33.    S_File_Xmodem_Time  : STRING[8];
  34.    S_File_Attributes   : STRING[6];
  35.    I                   : INTEGER;
  36.    L                   : INTEGER;
  37.    Dir_Spec            : AnyStr;
  38.    Save_Dir_Spec       : AnyStr;
  39.    View_Ch             : CHAR;
  40.    Total_File_Size     : LONGINT;
  41.    Total_File_Count    : LONGINT;
  42.    Free_Space          : LONGINT;
  43.    Path_Name           : AnyStr;
  44.    File_Ref_Name       : STRING[12];
  45.    TTime               : LONGINT;
  46.  
  47. LABEL
  48.    View_Exit;
  49.  
  50. BEGIN (* View_Directory *)
  51.                                    (*  Draw view menu *)
  52.  
  53.    Draw_Titled_Box( Saved_Screen, 5, 4, 75, 24, 'View Directory' );
  54.  
  55.    Dir_Spec := '';
  56.    TextColor( Menu_Text_Color_2 );
  57.    WRITELN('Enter search specification (*.* for all): ');
  58.    WRITE  ('>');
  59.    TextColor( Menu_Text_Color );
  60.    Read_Edited_String( Dir_Spec );
  61.  
  62.    FOR I := 1 TO 3 DO
  63.       BEGIN
  64.          GoToXY( 1 , I );
  65.          ClrEol;
  66.       END;
  67.  
  68.    IF ( Dir_Spec = CHR( ESC ) ) THEN
  69.       GOTO View_Exit;
  70.                                    (* Get current drive and path *)
  71.    GetDir( 0 , Path_Name );
  72.                                    (* If no spec entered, use current path *)
  73.    IF ( Dir_Spec = '' ) THEN
  74.       Dir_Spec := '*.*';
  75.  
  76.    Add_Path( Dir_Spec, Path_Name, Dir_Spec );
  77.  
  78.    IF ( Dir_Spec[LENGTH(Dir_Spec)] = ':' ) THEN
  79.       Dir_Spec := Dir_Spec + '*.*';
  80.  
  81.    WHILE ( POS( '\\', Dir_Spec ) > 0 ) DO
  82.       DELETE( Dir_Spec, POS( '\\', Dir_Spec ), 1 );
  83.  
  84.    IF ( POS( ':' , Dir_Spec ) > 0 ) THEN
  85.       Drive_Ch := Dir_Spec[1]
  86.    ELSE
  87.       Drive_Ch := Path_Name[1];
  88.                                    (* Display directory title *)
  89.  
  90.    RvsVideoOn( Menu_Text_Color , BLACK );
  91.  
  92.    GoToXY( 1 , 1 );
  93.  
  94.    WRITE('LISTING OF DIRECTORY: ',Dir_Spec);
  95.    ClrEol;
  96.    WRITELN;
  97.    WRITE(' File Name         Size     Date     Time  Attributes  Xfer Time');
  98.    ClrEol;
  99.    WRITELN;
  100.  
  101.    RvsVideoOff( Menu_Text_Color , BLACK );
  102.  
  103.                                    (* Reset window so header doesn't vanish *)
  104.    PibTerm_Window( 6, 7, 74, 23 );
  105.    GoToXY( 1 , WhereY );
  106.                                    (* List the directory contents   *)
  107.  
  108.    View_Count := 0;
  109.  
  110.    FindFirst( Dir_Spec, AnyFile, File_Entry );
  111.  
  112.    View_Done  := ( DosError <> 0 );
  113.  
  114.    Total_File_Size  := 0;
  115.    Total_File_Count := 0;
  116.  
  117.    WHILE( NOT View_Done ) DO
  118.       WITH File_Entry DO
  119.          BEGIN
  120.                                    (* == Display Next Directory Entry == *)
  121.  
  122.                                    (* Pick up creation date and time *)
  123.  
  124.             Dir_Convert_File_Date_And_Time( Time, S_File_Date, S_File_Time );
  125.  
  126.                                    (* Pick up file size *)
  127.  
  128.             Total_File_Size := Total_File_Size + Size;
  129.  
  130.                                    (* Pick up transfer time *)
  131.  
  132.             TTime := ROUND( ROUND( ( Size / 128.0 ) + 0.49 ) *
  133.                                    ( Trans_Time_Val * 1.0 ) /
  134.                                    ( Baud_Rate      * 1.0 ) );
  135.  
  136.             S_File_Xmodem_Time := TimeString( TTime , Military_Time );
  137.  
  138.                                    (* Determine attributes *)
  139.  
  140.             S_File_Attributes := '';
  141.  
  142.             IF ( Attr AND ReadOnly     ) <> 0 THEN
  143.                S_File_Attributes := 'R';
  144.             IF ( Attr AND Hidden       ) <> 0 THEN
  145.                S_File_Attributes := S_File_Attributes + 'H';
  146.             IF ( Attr AND SysFile      ) <> 0 THEN
  147.                S_File_Attributes := S_File_Attributes + 'S';
  148.             IF ( Attr AND VolumeID     ) <> 0 THEN
  149.                S_File_Attributes := S_File_Attributes + 'V';
  150.             IF ( Attr AND Directory    ) <> 0 THEN
  151.                S_File_Attributes := S_File_Attributes + 'D';
  152.             IF ( Attr AND Archive      ) <> 0 THEN
  153.                S_File_Attributes := S_File_Attributes + 'A';
  154.  
  155.             IF ( S_File_Attributes = '' ) THEN
  156.                S_File_Attributes := 'N';
  157.  
  158.                                    (* Display entry *)
  159.  
  160.             WRITELN( ' ', Name, DUPL( ' ' , 14 - LENGTH( Name ) ),
  161.                      Size:8, ' ', S_File_Date, ' ',
  162.                      S_File_Time,'  ',S_File_Attributes:10,'   ',
  163.                      S_File_Xmodem_Time );
  164.  
  165.                                    (* Increment count of lines displayed *)
  166.  
  167.             INC( View_Count );
  168.  
  169.                                    (* Prompt if end of screen *)
  170.             IF View_Count > 15 THEN
  171.                View_Prompt( View_Done , View_Count );
  172.  
  173.                                    (* Increment file count *)
  174.  
  175.             INC( Total_File_Count );
  176.  
  177.             FindNext( File_Entry );
  178.             View_Done := View_Done OR ( DosError <> 0 );
  179.  
  180.    END;
  181.                                    (* Display total file size and free space *)
  182.    WRITELN;
  183.  
  184.    INC( View_Count );
  185.    IF View_Count > 15 THEN
  186.       View_Prompt( View_Done , View_Count );
  187.  
  188.    Free_Space := DiskFree( SUCC( ORD( UpCase( Drive_Ch ) ) - ORD('A') ) );
  189.  
  190.    WRITE( Total_File_Size:8, ' bytes in ', Total_File_Count, ' files; ' );
  191.  
  192.    IF ( Free_Space >= 0 ) THEN
  193.       WRITELN( Free_Space:8,' bytes free')
  194.    ELSE
  195.       WRITELN( ' drive cannot be accessed.');
  196.  
  197.    INC( View_Count );
  198.    IF View_Count > 15 THEN
  199.       View_Prompt( View_Done , View_Count );
  200.  
  201.                                    (* Issue final end-of-directory prompt *)
  202.  
  203.    RvsVideoOn( Menu_Text_Color , BLACK );
  204.  
  205.    WRITE('Viewing of directory complete. ',
  206.          'Hit ESC to continue.');
  207.    ClrEol;
  208.  
  209.    RvsVideoOff( Menu_Text_Color , BLACK );
  210.  
  211.                                    (* Swallow terminating character *)
  212.    Read_Kbd( View_Ch );
  213.    IF ( View_Ch = CHR( ESC ) ) AND PibTerm_KeyPressed THEN
  214.       Read_Kbd( View_Ch );
  215.                                    (* Restore previous screen *)
  216. View_Exit:
  217.  
  218.    Restore_Screen_And_Colors( Saved_Screen );
  219.  
  220. END   (* View_Directory *);
  221.  
  222. (*----------------------------------------------------------------------*)
  223. (*      Log_Drive_Change --- Change current logged drive                *)
  224. (*----------------------------------------------------------------------*)
  225.  
  226. PROCEDURE Log_Drive_Change;
  227.  
  228. (*----------------------------------------------------------------------*)
  229. (*                                                                      *)
  230. (*     Procedure:  Log_Drive_Change                                     *)
  231. (*                                                                      *)
  232. (*     Purpose:    Change current logged drive                          *)
  233. (*                                                                      *)
  234. (*     Calling Sequence:                                                *)
  235. (*                                                                      *)
  236. (*        Log_Drive_Change                                              *)
  237. (*                                                                      *)
  238. (*     Calls:                                                           *)
  239. (*                                                                      *)
  240. (*----------------------------------------------------------------------*)
  241.  
  242. VAR
  243.    Drive_Path  : AnyStr;
  244.    Drive_Ch    : CHAR;
  245.    Drive_No    : INTEGER;
  246.    Drive_Count : INTEGER;
  247.  
  248. BEGIN (* Log_Drive_Change *);
  249.                                    (*  Draw logged drive change menu *)
  250.  
  251.    Draw_Titled_Box( Saved_Screen, 5, 10, 55, 15, 'Change Current Logged Drive' );
  252.  
  253.    GoToXY( 1 , 1 );
  254.  
  255.    GetDir( 0 , Drive_Path );
  256.  
  257.    Drive_Ch := Drive_Path[1];
  258.  
  259.    TextColor( Menu_Text_Color_2 );
  260.    WRITE('Current logged drive is: ');
  261.    TextColor( Menu_Text_Color );
  262.    WRITE( Drive_Ch );
  263.  
  264.    GoToXY( 1 , 2 );
  265.  
  266.    TextColor( Menu_Text_Color_2 );
  267.    WRITE('Enter letter for new logged drive: ');
  268.  
  269.    Read_Kbd( Drive_Ch );
  270.  
  271.    TextColor( Menu_Text_Color_2 );
  272.  
  273.    IF ( ( Drive_Ch = CHR( CR ) ) OR ( Drive_Ch = CHR( ESC ) ) ) THEN
  274.       BEGIN
  275.          WRITELN;
  276.          WRITELN('*** Logged drive remains unchanged.')
  277.       END
  278.    ELSE
  279.       BEGIN
  280.                                 (* Figure no. of drives in system *)
  281.  
  282.          TextColor( Menu_Text_Color );
  283.  
  284.          Drive_Ch := UpCase( Drive_Ch );
  285.  
  286.          WRITE( Drive_Ch );
  287.  
  288.          Drive_Count := Dir_Count_Drives;
  289.  
  290.                                 (* Drive no. for entered letter   *)
  291.  
  292.          Drive_No := ORD( Drive_Ch ) - ORD( 'A' );
  293.  
  294.                                 (* Check if drive legitimate      *)
  295.  
  296.          IF ( ( Drive_No < 0 ) OR ( Drive_No > Drive_Count ) ) THEN
  297.             WRITELN('*** Invalid drive, logged drive unchanged.')
  298.          ELSE
  299.             BEGIN
  300.                                 (* Change default drive *)
  301.  
  302.                ChDir( Drive_Ch );
  303.  
  304.                IF ( Int24Result = 0 ) THEN
  305.                   BEGIN
  306.  
  307.                      TextColor( Menu_Text_Color_2 );
  308.  
  309.                      WRITELN;
  310.                      WRITE('*** Logged drive changed to ');
  311.  
  312.                      TextColor( Menu_Text_Color );
  313.                      WRITE( Drive_Ch );
  314.  
  315.                   END
  316.                ELSE
  317.                   WRITELN('*** Invalid drive, logged drive unchanged.')
  318.  
  319.             END;
  320.  
  321.       END;
  322.  
  323.    Window_Delay;
  324.                                    (* Restore previous screen *)
  325.  
  326.    Restore_Screen_And_Colors( Saved_Screen );
  327.  
  328. END   (* Log_Drive_Change *);
  329.  
  330. (*----------------------------------------------------------------------*)
  331. (*       Change_Subdirectory --- Change current disk subdirectory       *)
  332. (*----------------------------------------------------------------------*)
  333.  
  334. PROCEDURE Change_Subdirectory;
  335.  
  336. (*----------------------------------------------------------------------*)
  337. (*                                                                      *)
  338. (*     Procedure:  Change_Subdirectory                                  *)
  339. (*                                                                      *)
  340. (*     Purpose:    Change current subdirectory                          *)
  341. (*                                                                      *)
  342. (*     Calling Sequence:                                                *)
  343. (*                                                                      *)
  344. (*        Change_Subdirectory;                                          *)
  345. (*                                                                      *)
  346. (*     Calls:   GetDir                                                  *)
  347. (*              ChDir                                                   *)
  348. (*              Save_Screen                                             *)
  349. (*              Restore_Screen                                          *)
  350. (*              Draw_Titled_Box                                         *)
  351. (*              Reset_Global_Colors                                     *)
  352. (*                                                                      *)
  353. (*                                                                      *)
  354. (*----------------------------------------------------------------------*)
  355.  
  356. VAR
  357.    Path_Name   : AnyStr;
  358.    Save_Path   : AnyStr;
  359.    Iok         : INTEGER;
  360.    Drive_Ch    : CHAR;
  361.    New_Drive   : CHAR;
  362.    Drive_No    : INTEGER;
  363.    Drive_Count : INTEGER;
  364.    Y           : INTEGER;
  365.  
  366. BEGIN (* Change_Subdirectory *)
  367.                                    (*  Draw directory change menu *)
  368.  
  369.    Draw_Titled_Box( Saved_Screen, 5, 10, 75, 15, 'Change Current Directory' );
  370.  
  371.    GoToXY( 1 , 1 );
  372.  
  373.    GetDir( 0 , Path_Name );
  374.    Iok := Int24Result;
  375.  
  376.    TextColor( Menu_Text_Color_2 );
  377.    WRITELN('Enter name of new directory path: ');
  378.    WRITE  ('>');
  379.  
  380.    TextColor( Menu_Text_Color );
  381.  
  382.    Save_Path := Path_Name;
  383.    Y         := WhereY;
  384.  
  385.    Read_Edited_String( Path_Name );
  386.  
  387.    WRITELN;
  388.  
  389.    TextColor( Menu_Text_Color_2 );
  390.  
  391.    IF ( ( LENGTH( Path_Name ) = 0 ) OR ( Path_Name = CHR( ESC ) ) ) THEN
  392.       BEGIN
  393.          GoToXY( 2 , Y );
  394.          TextColor( Menu_Text_Color );
  395.          WRITELN( Save_Path );
  396.          TextColor( Menu_Text_Color_2 );
  397.          WRITELN('*** Current directory remains unchanged.');
  398.       END
  399.    ELSE
  400.       BEGIN
  401.  
  402.          Chdir( Path_Name );
  403.  
  404.          IF ( Int24Result = 0 ) THEN
  405.             WRITELN('*** Current directory changed to ', Path_Name)
  406.          ELSE
  407.             WRITELN('*** Error found, directory not changed');
  408.  
  409.       END;
  410.  
  411.    Window_Delay;
  412.                                    (* Restore previous screen *)
  413.  
  414.    Restore_Screen_And_Colors( Saved_Screen );
  415.  
  416. END   (* Change_Subdirectory *);
  417.  
  418. (*----------------------------------------------------------------------*)
  419. (*               Delete_A_File --- Delete a file                        *)
  420. (*----------------------------------------------------------------------*)
  421.  
  422. PROCEDURE Delete_A_File;
  423.  
  424. (*----------------------------------------------------------------------*)
  425. (*                                                                      *)
  426. (*     Procedure:  Delete_A_File                                        *)
  427. (*                                                                      *)
  428. (*     Purpose:    Delete file in current subdirectory                  *)
  429. (*                                                                      *)
  430. (*     Calling Sequence:                                                *)
  431. (*                                                                      *)
  432. (*        Delete_A_File;                                                *)
  433. (*                                                                      *)
  434. (*     Calls:   Erase                                                   *)
  435. (*              Save_Screen                                             *)
  436. (*              Restore_Screen                                          *)
  437. (*              Draw_Titled_Box                                         *)
  438. (*              Reset_Global_Colors                                     *)
  439. (*                                                                      *)
  440. (*----------------------------------------------------------------------*)
  441.  
  442. VAR
  443.    File_Name : AnyStr;
  444.    F         : FILE;
  445.  
  446. BEGIN (* Delete_A_File *)
  447.                                    (*  Draw delete file menu *)
  448.  
  449.    Draw_Titled_Box( Saved_Screen, 5, 10, 75, 15, 'Delete A File -- Be Careful!' );
  450.  
  451.    TextColor( Menu_Text_Color_2 );
  452.  
  453.    GoToXY( 1 , 1 );
  454.  
  455.    WRITELN('Enter name of file to delete: ');
  456.    WRITE('>');
  457.  
  458.    File_Name := '';
  459.  
  460.    TextColor( Menu_Text_Color );
  461.  
  462.    Read_Edited_String( File_Name );
  463.    WRITELN;
  464.  
  465.    TextColor( Menu_Text_Color_2 );
  466.  
  467.    IF ( ( LENGTH( File_Name ) = 0 ) OR ( File_Name = CHR( ESC ) ) ) THEN
  468.       WRITELN('*** No file to delete.')
  469.    ELSE
  470.       BEGIN
  471.          ASSIGN( F , File_Name );
  472.          ERASE ( F );
  473.          IF ( Int24Result = 0 ) THEN
  474.             WRITELN('*** File deleted.')
  475.          ELSE
  476.             WRITELN('*** File not found to delete or read-only');
  477.       END;
  478.  
  479.    Window_Delay;
  480.                                    (* Restore previous screen *)
  481.  
  482.    Restore_Screen_And_Colors( Saved_Screen );
  483.  
  484. END   (* Delete_A_File *);
  485.  
  486. (*----------------------------------------------------------------------*)
  487. (*        Find_Free_Space_On_Drive --- Find free space on a drive       *)
  488. (*----------------------------------------------------------------------*)
  489.  
  490. PROCEDURE Find_Free_Space_On_Drive;
  491.  
  492. (*----------------------------------------------------------------------*)
  493. (*                                                                      *)
  494. (*     Procedure:  Find_Free_Space_On_Drive                             *)
  495. (*                                                                      *)
  496. (*     Purpose:    Finds free space on a drive                          *)
  497. (*                                                                      *)
  498. (*     Calling Sequence:                                                *)
  499. (*                                                                      *)
  500. (*        Find_Free_Space_On_Drive;                                     *)
  501. (*                                                                      *)
  502. (*     Calls:   DiskFree                                                *)
  503. (*              Save_Screen                                             *)
  504. (*              Restore_Screen                                          *)
  505. (*              Draw_Titled_Box                                         *)
  506. (*              Reset_Global_Colors                                     *)
  507. (*                                                                      *)
  508. (*----------------------------------------------------------------------*)
  509.  
  510. VAR
  511.    Drive_Ch: CHAR;
  512.    FSpace:   LONGINT;
  513.  
  514. BEGIN (* Find_Free_Space_On_Drive *)
  515.  
  516.    Draw_Titled_Box( Saved_Screen, 10, 10, 61, 15, 'Free space on drive' );
  517.  
  518.    REPEAT
  519.       GoToXY( 1 , 1 );
  520.       ClrEol;
  521.       Drive_CH := ' ';
  522.       TextColor( Menu_Text_Color_2 );
  523.       WRITE('Which drive? ');
  524.       Read_Kbd( Drive_Ch );
  525.       IF ( ( Drive_Ch = CHR( CR ) ) OR ( Drive_Ch = CHR( ESC ) ) ) THEN
  526.          Drive_Ch := ' ';
  527.       TextColor( Menu_Text_Color );
  528.       WRITE( Drive_Ch );
  529.       Drive_Ch := UpCase( Drive_Ch );
  530.    UNTIL( Drive_Ch IN [' ','A'..'Z'] );
  531.  
  532.    TextColor( Menu_Text_Color_2 );
  533.  
  534.    IF Drive_Ch <> ' ' THEN
  535.       BEGIN
  536.          WRITELN;
  537.          FSpace := DiskFree( SUCC( ORD( Drive_Ch ) - ORD('A') ) );
  538.          IF ( FSpace >= 0 ) THEN
  539.             WRITELN('Free space on drive ',Drive_Ch,' is ',FSpace:8,' bytes')
  540.          ELSE
  541.             WRITELN('Can''t find free space for drive ',Drive_Ch);
  542.  
  543.          WRITELN(' ');
  544.          WRITE  ('Hit ESC to continue');
  545.  
  546.          Read_Kbd( Drive_Ch );
  547.  
  548.          IF ( Drive_Ch = CHR( ESC ) ) AND PibTerm_KeyPressed THEN
  549.             Read_Kbd( Drive_Ch );
  550.  
  551.       END;
  552.  
  553.    Restore_Screen_And_Colors( Saved_Screen );
  554.  
  555. END   (* Find_Free_Space_On_Drive *);
  556.  
  557. (*----------------------------------------------------------------------*)
  558. (*                    Copy_A_File  --- Copy a file                      *)
  559. (*----------------------------------------------------------------------*)
  560.  
  561. PROCEDURE Copy_A_File;
  562.  
  563. (*----------------------------------------------------------------------*)
  564. (*                                                                      *)
  565. (*     Procedure:  Copy_A_File                                          *)
  566. (*                                                                      *)
  567. (*     Purpose:    Copies a file                                        *)
  568. (*                                                                      *)
  569. (*     Calling Sequence:                                                *)
  570. (*                                                                      *)
  571. (*        Copy_A_File;                                                  *)
  572. (*                                                                      *)
  573. (*     Calls:                                                           *)
  574. (*              Save_Screen                                             *)
  575. (*              Restore_Screen                                          *)
  576. (*              Draw_Titled_Box                                         *)
  577. (*              Reset_Global_Colors                                     *)
  578. (*                                                                      *)
  579. (*----------------------------------------------------------------------*)
  580.  
  581. CONST
  582.    BufSize =  4096                 (* Buffer size       *);
  583.  
  584. VAR
  585.    F          : FILE               (* File to be copied *);
  586.    F_Size     : LONGINT            (* Size of file      *);
  587.    F_Name     : AnyStr             (* File to copy      *);
  588.    F_Open     : BOOLEAN            (* If F opened OK    *);
  589.    G          : FILE               (* File copied to    *);
  590.    G_Open     : BOOLEAN            (* If G opened OK    *);
  591.    G_Size     : LONGINT            (* Size of G         *);
  592.    G_Name     : AnyStr             (* File copy         *);
  593.    Abort_Copy : BOOLEAN            (* TRUE to stop copy *);
  594.  
  595.    BytesRead  : INTEGER            (* # of bytes read   *);
  596.    BytesDone  : LONGINT            (* Total bytes read  *);
  597.  
  598.                                    (* Buffer area       *)
  599.    Buffer     : PACKED ARRAY[ 1 .. BufSize ] OF CHAR;
  600.  
  601.    QErr       : BOOLEAN            (* If error occurs   *);
  602.  
  603. LABEL
  604.    Abort_It;
  605.  
  606. BEGIN (* Copy_A_File *)
  607.                                    (* Announce file copy *)
  608.  
  609.    Draw_Titled_Box( Saved_Screen, 5, 10, 75, 17, 'Copy a file' );
  610.  
  611.    Abort_Copy := FALSE;
  612.    Qerr       := FALSE;
  613.                                    (* Get name of file to copy *)
  614.    REPEAT
  615.  
  616.       TextColor( Menu_Text_Color_2 );
  617.       GoToXY( 1 , 1 );
  618.       WRITE(' Enter file to be copied:    ');
  619.       ClrEol;
  620.       F_Name := '';
  621.  
  622.       TextColor( Menu_Text_Color );
  623.       Read_Edited_String( F_Name );
  624.  
  625.       IF ( ( LENGTH( F_Name ) = 0 ) OR ( F_Name = CHR( ESC ) ) ) THEN
  626.          Abort_Copy := TRUE
  627.       ELSE
  628.          F_Size := Get_File_Size( F_Name, F_Open )
  629.  
  630.    UNTIL ( F_Open OR Abort_Copy );
  631.  
  632.                                    (* Stop if no input file *)
  633.  
  634.    IF Abort_Copy THEN GOTO Abort_It;
  635.  
  636.                                    (* Get name of file to copy to *)
  637.    REPEAT
  638.  
  639.       TextColor( Menu_Text_Color_2 );
  640.       GoToXY( 1 , 2 );
  641.       WRITE(' Enter file to receive copy: ');
  642.       ClrEol;
  643.       G_Name := '';
  644.       TextColor( Menu_Text_Color );
  645.       Read_Edited_String( G_Name );
  646.  
  647.       IF ( ( LENGTH( G_Name ) = 0 ) OR ( G_Name = CHR( ESC ) ) ) THEN
  648.          Abort_Copy := TRUE
  649.       ELSE
  650.          G_Size := Get_File_Size( G_Name, G_Open );
  651.  
  652.       IF G_Open THEN
  653.          BEGIN
  654.             GoToXY( 1 , 3 );
  655.             G_Open := NOT YesNo(' File already exists, overwrite (Y/N)? ');
  656.          END;
  657.  
  658.    UNTIL ( ( NOT G_Open ) OR Abort_Copy );
  659.  
  660.                                    (* Open input file *)
  661.    ASSIGN( F , F_Name );
  662.    RESET ( F , 1 );
  663.                                    (* Open output file *)
  664.    ASSIGN ( G , G_Name );
  665.    REWRITE( G , 1 );
  666.  
  667.                                    (* Report file size *)
  668.    TextColor( Menu_Text_Color_2 );
  669.  
  670.    GoToXY( 1 , 4 );
  671.    WRITE('Size of file ',F_Name,' in bytes is ',F_Size:8 );
  672.  
  673.    GoToXY( 1 , 5 );
  674.    WRITE('Bytes copied: ');
  675.  
  676.    BytesDone := 0;
  677.                                    (* Perform the copy *)
  678.    REPEAT
  679.  
  680.       BlockRead( F, Buffer, BufSize, BytesRead );
  681.  
  682.       IF ( Int24Result <> 0 ) THEN
  683.          BEGIN
  684.             GoToXY( 1 , 6 );
  685.             WRITE('Error reading input file, copy stops.');
  686.             Qerr := TRUE;
  687.          END;
  688.  
  689.       IF ( ( BytesRead > 0 ) AND ( NOT Qerr ) ) THEN
  690.          BEGIN
  691.             BlockWrite( G, Buffer, BytesRead );
  692.             IF ( Int24Result <> 0 ) THEN
  693.                BEGIN
  694.                   GoToXY( 1 , 6 );
  695.                   WRITE('Error writing output file, copy stops.');
  696.                   Qerr := TRUE;
  697.                END;
  698.          END;
  699.  
  700.       BytesDone := BytesDone + BytesRead;
  701.  
  702.       GoToXY( 15 , 5 );
  703.       WRITE( BytesDone:8 );
  704.  
  705.    UNTIL ( ( BytesRead < BufSize ) OR Qerr );
  706.  
  707.                                    (* Close files  *)
  708.    CLOSE( F );
  709.    Err := Int24Result;
  710.    CLOSE( G );
  711.    Err := Int24Result;
  712.  
  713.    GoToXY( 1 , 6 );
  714.  
  715.    IF ( NOT Qerr ) THEN
  716.       WRITE('Copy complete.');
  717.  
  718.    Window_Delay;
  719.  
  720. Abort_It:
  721.                                    (* Restore previous screen *)
  722.  
  723.    Restore_Screen_And_Colors( Saved_Screen );
  724.  
  725. END   (* Copy_A_File *);
  726.  
  727. (*----------------------------------------------------------------------*)
  728. (*              Print_A_File  --- Initiate printing of a file           *)
  729. (*----------------------------------------------------------------------*)
  730.  
  731. PROCEDURE Print_A_File( F_Name : AnyStr );
  732.  
  733. (*----------------------------------------------------------------------*)
  734. (*                                                                      *)
  735. (*     Procedure:  Print_A_File                                         *)
  736. (*                                                                      *)
  737. (*     Purpose:    Initiates printing of a file                         *)
  738. (*                                                                      *)
  739. (*     Calling Sequence:                                                *)
  740. (*                                                                      *)
  741. (*        Print_A_File;                                                 *)
  742. (*                                                                      *)
  743. (*     Calls:                                                           *)
  744. (*              Save_Screen                                             *)
  745. (*              Restore_Screen                                          *)
  746. (*              Draw_Titled_Box                                         *)
  747. (*              Reset_Global_Colors                                     *)
  748. (*                                                                      *)
  749. (*----------------------------------------------------------------------*)
  750.  
  751. VAR
  752.    F_Open      : BOOLEAN;
  753.    Abort_Print : BOOLEAN;
  754.    F_Size      : LONGINT;
  755.    Err         : INTEGER;
  756.  
  757. BEGIN (* Print_A_File *)
  758.                                    (* Announce file print *)
  759.  
  760.    Draw_Titled_Box( Saved_Screen, 5, 10, 75, 15, 'Print a file' );
  761.  
  762.                                    (* Print a file not allowed      *)
  763.                                    (* if logging session to printer *)
  764.  
  765.    TextColor( Menu_Text_Color_2 );
  766.  
  767.    IF Printer_On THEN
  768.       BEGIN
  769.          WRITELN('Can''t print a file while session logging active.');
  770.          Window_Delay;
  771.          Restore_Screen_And_Colors( Saved_Screen );
  772.          EXIT;
  773.       END;
  774.                                    (* Currently spooling -- see if *)
  775.                                    (* we are to stop.              *)
  776.    IF Print_Spooling THEN
  777.       BEGIN
  778.          F_Open := YesNo('File already being printed, stop it (Y/N)? ');
  779.          IF F_Open THEN
  780.             BEGIN
  781.                Print_Spooling := FALSE;
  782.                CLOSE( Spool_File );
  783.                DISPOSE( Spool_Buffer );
  784.             END
  785.          ELSE
  786.             BEGIN
  787.                Restore_Screen_And_Colors( Saved_Screen );
  788.                EXIT;
  789.             END;
  790.       END;
  791.  
  792.    Abort_Print := FALSE;
  793.    F_Open      := FALSE;
  794.                                    (* Get name of file to copy *)
  795.    GoToXY( 1 , 1 );
  796.    WRITE(' Enter file to be printed:    ');
  797.    ClrEol;
  798.  
  799.    TextColor( Menu_Text_Color );
  800.    IF ( LENGTH( F_Name ) = 0 ) THEN
  801.       Read_Edited_String( F_Name )
  802.    ELSE
  803.       WRITE( F_Name );
  804.    WRITELN;
  805.  
  806.    TextColor( Menu_Text_Color_2 );
  807.  
  808.    IF ( ( LENGTH( F_Name ) > 0 ) AND ( F_Name <> CHR( ESC ) ) ) THEN
  809.       BEGIN
  810.          F_Size := Get_File_Size( F_Name, F_Open );
  811.          IF ( NOT F_Open ) THEN
  812.             BEGIN
  813.                WRITE(' Can''t open that file.');
  814.                ClrEol;
  815.                Window_Delay;
  816.                GoToXY( 1 , WhereY );
  817.                ClrEol;
  818.                Abort_Print := TRUE;
  819.             END;
  820.       END
  821.    ELSE
  822.       Abort_Print := TRUE;
  823.                                    (* Stop if no file to print *)
  824.    IF ( NOT Abort_Print ) THEN
  825.       BEGIN
  826.                                    (* Open file to print and read in *)
  827.                                    (* first buffer full of data      *)
  828.  
  829.          ASSIGN( Spool_File , F_Name );
  830.          RESET ( Spool_File , 1 );
  831.          
  832.          NEW( Spool_Buffer );
  833.  
  834.          IF ( Spool_Buffer = NIL ) THEN
  835.             BEGIN
  836.                WRITELN;
  837.                WRITELN(' Not enough memory to print file, print cancelled.');
  838.                Press_Any;
  839.             END
  840.          ELSE
  841.             BEGIN
  842.  
  843.                Spool_Buffer_Count := Max_Spool_Buffer_Count;
  844.  
  845.                BlockRead( Spool_File, Spool_Buffer^, Max_Spool_Buffer_Count,
  846.                           Spool_Buffer_Count );
  847.  
  848.                Err := Int24Result;
  849.  
  850.                Spool_Buffer_Pos := 0;
  851.  
  852.                Print_Spooling := TRUE;
  853.  
  854.                WRITELN;
  855.                WRITELN(' File ',F_Name,' starting to print.');
  856.                Window_Delay;
  857.  
  858.             END;
  859.  
  860.       END;
  861.                                    (* Restore previous screen *)
  862.  
  863.    Restore_Screen_And_Colors( Saved_Screen );
  864.  
  865. END   (* Print_A_File *);
  866.