home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
catalog
/
pibcat17.arc
/
PIBCATL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-03-31
|
12KB
|
280 lines
(*----------------------------------------------------------------------*)
(* Display_Lbr_Contents --- Display contents of library (.LBR) file *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_Lbr_Contents( LbrFileName : AnyStr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Display_Lbr_Contents *)
(* *)
(* Purpose: Displays contents of a library file (.LBR file) *)
(* *)
(* Calling sequence: *)
(* *)
(* Display_Lbr_Contents( LbrFileName : AnyStr ); *)
(* *)
(* LbrFileName --- name of library file whose contents *)
(* are to be listed. *)
(* *)
(* Calls: *)
(* *)
(* Aside from internal subroutines, these routines are required: *)
(* *)
(* Dir_Convert_Date_And_Time *)
(* --- convert DOS packed date/time to string*)
(* Open_File --- open a file *)
(* Close_File --- close a file *)
(* Entry_Matches --- Perform wildcard match *)
(* Display_Page_Titles *)
(* --- Display titles at top of page *)
(* DUPL --- Duplicate a character into a string *)
(* *)
(*----------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Map of Library file (.LBR) entry header *)
(*----------------------------------------------------------------------*)
TYPE
Lbr_Entry_Type = RECORD
Flag : BYTE (* LBR - Entry flag *);
Name : ARRAY[1 .. 8] OF CHAR (* File name *);
Ext : ARRAY[1 .. 3] OF CHAR (* Extension *);
Offset: WORD (* Offset within Library *);
N_Sec : WORD (* Number of 128-byte sectors *);
CRC : WORD (* CRC (optional) *);
Date : WORD (* # days since 1/1/1978 *);
UDate : WORD (* Date of last update *);
Time : WORD (* Packed time *);
UTime : WORD (* Time of last update *);
Pads : ARRAY[1 .. 6] OF CHAR (* Currently unused *);
END;
CONST
Lbr_Header_Length = 32 (* Length of library file header entry *);
VAR
LbrFile : FILE (* Library file *);
Lbr_Entry : Lbr_Entry_Type (* Header describing one file in library *);
Lbr_Pos : LONGINT (* Current byte position in library *);
Lbr_Dir_Size : INTEGER (* # of entries in library directory *);
Bytes_Read : INTEGER (* # bytes read at current file position *);
Ierr : INTEGER (* Error flag *);
Long_Name : AnyStr (* Long file name *);
(*----------------------------------------------------------------------*)
(* Get_Next_Lbr_Entry --- Get next header entry in library *)
(*----------------------------------------------------------------------*)
FUNCTION Get_Next_Lbr_Entry( VAR Lbr_Entry : Lbr_Entry_Type;
VAR Error : INTEGER ) : BOOLEAN;
VAR
Month : INTEGER;
Year : INTEGER;
Done : BOOLEAN;
T : INTEGER;
(* # of days in each month *)
(* STRUCTURED *) CONST
NDays : ARRAY[1..12] OF INTEGER = ( 31, 28, 31, 30, 31, 30,
31, 31, 30, 31, 30, 31 );
BEGIN (* Get_Next_Lbr_Entry *)
(* Assume no error *)
Error := 0;
(* Loop over directory entries *)
REPEAT
(* Decrement directory entry count. *)
(* If = 0, reached end of directory *)
(* entries. *)
Lbr_Dir_Size := PRED( Lbr_Dir_Size );
IF ( Lbr_Dir_Size < 0 ) THEN
Error := End_Of_File;
(* If not end of entries ... *)
IF ( Error = 0 ) THEN
BEGIN
(* If not first time, move to next *)
(* directory entry position in file. *)
IF ( Lbr_Pos <> 0 ) THEN
Seek( LbrFile, Lbr_Pos );
(* Read directory entry *)
BlockRead( LbrFile, Lbr_Entry, SizeOf( Lbr_Entry ), Bytes_Read );
Error := 0;
(* If wrong length, .LBR format must *)
(* be incorrect. *)
IF ( Bytes_Read < Lbr_Header_Length ) THEN
Error := Format_Error
ELSE
(* If length OK, assume entry OK. *)
WITH Lbr_Entry DO
BEGIN
(* Point to next .LBR entry in file *)
Lbr_Pos := Lbr_Pos + Lbr_Header_Length;
(* Pick up time/date of creation this *)
(* entry if specified. If the update *)
(* time/date is different, then we *)
(* will report that instead. *)
IF ( Time = 0 ) THEN
BEGIN
Time := UTime;
Date := UDate;
END
ELSE
IF ( ( Time <> UTime ) OR ( Date <> UDate ) ) THEN
BEGIN
Time := UTime;
Date := UDate;
END;
(* Convert date from library format of *)
(* # days since 1/1/1978 to DOS format *)
Month := 1;
Year := 78;
(* This is done using brute force. *)
REPEAT
(* Account for leap years *)
T := 365 + ORD( Year MOD 4 = 0 );
(* See if we have less than 1 year left *)
Done := ( Date < T );
IF ( NOT Done ) THEN
BEGIN
Year := SUCC( Year );
Date := Date - T;
END;
UNTIL Done;
(* Now get months and days within year *)
REPEAT
T := Ndays[Month] +
ORD( ( Month = 2 ) AND ( Year MOD 4 = 0 ) );
Done := ( Date < T );
IF ( NOT Done ) THEN
BEGIN
Month := SUCC( Month );
Date := Date - T;
END;
UNTIL Done;
(* If > 1980, convert to DOS date *)
(* else leave unconverted. *)
IF ( Year >= 80 ) THEN
Date := ( Year - 80 ) SHL 9 + Month SHL 5 + Date
ELSE
Date := 0;
END (* With *);
END (* Error = 0 *);
UNTIL ( ( Error <> 0 ) OR ( Lbr_Entry.Flag = 0 ) );
(* Report success/failure to caller *)
Get_Next_Lbr_Entry := ( Error = 0 );
END (* Get_Next_Lbr_Entry *);
(*----------------------------------------------------------------------*)
(* Display_Lbr_Entry --- Display .LBR entry file data *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_Lbr_Entry( Lbr_Entry : Lbr_Entry_Type );
VAR
FName : AnyStr;
RLength : LONGINT;
TimeDate : LONGINT;
TimeDateW : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
BEGIN (* Display_Lbr_Entry *)
WITH Lbr_Entry DO
BEGIN
(* Pick up file name *)
FName := TRIM( Name );
IF ( Ext <> ' ' ) THEN
FName := FName + '.' + Ext;
(* See if this file matches the *)
(* entry spec wildcard. Exit if *)
(* not. *)
IF Use_Entry_Spec THEN
IF ( NOT Entry_Matches( FName ) ) THEN
EXIT;
(* Convert length in sectors to *)
(* length in bytes. *)
RLength := N_Sec * 128;
(* Get date and time of creation *)
TimeDateW[ 1 ] := Time;
TimeDateW[ 2 ] := Date;
Long_Name := '';
(* Display info for this entry *)
Display_One_Entry( FName, Rlength, TimeDate, LbrFileName,
Current_Subdirectory, Long_Name );
END;
END (* Display_Lbr_Entry *);
(*----------------------------------------------------------------------*)
BEGIN (* Display_Lbr_Contents *)
(* Open "lbr" library file and *)
(* initialize contents display. *)
IF Start_Contents_Listing( ' Library file: ',
Current_Subdirectory + LbrFileName, LbrFile,
Lbr_Pos, Ierr ) THEN
BEGIN
(* Set # directory entries = 1 so *)
(* we can process actual directory. *)
Lbr_Dir_Size := 1;
(* Pick up actual number of entries *)
(* in library. *)
IF ( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) THEN
WITH Lbr_Entry DO
IF ( ( ( Flag OR Offset ) = 0 ) AND ( N_Sec <> 0 ) ) THEN
Lbr_Dir_Size := PRED( N_Sec * 4 )
ELSE
Ierr := Format_Error;
(* Loop over library entries and print *)
(* information about each entry. *)
IF ( Ierr = 0 ) THEN
WHILE( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) DO
Display_Lbr_Entry( Lbr_Entry );
(* Close library file *)
End_Contents_Listing( LbrFile );
END;
END (* Display_Lbr_Contents *);