(*----------------------------------------------------------------------*) (* PibFileManipulation --- File Manipulation for Turbo *) (*----------------------------------------------------------------------*) OVERLAY PROCEDURE PibFileManipulation; (*----------------------------------------------------------------------*) (* *) (* Procedure: PibFileManipulation *) (* *) (* Purpose: Central control routine for file manipulation *) (* *) (* Calling Sequence: *) (* *) (* PibFileManipulation; *) (* *) (* Calls: *) (* *) (* Remarks: *) (* *) (* This routine exists to centralize file manipulation so that *) (* the Turbo Pascal overlay scheme will work. *) (* *) (*----------------------------------------------------------------------*) VAR File_Menu : Menu_Type; I : INTEGER; (*----------------------------------------------------------------------*) (* Get_File_Size --- Get size in bytes for a file *) (*----------------------------------------------------------------------*) FUNCTION Get_File_Size( Fname: AnyStr; VAR OpenOK : BOOLEAN ): REAL; (*----------------------------------------------------------------------*) (* *) (* Procedure: Get_File_Size *) (* *) (* Purpose: Get size in bytes for a file *) (* *) (* Calling Sequence: *) (* *) (* Fsize := Get_File_Size( Fname : AnyStr; *) (* VAR OpenOK : BOOLEAN ) : Real; *) (* *) (* Fname --- name of file to find size of *) (* OpenOK --- set TRUE if file opened successfully *) (* Fsize --- file size in bytes *) (* *) (* Calls: *) (* *) (* RESET *) (* Int24Result *) (* ASSIGN *) (* LongFileSize *) (* Close *) (* *) (* Remarks: *) (* *) (* The file must not already be opened before calling this *) (* routine. *) (* *) (*----------------------------------------------------------------------*) VAR F : FILE OF BYTE; BEGIN (* Get_File_Size *) Get_File_Size := 0.0; ASSIGN( F , Fname ); (*$I- *) RESET ( F ); (*$I+ *) IF Int24Result = 0 THEN BEGIN Get_File_Size := LongFileSize( F ); CLOSE( F ); OpenOK := TRUE; END ELSE OpenOK := FALSE; END (* Get_File_Size *); (*----------------------------------------------------------------------*) (* View_A_File --- List ascii file *) (*----------------------------------------------------------------------*) PROCEDURE View_A_File; (*----------------------------------------------------------------------*) (* *) (* Procedure: View_A_File *) (* *) (* Purpose: Lists selected ascii file *) (* *) (* Calling Sequence: *) (* *) (* View_A_File; *) (* *) (* Calls: View_Prompt *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* *) (* Remarks: *) (* *) (* This routine will list non-ascii files, but they will be *) (* meaningless. *) (* *) (*----------------------------------------------------------------------*) VAR View_File_Name : STRING[15]; ViewFile : Text; View_File_Open : BOOLEAN; View_File_Size : Real; BEGIN (* View_A_File *) (* Draw view menu *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 5, 4, 75, 25, Menu_Frame_Color, Menu_Text_Color, 'View A File' ); (* Get name of file to list *) WRITELN; WRITE('Enter name of file to list: '); READLN( View_File_Name ); View_File_Open := FALSE; (* Ensure file exists ... *) IF LENGTH( View_File_Name ) > 0 THEN BEGIN (* View_File_Name > 0 *) View_File_Size := Get_File_Size( View_File_Name , View_File_Open ); IF ( NOT View_File_Open ) THEN BEGIN (* Int24Result <> 0 *) TextColor( Menu_Text_Color + Blink ); WRITELN('>>> Can''t open file ',View_File_Name,' for viewing.'); DELAY( Two_Second_Delay ); TextColor( Menu_Text_Color ); END (* Int24Result <> 0 *) (* ... and file is not empty *) ELSE IF ( View_File_Size <= 0 ) THEN BEGIN (* File is empty *) TextColor( Menu_Text_Color + Blink ); WRITELN('>>> File ',View_File_Name,' is empty.'); DELAY( Two_Second_Delay ); TextColor( Menu_Text_Color ); END (* File is empty *) ELSE (* Write header line *) BEGIN (* List the File *) ASSIGN( ViewFile, View_File_Name ); RESET( ViewFile ); Clear_Window; RvsVideoOn( Menu_Text_Color , BackGround_Color ); WRITELN('LISTING OF FILE: ',View_File_Name, ' SIZE: ', View_File_Size:8:0, ' BYTES.'); RvsVideoOff( Menu_Text_Color , BackGround_Color ); (* RESET window so header doesn't vanish *) Window( 7, 6, 74, 24 ); GoToXY( 1 , WhereY ); (* List the file *) View_Count := 0; View_Done := FALSE; REPEAT (* Read and write line from file *) READLN ( ViewFile , View_Line ); IF Length( View_Line ) > 65 THEN View_Line[0] := CHR( 65 ); WRITELN( View_Line ); (* Increment count of lines displayed *) View_Count := View_Count + 1; (* Prompt if end of screen *) IF View_Count > 17 THEN View_Prompt( View_Done , View_Count ); UNTIL EOF( ViewFile ) OR View_Done; RvsVideoOn( Menu_Text_Color , BackGround_Color ); WRITE('Viewing of file complete. ', 'Hit any key to continue.'); RvsVideoOff( Menu_Text_Color , BackGround_Color ); WHILE ( Not KeyPressed ) DO ; READ( Kbd , View_Char[1] ); END (* List the file *); END (* View_File_Name > 0 *); IF View_File_Open THEN Close( ViewFile ); Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* View_A_File *); (*----------------------------------------------------------------------*) (* View_Directory --- List files in current directory *) (*----------------------------------------------------------------------*) PROCEDURE View_Directory; (*----------------------------------------------------------------------*) (* *) (* Procedure: View_Directory *) (* *) (* Purpose: Lists files in current MSDOS directory *) (* *) (* Calling Sequence: *) (* *) (* View_Directory; *) (* *) (* Calls: View_Prompt *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* Dir_Get_Default_Drive *) (* Dir_Get_Current_Path *) (* Dir_Find_First_File *) (* Dir_Find_Next_File *) (* Dir_Convert_Time *) (* Dir_Convert_Date *) (* *) (*----------------------------------------------------------------------*) VAR View_Directory_Name : AnyStr; Drive_Ch : CHAR; Iok : INTEGER; File_Entry : Directory_Record; S_File_Name : STRING[14]; S_File_Time : STRING[8]; S_File_Date : STRING[8]; S_File_Size : Real; S_File_Xmodem_Time : STRING[8]; Fs1 : Real; Fs2 : Real; I : INTEGER; BEGIN (* View_Directory *) (* Draw view menu *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 5, 4, 75, 25, Menu_Frame_Color, Menu_Text_Color, 'View Current Directory' ); RvsVideoOn( Menu_Text_Color , BackGround_Color ); Drive_Ch := Dir_Get_Default_Drive; Iok := Dir_Get_Current_Path( Drive_Ch , View_Directory_Name ); WRITELN('LISTING OF DIRECTORY: ',Drive_Ch + ':\' + View_Directory_Name ); WRITELN(' File Name Size Date Time Xfer Time'); RvsVideoOff( Menu_Text_Color , BackGround_Color ); (* RESET window so header doesn't vanish *) Window( 7, 7, 74, 24 ); GoToXY( 1 , WhereY ); (* List the directory contents *) View_Count := 0; View_Done := ( Dir_Find_First_File( '*.*', File_Entry ) <> 0 ); WHILE( NOT View_Done ) DO BEGIN (* Display Next Directory Entry *) S_File_Name := ''; I := 1; (* Pick up file name *) WHILE( ( I <= 14 ) AND ( File_Entry.File_Name[I] <> CHR(0) ) ) DO BEGIN S_File_Name := S_File_Name + File_Entry.File_Name[I]; I := I + 1; END; (* Pick up creation date and time *) Dir_Convert_Time( File_Entry.File_Time , S_File_Time ); Dir_Convert_Date( File_Entry.File_Date , S_File_Date ); (* Pick up file size *) Fs1 := File_Entry.File_Size[1]; Fs2 := File_Entry.File_Size[2]; IF Fs1 < 0 THEN Fs1 := Fs1 + 65536.0; IF Fs2 < 0 THEN Fs2 := Fs2 + 65536.0; S_File_Size := Fs2 * 65536.0 + Fs1; (* Pick up transfer time *) S_File_Xmodem_Time := TimeString( ROUND( ( S_File_Size / 128.0 ) + 0.49 ) * ( Trans_Time_Val / Baud_Rate ) ); (* Display entry *) WRITELN( S_File_Name:14, ' ', S_File_Size:8:0, ' ', S_File_Date, ' ', S_File_Time,' ',S_File_Xmodem_Time ); (* Increment count of lines displayed *) View_Count := View_Count + 1; (* Prompt if end of screen *) IF View_Count > 16 THEN View_Prompt( View_Done , View_Count ); View_Done := View_Done OR ( Dir_Find_Next_File( File_Entry ) <> 0 ); END; (* Issue final end-of-directory prompt *) RvsVideoOn( Menu_Text_Color , BackGround_Color ); WRITE('Viewing of directory complete. ', 'Hit any key to continue.'); RvsVideoOff( Menu_Text_Color , BackGround_Color ); WHILE ( NOT KeyPressed ) DO ; READ( Kbd , View_Char ); (* Restore previous screen *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* View_Directory *); (*----------------------------------------------------------------------*) (* Log_Drive_Change --- Change current logged drive *) (*----------------------------------------------------------------------*) PROCEDURE Log_Drive_Change; (*----------------------------------------------------------------------*) (* *) (* Procedure: Log_Drive_Change *) (* *) (* Purpose: Change current logged drive *) (* *) (* Calling Sequence: *) (* *) (* Log_Drive_Change *) (* *) (* Calls: Dir_Get_Default_Drive *) (* Dir_Set_Default_Drive *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* *) (* *) (*----------------------------------------------------------------------*) VAR Drive_Ch : STRING[1]; Drive_No : INTEGER; Drive_Count : INTEGER; BEGIN (* Log_Drive_Change *); (* Draw log change menu *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 5, 10, 55, 15, Menu_Frame_Color, Menu_Text_Color, 'Change Current Logged Drive' ); GoToXY( 1 , 1 ); Drive_Ch[1] := Dir_Get_Default_Drive; WRITELN('Current logged drive is ',Drive_Ch[1] ); GoToXY( 1 , 2 ); WRITE('Enter letter for new logged drive: '); READ( Kbd , Drive_Ch ); WRITE( Drive_Ch ); IF LENGTH( Drive_Ch ) = 0 THEN BEGIN WRITELN; WRITELN('*** Logged drive remains unchanged.') END ELSE BEGIN (* Figure no. of drives in system *) Drive_Count := Dir_Count_Drives; (* Drive no. for entered letter *) Drive_No := ORD( UpCASE( Drive_Ch ) ) - ORD( 'A' ); (* Check if drive legitimate *) IF ( Drive_No < 0 ) OR ( Drive_No > Drive_Count ) THEN WRITELN('*** Invalid drive, logged drive unchanged.') ELSE BEGIN (* Change default drive *) Dir_Set_Default_Drive( Drive_Ch ); WRITELN; WRITELN('*** Logged drive changed to ',Drive_Ch ); END; END; DELAY( Two_Second_Delay ); (* Restore previous screen *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Log_Drive_Change *); (*----------------------------------------------------------------------*) (* Change_Subdirectory --- Change current disk subdirectory *) (*----------------------------------------------------------------------*) PROCEDURE Change_Subdirectory; (*----------------------------------------------------------------------*) (* *) (* Procedure: Change_Subdirectory *) (* *) (* Purpose: Change current subdirectory *) (* *) (* Calling Sequence: *) (* *) (* Change_Subdirectory; *) (* *) (* Calls: Dir_Get_Default_Drive *) (* Dir_Set_Current_Path *) (* Dir_Get_Current_Path *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* *) (* *) (*----------------------------------------------------------------------*) VAR Path_Name : AnyStr; Iok : INTEGER; Drive_Ch : CHAR; BEGIN (* Change_Subdirectory *) (* Draw directory change menu *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 5, 10, 60, 15, Menu_Frame_Color, Menu_Text_Color, 'Change Current Directory' ); GoToXY( 1 , 1 ); Drive_Ch := Dir_Get_Default_Drive; Iok := Dir_Get_Current_Path( Drive_Ch , Path_Name ); WRITELN('Current directory is ', Drive_Ch + ':\' + Path_Name ); WRITE('Enter name of new directory path: '); READ( Path_Name ); WRITELN; IF LENGTH( Path_Name ) = 0 THEN WRITELN('*** Current directory remains unchanged.') ELSE BEGIN IF Dir_Set_Current_Path( Path_Name ) = 0 THEN WRITELN('*** Current directory changed to ', Drive_Ch + ':' + Path_Name ) ELSE WRITELN('*** Error found, directory not changed'); END; DELAY( Two_Second_Delay ); (* Restore previous screen *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Change_Subdirectory *); (*----------------------------------------------------------------------*) (* Delete_A_File --- Delete a file *) (*----------------------------------------------------------------------*) PROCEDURE Delete_A_File; (*----------------------------------------------------------------------*) (* *) (* Procedure: Delete_A_File *) (* *) (* Purpose: Delete file in current subdirectory *) (* *) (* Calling Sequence: *) (* *) (* Delete_A_File; *) (* *) (* Calls: Dir_Delete_File *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* *) (*----------------------------------------------------------------------*) VAR File_Name : AnyStr; BEGIN (* Delete_A_File *) (* Draw delete file menu *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 5, 10, 60, 14, Menu_Frame_Color, Menu_Text_Color + Blink, 'Delete A File -- Be Careful!' ); TextColor( Menu_Text_Color ); GoToXY( 1 , 1 ); WRITE('Enter name of file to delete: '); READ( File_Name ); WRITELN; IF LENGTH( File_Name ) = 0 THEN WRITELN('*** No file to delete.') ELSE IF ( Dir_Delete_File( File_Name ) = 0 ) THEN WRITELN('*** File deleted.') ELSE WRITELN('*** File not found to delete or read-only'); DELAY( Two_Second_Delay ); (* Restore previous screen *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Delete_A_File *); (*----------------------------------------------------------------------*) (* Find_Free_Space_On_Drive --- Find free space on a drive *) (*----------------------------------------------------------------------*) PROCEDURE Find_Free_Space_On_Drive; (*----------------------------------------------------------------------*) (* *) (* Procedure: Find_Free_Space_On_Drive *) (* *) (* Purpose: Finds free space on a drive *) (* *) (* Calling Sequence: *) (* *) (* Find_Free_Space_On_Drive; *) (* *) (* Calls: Dir_Get_Free_Space *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* *) (*----------------------------------------------------------------------*) VAR Drive_Ch: CHAR; Fspace: REAL; BEGIN (* Find_Free_Space_On_Drive *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 10, 10, 61, 15, Menu_Frame_Color, Menu_Text_Color, 'Free space on drive' ); REPEAT GoToXY( 1 , 1 ); ClrEol; Drive_CH := ' '; WRITE('Which drive? '); READ( Kbd , Drive_Ch ); WRITE( Drive_Ch ); Drive_Ch := UpCase( Drive_Ch ); UNTIL( Drive_Ch IN [' ','A'..'Z'] ); IF Drive_Ch <> ' ' THEN BEGIN WRITELN; FSpace := Dir_Get_Free_Space( Drive_Ch ); IF Fspace > 0.0 THEN WRITELN('Free space on drive ',Drive_Ch,' is ',Fspace:8:0,' bytes') ELSE WRITELN('Can''t find free space for drive ',Drive_Ch); END; WRITELN(' '); WRITE ('Hit any key to continue'); READ( Kbd, Drive_Ch ); IF ( Drive_Ch = CHR( ESC ) ) AND KeyPressed THEN READ( Kbd, Drive_Ch ); Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Find_Free_Space_On_Drive *); (*----------------------------------------------------------------------*) (* Copy_A_File --- Copy a file *) (*----------------------------------------------------------------------*) PROCEDURE Copy_A_File; (*----------------------------------------------------------------------*) (* *) (* Procedure: Copy_A_File *) (* *) (* Purpose: Copies a file *) (* *) (* Calling Sequence: *) (* *) (* Copy_A_File; *) (* *) (* Calls: *) (* Save_Screen *) (* Restore_Screen *) (* Draw_Menu_Frame *) (* Reset_Global_Colors *) (* Open_File_Handle *) (* Create_File_Handle *) (* Close_File_Handle *) (* Read_File_Handle *) (* Write_File_Handle *) (* *) (*----------------------------------------------------------------------*) CONST BufSize = 4096 (* Buffer size *); VAR F_Handle : INTEGER (* File to be copied *); F_Size : REAL (* Size of file *); F_Open : BOOLEAN (* If F opened OK *); G_Handle : INTEGER (* File copied to *); G_Open : BOOLEAN (* If G opened OK *); G_Size : REAL (* Size of G *); F_Name : AnyStr (* Input file name *); G_Name : AnyStr (* Output file name *); Abort_Copy : BOOLEAN (* TRUE to stop copy *); BytesRead : INTEGER (* # of bytes read *); BytesDone : REAL (* Total bytes read *); (* Buffer area *) Buffer : PACKED ARRAY[ 1 .. BufSize ] OF CHAR; Err : INTEGER (* I/O error flag *); LABEL Abort_it; BEGIN (* Copy_A_File *) (* Announce file copy *) Save_Screen( Saved_Screen ); Draw_Menu_Frame( 5, 10, 75, 17, Menu_Frame_Color, Menu_Text_Color, 'Copy a file' ); Abort_Copy := FALSE; (* Get name of file to copy *) REPEAT GoToXY( 1 , 1 ); WRITE(' Enter file to be copied: '); ClrEol; READLN( F_Name ); IF LENGTH( F_Name ) > 0 THEN F_Size := Get_File_Size( F_Name, F_Open ) ELSE Abort_Copy := TRUE; UNTIL ( F_Open OR Abort_Copy ); (* Stop if no input file *) IF Abort_Copy THEN GOTO Abort_It; (* Get name of file to copy to *) REPEAT GoToXY( 1 , 2 ); WRITE(' Enter file to receive copy: '); ClrEol; READLN( G_Name ); IF LENGTH( G_Name ) > 0 THEN G_Size := Get_File_Size( G_Name, G_Open ) ELSE Abort_Copy := TRUE; IF G_Open THEN BEGIN GoToXY( 1 , 3 ); G_Open := NOT YesNo(' File already exists, overwrite (Y or N)? '); END; UNTIL ( ( NOT G_Open ) OR Abort_Copy ); (* Open input file *) Err := Open_File_Handle( F_Name, Access_Read_Mode, F_Handle ); (* Open output file *) Err := Create_File_Handle( G_Name , Access_Write_Mode, G_Handle ); (* Report file size *) GoToXY( 1 , 4 ); WRITE('Size of file ',F_Name,' in bytes is ',F_Size:8:0 ); GoToXY( 1 , 5 ); WRITE('Bytes copied: '); BytesDone := 0.0; (* Perform the copy *) REPEAT BytesRead := BufSize; Err := Read_File_Handle( F_Handle, Buffer, BytesRead ); IF BytesRead > 0 THEN Err := Write_File_Handle( G_Handle, Buffer, BytesRead ); BytesDone := BytesDone + BytesRead; GoToXY( 15 , 5 ); WRITE( BytesDone:8:0 ); UNTIL ( BytesRead < BufSize ); (* Close files *) Err := Close_File_Handle( F_Handle ); Err := Close_File_Handle( G_Handle ); GoToXY( 1 , 6 ); WRITE('Copy complete.'); DELAY( Two_Second_Delay ); Abort_It: (* Restore previous screen *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Copy_A_File *); (*----------------------------------------------------------------------*) BEGIN (* PibFileManipulation *) File_Menu.Menu_Size := 8; File_Menu.Menu_Row := 11; File_Menu.Menu_Column := 30; File_Menu.Menu_Tcolor := Menu_Text_Color; File_Menu.Menu_Bcolor := BackGround_Color; File_Menu.Menu_Fcolor := Menu_Frame_Color; File_Menu.Menu_Width := 0; File_Menu.Menu_Height := 0; File_Menu.Menu_Default := 8; FOR I := 1 TO 8 DO WITH File_Menu.Menu_Entries[I] DO BEGIN Menu_Item_Row := I; Menu_Item_Column := 2; CASE I Of 1: Menu_Item_Text := 'A)ctive directory change'; 2: Menu_Item_Text := 'C)opy file'; 3: Menu_Item_Text := 'D)irectory display'; 4: Menu_Item_Text := 'E)rase file'; 5: Menu_Item_Text := 'F)ree space on drive'; 6: Menu_Item_Text := 'L)ogged drive change'; 7: Menu_Item_Text := 'V)iew a file'; 8: Menu_Item_Text := 'Q)uit'; END (* CASE *); END; File_Menu.Menu_Title := 'Choose File Function: '; Menu_Display_Choices( File_Menu ); CASE Menu_Get_Choice( File_Menu , Erase_Menu ) OF 1: Change_Subdirectory; 2: Copy_A_File; 3: View_Directory; 4: Delete_A_File; 5: Find_Free_Space_On_Drive; 6: Log_Drive_Change; 7: View_A_File; ELSE; END (* Case *); END (* PibFileManipulation *);