home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 September
/
Simtel20_Sept92.cdr
/
msdos
/
catalog
/
pibcat17.arc
/
PIBCATS4.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-03-31
|
25KB
|
615 lines
(*----------------------------------------------------------------------*)
(* Move_File_Info --- Save file information for sorting *)
(*----------------------------------------------------------------------*)
PROCEDURE Move_File_Info( Full : SearchRec;
VAR Short: Short_Dir_Record );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Move_File_Info *)
(* *)
(* Purpose: Saves information about file in compact form *)
(* *)
(* Calling sequence: *)
(* *)
(* Move_File_Info( Full : SearchRec; *)
(* VAR Short: Short_Dir_Record ); *)
(* *)
(* Full --- Directory info as retrieved from DOS *)
(* Short --- Directory info with garbage thrown out *)
(* *)
(* Remarks: *)
(* *)
(* This routine copies the useful stuff about a file to a *)
(* shorter record which is more easily sorted. *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* Move_File_Info *)
Short.File_Time := Full.Time;
Short.File_Size := Full.Size;
Short.File_Attr := Full.Attr;
Short.File_Name := Full.Name + DUPL( ' ' , 12 - LENGTH( Full.Name ) );
END (* Move_File_Info *);
(*----------------------------------------------------------------------*)
(* Display_File_Info --- Display information about a file *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_File_Info( Dir_Entry : Short_Dir_Record );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Display_File_Info *)
(* *)
(* Purpose: Displays information for current file *)
(* *)
(* Calling sequence: *)
(* *)
(* Display_File_Info( Dir_Entry : Short_Dir_Record ); *)
(* *)
(* Dir_Entry --- Directory record describing file *)
(* *)
(* Remarks: *)
(* *)
(* The counters for total number of files and total file space *)
(* used are incremented here. *)
(* *)
(*----------------------------------------------------------------------*)
CONST
Null_Path_Name : AnyStr = '';
VAR
STime : STRING[10];
SDate : STRING[10];
I : INTEGER;
BEGIN (* Display_File_Info *)
(* Handle condensed listing *)
IF Do_Condensed_Listing THEN
Write_Condensed_Line( Dir_Entry.File_Name, Dir_Entry.File_Size,
Dir_Entry.File_Time, Null_Path_Name,
Current_Subdirectory )
ELSE (* Handle normal listing *)
WITH Dir_Entry DO
BEGIN
(* Get date and time of creation *)
Dir_Convert_Date_And_Time( File_Time , SDate , STime );
(* Ensure space left this page *)
IF ( Lines_Left < 1 ) THEN
Display_Page_Titles;
(* Write out file name *)
WRITE( Output_File , Left_Margin_String , ' ' , File_Name );
FOR I := LENGTH( File_Name ) TO 14 DO
WRITE( Output_File , ' ' );
(* Write length, date, and time *)
WRITE ( Output_File , File_Size:8 , ' ' );
WRITE ( Output_File , SDate , ' ' );
WRITE ( Output_File , STime );
WRITELN( Output_File );
(* Update count of lines left *)
IF Do_Printer_Format THEN
DEC( Lines_Left );
END;
(* Increment total file count *)
INC( Total_Files );
(* Increment total space used *)
Total_Space := Total_Space + Dir_Entry.File_Size;
END (* Display_File_Info *);
(*----------------------------------------------------------------------*)
(* Sort_Files --- Sort files in ascending order by name *)
(*----------------------------------------------------------------------*)
PROCEDURE Sort_Files( First : INTEGER;
Last : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Sort_Files *)
(* *)
(* Purpose: Sorts file names in current directory *)
(* *)
(* Calling sequence: *)
(* *)
(* Sort_Files( First : INTEGER; Last : INTEGER ); *)
(* *)
(* First --- First entry in 'File_Stack' to sort *)
(* Last --- Last entry in 'File_Stack' to sort *)
(* *)
(* Remarks: *)
(* *)
(* A shell sort is used to put the file names for the current *)
(* directory in ascending order. The current directory's files *)
(* are bracketed by 'First' and 'Last'. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Temp : Short_Dir_Record;
I : INTEGER;
J : INTEGER;
D : INTEGER;
BEGIN (* Sort_Files *)
D := SUCC( Last - First );
WHILE( D > 1 ) DO
BEGIN
IF ( D < 5 ) THEN
D := 1
ELSE
D := TRUNC( 0.45454 * D );
FOR I := ( Last - D ) DOWNTO First DO
BEGIN
Temp := File_Stack[ I SHR SegShift ]^[ I AND MaxFiles ];
J := I + D;
WHILE( ( Temp.File_Name >
File_Stack[ J SHR SegShift ]^[ J AND MaxFiles ].File_Name ) AND
( J <= Last ) ) DO
BEGIN
File_Stack[ ( J - D ) SHR SegShift ]^[ ( J - D ) AND MaxFiles ] :=
File_Stack[ J SHR SegShift ]^[ J AND MaxFiles ];
J := J + D;
END;
File_Stack[ ( J - D ) SHR SegShift ]^[ ( J - D ) AND MaxFiles ] := Temp;
END;
END;
END (* Sort_Files *);
(*----------------------------------------------------------------------*)
(* Find_Files --- Recursively search directories for files *)
(*----------------------------------------------------------------------*)
PROCEDURE Find_Files( VAR Subdir : AnyStr;
VAR File_Spec : AnyStr;
Attr : INTEGER;
Levels : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Find_Files *)
(* *)
(* Purpose: Recursively traverses directories looking for files *)
(* *)
(* Calling sequence: *)
(* *)
(* Find_Files( VAR Subdir : AnyStr; *)
(* VAR File_Spec : AnyStr; *)
(* Attr : INTEGER; *)
(* Levels : INTEGER ); *)
(* *)
(* Subdir --- subdirectory name of this level *)
(* File_Spec --- DOS file spec to match *)
(* Attr --- attribute type to match *)
(* Levels --- current subdirectory level depth *)
(* *)
(* Remarks: *)
(* *)
(* This is the actual heart of PibCat. This routine invokes *)
(* itself recursively to traverse all subdirectories looking for *)
(* files which match the given file specification. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Dir_Entry : SearchRec;
Path : AnyStr;
Error : INTEGER;
I : INTEGER;
Dir : STRING[14];
Cur_Count : INTEGER;
Skip_Attr : INTEGER;
Files_Here : INTEGER;
ISeg : INTEGER;
IOff : INTEGER;
FileName : AnyStr;
LABEL Quit;
BEGIN (* Find_Files *)
(* Save current file count *)
Cur_Count := File_Count;
(* No files in this directory yet *)
Files_Here := 0;
(* Don't list directories as files *)
Skip_Attr := VolumeID + Directory;
IF ( Levels >= 1 ) THEN
BEGIN
(* Get full file spec to search for *)
Path := Subdir + File_Spec;
(* Get first file on this level *)
FindFirst( Path, AnyFile, Dir_Entry );
Error := DosError;
(* Get info on remaining files *)
(* on this level. *)
WHILE ( Error = 0 ) DO
BEGIN
(* Increment count of files in this dir *)
(* including subdirectories *)
INC( File_Count );
(* Increment non-directory file count *)
IF ( ( Dir_Entry.Attr AND Skip_Attr ) = 0 ) THEN
INC( Files_Here );
(* Save info on this file *)
Move_File_Info ( Dir_Entry ,
File_Stack[ File_Count SHR SegShift ]^[ File_Count AND MaxFiles ] );
(* Get next file entry *)
FindNext( Dir_Entry );
Error := DosError;
(* Check for ^C at keyboard *)
IF KeyPressed THEN
IF QuitFound THEN
GOTO Quit;
END;
(* Sort file names *)
Sort_Files( SUCC( Cur_Count ) , File_Count );
(* Increment directory count *)
INC ( Total_Dirs );
(* Report scanning this subdirectory *)
WRITELN( Status_File , ' Scanning: ', Subdir );
(* Display file info header *)
IF ( Files_Here > 0 ) THEN
BEGIN
Subdir_Title := Left_Margin_String + ' Directory: ' + Subdir;
IF ( NOT Do_Condensed_Listing ) THEN
IF Do_Printer_Format THEN
IF ( Lines_Left < 4 ) THEN
Display_Page_Titles
ELSE
BEGIN
WRITELN( Output_File );
WRITELN( Output_File , Subdir_Title );
WRITELN( Output_File );
END
ELSE
BEGIN
WRITELN( Output_File );
WRITELN( Output_File , Subdir_Title );
WRITELN( Output_File );
END;
(* Count lines left on page *)
IF Do_Printer_Format THEN
BEGIN
DEC( Lines_Left , 3 );
IF ( Lines_Left < 1 ) THEN
Display_Page_Titles;
END;
END;
(* Remove drive from path for *)
(* display purposes. *)
Current_Subdirectory := Subdir;
I := POS( ':' , Current_Subdirectory );
IF ( I > 0 ) THEN
DELETE( Current_Subdirectory, 1, I );
(* Display info on all files *)
(* But don't display directories! *)
FOR I := SUCC( Cur_Count ) TO File_Count DO
BEGIN
ISeg := I SHR SegShift;
IOff := I AND MaxFiles;
(* Display info for current file *)
IF ( ( File_Stack[ ISeg ]^[ IOff ].File_Attr AND Skip_Attr ) = 0 ) THEN
Display_File_Info( File_Stack[ ISeg ]^[ IOff ] );
(* If we're expanding library files, *)
(* and we're expanding them right *)
(* after each library name, then *)
(* check if current file is a lib *)
(* and expand it. *)
IF ( Expand_Libs AND Expand_Libs_In ) THEN
BEGIN
FileName := File_Stack[ ISeg ]^[ IOff ].File_Name;
IF ( POS( '.ARC', FileName ) > 0 ) THEN
Display_Archive_Contents( FileName )
ELSE IF ( POS( '.ZIP', FileName ) > 0 ) THEN
Display_ZIP_Contents( FileName )
ELSE IF ( POS( '.LZH', FileName ) > 0 ) THEN
Display_LZH_Contents( FileName )
ELSE IF ( POS( '.PAK', FileName ) > 0 ) THEN
Display_Archive_Contents( FileName )
ELSE IF ( POS( '.DWC', FileName ) > 0 ) THEN
Display_DWC_Contents( FileName )
ELSE IF ( POS( '.LBR', FileName ) > 0 ) THEN
Display_Lbr_Contents( FileName )
ELSE IF ( POS( '.LZS', FileName ) > 0 ) THEN
Display_LZH_Contents( FileName )
ELSE IF ( POS( '.MD ', FileName ) > 0 ) THEN
Display_MD_Contents( FileName )
ELSE IF ( POS( '.ZOO', FileName ) > 0 ) THEN
Display_ZOO_Contents( FileName );
END;
IF KeyPressed THEN
IF QuitFound THEN
GOTO Quit;
END;
(* List library file contents if requested *)
IF ( Expand_Libs AND ( NOT Expand_Libs_In ) ) THEN
BEGIN
(* List contents of any library files *)
FOR I := SUCC( Cur_Count ) TO File_Count DO
BEGIN
ISeg := I SHR SegShift;
IOff := I AND MaxFiles;
(* If current file is any type of *)
(* library file, then list contents *)
FileName := File_Stack[ ISeg ]^[ IOff ].File_Name;
IF ( POS( '.ARC', FileName ) > 0 ) THEN
Display_Archive_Contents( FileName )
ELSE IF ( POS( '.ZIP', FileName ) > 0 ) THEN
Display_ZIP_Contents( FileName )
ELSE IF ( POS( '.LZH', FileName ) > 0 ) THEN
Display_LZH_Contents( FileName )
ELSE IF ( POS( '.PAK', FileName ) > 0 ) THEN
Display_Archive_Contents( FileName )
ELSE IF ( POS( '.DWC', FileName ) > 0 ) THEN
Display_DWC_Contents( FileName )
ELSE IF ( POS( '.LBR', FileName ) > 0 ) THEN
Display_Lbr_Contents( FileName )
ELSE IF ( POS( '.LZS', FileName ) > 0 ) THEN
Display_LZH_Contents( FileName )
ELSE IF ( POS( '.MD ', FileName ) > 0 ) THEN
Display_MD_Contents( FileName )
ELSE IF ( POS( '.ZOO', FileName ) > 0 ) THEN
Display_ZOO_Contents( FileName );
(* If <CTRL>Break hit, quit. *)
IF KeyPressed THEN
IF QuitFound THEN
GOTO Quit;
END;
END;
IF ( Levels >= 2 ) THEN
BEGIN
(* List all subdirectories to given level *)
(* Note: we read through whole directory *)
(* again since we probably excluded *)
(* directories on first pass. *)
Path := Subdir + '*.*';
(* Get first file *)
FindFirst( Path, AnyFile, Dir_Entry );
Error := DosError;
(* While there are files left ... *)
WHILE ( Error = 0 ) DO
BEGIN
(* See if it's a subdirectory *)
IF ( ( Dir_Entry.Attr AND Directory ) <> 0 ) THEN
BEGIN
(* Yes -- get subdirectory name *)
Dir := Dir_Entry.Name;
(* Ignore '.' and '..' *)
IF ( ( Dir <> '.' ) AND ( Dir <> '..') ) THEN
BEGIN
(* Construct path name for subdirectory *)
Path := Subdir + Dir + '\';
(* List files in subdirectory *)
Find_Files( Path, File_Spec, Attr, PRED( Levels ) );
IF User_Break THEN
GOTO Quit;
END;
END;
(* Get next file entry *)
FindNext( Dir_Entry );
Error := DosError;
END (* WHILE *);
END (* IF Levels >= 2 *);
END (* IF Levels >= 1 *);
(* Restore previous file count *)
Quit:
File_Count := Cur_Count;
END (* Find_Files *);
(*----------------------------------------------------------------------*)
(* Perform_Cataloguing --- Do cataloguing of files *)
(*----------------------------------------------------------------------*)
PROCEDURE Perform_Cataloguing;
VAR
Name : AnyStr;
Subdir : AnyStr;
File_Spec : AnyStr;
I : INTEGER;
Done : BOOLEAN;
BEGIN (* Perform_Cataloguing *)
(* Display volume label *)
Display_Volume_Label;
(* Append disk letter to file spec *)
IF ( POS( '\' , Find_Spec ) = 0 ) THEN
Name := Cat_Drive + ':\' + Find_Spec
ELSE
Name := Cat_Drive + ':' + Find_Spec;
(* Make sure some files get looked at! *)
IF Name[ LENGTH( Name ) ] = '\' THEN
Name := Name + '*.*';
(* Split out directory from file spec *)
Subdir := Name;
I := SUCC( LENGTH( Subdir ) );
Done := FALSE;
REPEAT
DEC( I );
IF ( I > 0 ) THEN
Done := ( Subdir[ I ] = '\' )
ELSE
Done := TRUE;
UNTIL Done;
I := LENGTH( Subdir ) - I;
File_Spec[ 0 ] := CHR( I );
MOVE( Subdir[ 1 + LENGTH( Subdir ) - I ] , File_Spec[ 1 ] , I );
Subdir[ 0 ] := CHR( LENGTH( Subdir ) - I );
(* Begin listing files at specified *)
(* subdirectory *)
Find_Files( Subdir, File_Spec, $FF, 9999 );
END (* Perform_Cataloguing *);
(*----------------------------------------------------------------------*)
(* Terminate --- Terminate cataloguing *)
(*----------------------------------------------------------------------*)
PROCEDURE Terminate;
BEGIN (* Terminate *)
(* Note if catalogue terminated by ^C *)
IF ( NOT Help_Only ) THEN
IF User_Break THEN
BEGIN
IF ( NOT Do_Condensed_Listing ) THEN
BEGIN
IF ( Lines_Left < 6 ) THEN
Display_Page_Titles;
WRITELN( Output_File );
WRITELN( Output_File , Left_Margin_String,
'>>>>> ^C typed, catalog listing INCOMPLETE.');
WRITELN( Output_File );
END;
WRITELN( Status_File , '^C typed, catalog listing INCOMPLETE.' );
END
ELSE
IF ( NOT Do_Condensed_Listing ) THEN
BEGIN (* Indicate file totals *)
IF ( Lines_Left < 9 ) THEN
Display_Page_Titles;
WRITELN( Output_File );
WRITELN( Output_File , Left_Margin_String, ' Totals:');
WRITELN( Output_File , Left_Margin_String,
' Directories scanned: ',Total_Dirs:10);
WRITELN( Output_File , Left_Margin_String,
' Files selected : ',Total_Files:10);
WRITELN( Output_File , Left_Margin_String,
' Bytes in files : ',Total_Space:10);
WRITELN( Output_File , Left_Margin_String,
' Entries selected : ',Total_Entries:10);
WRITELN( Output_File , Left_Margin_String,
' Bytes in entries : ',Total_ESpace:10);
WRITELN( Output_File , Left_Margin_String,
' Bytes free : ',
DiskFree( SUCC( ORD( Cat_Drive ) - ORD('A') ) ):10 );
END;
(* Close output file *)
(*$I-*)
CLOSE( Output_File );
(*$I+*)
IF ( IOResult <> 0 ) THEN;
(* Close status file *)
(*$I-*)
CLOSE( Status_File );
(*$I+*)
IF ( IOResult <> 0 ) THEN;
END (* Terminate *);