home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR13
/
4UTILS76.ZIP
/
DESCRIPT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-31
|
14KB
|
448 lines
UNIT DescriptionHandling;
{$L+,X+,V-}
(* ----------------------------------------------------------------------
Part of 4DESC - A Simple 4DOS File Description Editor
and 4FF - 4DOS File Finder
David Frey, & Tom Bowden
Urdorferstrasse 30 1575 Canberra Drive
8952 Schlieren ZH Stone Mountain, GA 30088-3629
Switzerland USA
Code created using Turbo Pascal 7.0 (c) Borland International 1992
DISCLAIMER: This unit is freeware: you are allowed to use, copy
and change it free of charge, but you may not sell or hire
this part of 4DESC. The copyright remains in our hands.
If you make any (considerable) changes to the source code,
please let us know. (send a copy or a listing).
We would like to see what you have done.
We, David Frey and Tom Bowden, the authors, provide absolutely
no warranty of any kind. The user of this software takes the
entire risk of damages, failures, data losses or other
incidents.
This unit stores/retrieves the file data and descriptions by using
a TCollection (a Turbo Vision Object).
----------------------------------------------------------------------- *)
INTERFACE USES Objects, Dos, StringDateHandling;
CONST MaxDescLen = 200; (* description length of next 4DOS update *)
DirSize = ' <DIR> ';
TYPE NameExtStr = STRING[1+8+1+3];
SizeStr = STRING[9];
DescStr = STRING[MaxDescLen];
ProgInfo = STRING;
SortKeyStr = STRING[14];
VAR DescLong : BOOLEAN;
DispLen : BYTE;
HelpStr : DescStr;
Template : STRING;
TYPE PFileData = ^TFileData;
TFileData = OBJECT(TObject)
IsADir : BOOLEAN;
Name : PString; (* ^NameExtStr; *)
Size : PString; (* ^SizeStr; *)
Date : PString; (* ^DateStr; *)
Time : PString; (* ^TimeStr; *)
ProgInfo : PString; (* ^STRING; *)
Desc : PString; (* ^DescStr; *)
SortKey : PString; (* ^SortKeyStr;
either 0<DirName> for directories,
or 1<Name> for ordinary files *)
CONSTRUCTOR Init(Search: SearchRec);
DESTRUCTOR Done; VIRTUAL;
PROCEDURE AssignName(AName: NameExtStr);
PROCEDURE AssignDesc(ADesc: DescStr);
PROCEDURE AssignProgInfo(AProgInfo: STRING);
FUNCTION GetDesc: DescStr;
FUNCTION GetSize: SizeStr;
FUNCTION GetName: NameExtStr;
FUNCTION GetProgInfo: STRING;
FUNCTION FormatScrollableDescription(off,len: BYTE): STRING;
END;
CONST ListOK = 0;
ListTooManyFiles = 1;
ListOutOfMem = 2;
TYPE PFileList = ^TFileList;
TFileList = OBJECT(TSortedCollection)
Status : BYTE;
MaxFileLimit: INTEGER;
CONSTRUCTOR Init(Path: PathStr);
FUNCTION KeyOf(Item: POINTER): POINTER; VIRTUAL;
FUNCTION Compare(key1,key2: POINTER): INTEGER; VIRTUAL;
END;
VAR FileList : PFileList;
FUNCTION NILCheck(APtr: POINTER): POINTER;
(* APtr = NIL ? If yes, give a fatal error message and abort. *)
IMPLEMENTATION USES Memory, DisplayKeyboardAndCursor, Drivers;
(* Allocate a 2KB text buffer for faster reads of DESCRIPT.ION *)
VAR Buffer: ARRAY[1..2048] OF CHAR;
{$F+}
FUNCTION HeapFunc(Size: WORD): INTEGER;
(* This is Turbo Pascal Heap Function, which is called whenever the heap
manager is unable to complete an allocation request. *)
BEGIN
HeapFunc := 1; (* Return NIL if out of heap *)
END;
{$F-}
FUNCTION NILCheck(APtr: POINTER): POINTER;
(* Aborts when a NIL pointer has been detected. This prevents
deferencing a NIL pointer, which could be catastrophic
(spontaneous rebooting etc.) *)
BEGIN
IF APtr = NIL THEN Abort('NIL Pointer detected!')
ELSE NILCheck := APtr;
END;
CONSTRUCTOR TFileData.Init(Search: SearchRec);
(* Constructor method. Constructs a FileData "object" on the heap
a fills in the appropriate values. *)
VAR TimeRec : DateTime;
s : STRING;
c : CHAR;
BEGIN
TObject.Init;
UnpackTime(Search.Time,TimeRec);
Name := NIL;
Date := NIL; Date := NewStr(FormDate(TimeRec));
Time := NIL; Time := NewStr(FormTime(TimeRec));
ProgInfo := NIL;
Desc := NIL;
SortKey := NIL;
IsADir := (Search.Attr AND Directory = Directory);
IF IsADir THEN
BEGIN
s := DirSize;
c := '0';
UpString(Search.Name);
END
ELSE
BEGIN
IF FullSize THEN Str(Search.Size:8,s)
ELSE s := FormattedLongIntStr(Search.Size DIV 1024,7)+'K';
c := '1';
END;
Size := NewStr(s);
Name := NewStr(Search.Name);
SortKey := NewStr(c + Search.Name);
(* Force directories ahead of files in sorted display. *)
END;
DESTRUCTOR TFileData.Done;
(* Removes a FileData object from the heap. *)
BEGIN
DisposeStr(Date); Date := NIL;
DisposeStr(Time); Time := NIL;
DisposeStr(ProgInfo); ProgInfo := NIL;
DisposeStr(Desc); Desc := NIL;
DisposeStr(Name); Name := NIL;
DisposeStr(Size); Size := NIL;
DisposeStr(SortKey); SortKey := NIL;
TObject.Done;
END;
PROCEDURE TFileData.AssignName(AName: NameExtStr);
(* Dynamic version of "Name := AName" *)
BEGIN
IF Name <> NIL THEN
BEGIN DisposeStr(Name); Name := NIL; END;
Name := NewStr(AName);
IF (AName <> '') AND (Name = NIL) THEN
Abort('AssignName: NIL Pointer detected!')
END;
PROCEDURE TFileData.AssignDesc(ADesc: DescStr);
(* Dynamic version of "Desc := ADesc" *)
BEGIN
IF Desc <> NIL THEN
BEGIN DisposeStr(Desc); Desc := NIL; END;
Desc := NewStr(ADesc);
IF (ADesc <> '') AND (Desc = NIL) THEN
Abort('AssignDesc: NIL Pointer detected!')
END;
PROCEDURE TFileData.AssignProgInfo(AProgInfo: STRING);
(* Dynamic version of "ProgInfo := AProgInfo" *)
BEGIN
IF ProgInfo <> NIL THEN
BEGIN DisposeStr(ProgInfo); ProgInfo := NIL; END;
ProgInfo := NewStr(AProgInfo);
IF (AProgInfo <> '') AND (ProgInfo = NIL) THEN
Abort('AssignProgInfo: NIL Pointer detected!')
END;
FUNCTION TFileData.GetDesc: DescStr;
(* Returns the description of a file *)
BEGIN
IF Desc <> NIL THEN GetDesc := Desc^
ELSE GetDesc := '';
END;
FUNCTION TFileData.GetSize: SizeStr;
(* Returns the size of a file [as a string] *)
BEGIN
IF Size <> NIL THEN GetSize := Size^
ELSE GetSize := '';
END;
FUNCTION TFileData.GetName: NameExtStr;
(* Returns the filename *)
BEGIN
IF Name <> NIL THEN GetName := Name^
ELSE GetName := '';
END;
FUNCTION TFileData.GetProgInfo: STRING;
(* Returns the program information *)
BEGIN
IF ProgInfo <> NIL THEN GetProgInfo := ProgInfo^
ELSE GetProgInfo := '';
END;
FUNCTION TFileData.FormatScrollableDescription(off,len: BYTE): STRING;
(* Formats a description line. We do not return the full descrption,
in order to enable scrolling we return only the substring from off
to off+len. *)
VAR ia : ARRAY[0..4] OF PString;
s : STRING;
BEGIN
HelpStr := Copy(GetDesc,off,len); (* HelpStr must be global; @ doesn't
work with local strings
[ I know, it looks clumsy, but this
is a restriction of FormatStr ] *)
ia[0] := Name;
ia[1] := Size;
ia[2] := Date;
ia[3] := Time;
ia[4] := @HelpStr;
FormatStr(s,Template,ia);
FormatScrollableDescription := s;
END;
CONSTRUCTOR TFileList.Init(Path: PathStr);
(* Build a list of FileData objects by inserting the directory entries
in a TSortedCollection. *)
CONST CR = #13;
LF = #10;
EOFMark = #26;
VAR DescFileExists : BOOLEAN;
DescFound : BOOLEAN;
DescFile : TEXT;
DescLine : STRING;
DescName : NameExtStr;
DescStart : BYTE;
DescEnd : BYTE;
Desc : STRING;
ProgInfo : STRING;
sr : SearchRec;
ListEntry : PFileData;
mfl : LONGINT;
c : ARRAY[0..1] OF CHAR;
l : BYTE;
Index : INTEGER;
Key : PString;
SKeyName : SortKeyStr;
PROCEDURE DescSearch;
(* Search for a directory name and look whether it has a description or
not. *)
BEGIN
Key := @SKeyName;
IF Search(Key,Index) THEN
BEGIN
DescEnd := Pos(#4,DescLine);
IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
IF (DescEnd-1) - (DescStart+1) > MaxDescLen THEN DescLong := TRUE;
Desc := Copy(DescLine,DescStart+1,DescEnd-1);
StripLeadingSpaces(Desc);
StripTrailingSpaces(Desc);
ListEntry := At(Index);
ListEntry^.AssignDesc(Desc);
ProgInfo := Copy(DescLine,DescEnd,255);
ListEntry^.AssignProgInfo(ProgInfo);
END;
END;
PROCEDURE BeautifyEntries(AnEntry: PFileData); FAR;
(* Formats the file names to look like
xxxxx.xxx (NotLeftJust = TRUE) or
xxxxx .xxx (NotLeftJust = FALSE) *)
VAR s : NameExtStr;
p : BYTE;
BEGIN
IF (AnEntry <> NIL) AND NOT AnEntry^.IsADir THEN
WITH AnEntry^ DO
BEGIN
s := GetName;
p := Pos('.',s);
IF p > 0 THEN
BEGIN
WHILE NOT NotLeftJust AND (p <> 9) AND (Length(s) < 13) DO
BEGIN
System.Insert(' ',s,p);
p := Pos('.',s);
END;
AssignName(s);
END;
END; (* with *)
END;
BEGIN
(* Grab either the maximum size of memory available (if less than 64KB)
or the maximum collection size.
This restriction is directly imposed by DOS's segmentation [64KB
data limit !!. It could be avoided be using a proper Operating System *)
mfl := (MemAvail-2048) DIV SizeOf(POINTER);
IF mfl > MaxCollectionSize THEN MaxFileLimit := MaxCollectionSize
ELSE MaxFileLimit := INTEGER(mfl);
TCollection.Init(MaxFileLimit,0); Status := ListOK;
(* First, collect all files in the current directory. *)
FindFirst('*.*',ReadOnly+Archive+Directory+BYTE(UseHidden)*Hidden+SysFile, sr);
WHILE (DosError = 0) AND (Status = ListOK) AND (Count < MaxCollectionSize) DO
BEGIN
DownString(sr.Name);
IF MemAvail < SizeOf(TFileData) THEN Status := ListOutOfMem
ELSE
BEGIN
ListEntry := NIL; ListEntry := New(PFileData,Init(sr));
IF ListEntry <> NIL THEN Insert(ListEntry)
ELSE Status := ListOutOfMem;
(* Oops, out of mem, New returned a
NIL pointer *)
END;
FindNext(sr);
END; (* while *)
IF Count = MaxFileLimit THEN Status := ListTooManyFiles;
(* Oops, more than MaxFileLimit files reside in this directory. *)
(* Next, open a DESCRIPT.ION file and read out the descriptions. *)
FindFirst('DESCRIPT.ION',Hidden + Archive,sr);
DescFileExists := (DosError = 0);
IF DescFileExists THEN
BEGIN
{$I-}
Assign(DescFile,'DESCRIPT.ION');
SetTextBuf(DescFile,Buffer);
Reset(DescFile);
{$I+}
REPEAT
DescLine := '';
c[0] := #0;
REPEAT
c[1] := c[0];
Read(DescFile,c[0]);
DescLine := DescLine + c[0];
UNTIL ((c[0] = CR) AND (c[1] = LF)) OR
(c[1] = CR) OR
(c[1] = LF) OR
(c[1] = EOFMark);
l := Length(DescLine);
WHILE (DescLine[l] = CR) OR
(DescLine[l] = LF) OR
(DescLine[l] = EOFMark) DO
BEGIN
System.Delete(DescLine,l,1);
l := Length(DescLine);
END;
DescStart := Pos(' ',DescLine);
IF DescStart = 0 THEN DescStart := Length(DescLine)+1;
DescName := Copy(DescLine,1,DescStart-1);
DownString(DescName);
SKeyName := '1' + DescName;
DescSearch; (* File name search *)
UpString(DescName);
SKeyName := '0' + DescName;
DescSearch; (* Directory name search *)
UNTIL Eof(DescFile);
{$I-}
Close(DescFile);
{$I+}
END;
ForEach(@BeautifyEntries);
END; (* TFileList.Init *)
FUNCTION TFileList.KeyOf(Item: POINTER): POINTER;
(* This function is used by Turbo Vision's TSortedCollection object,
to determine the key, i.e. which entry is relevant for sorting. *)
BEGIN
KeyOf := PFileData(Item)^.SortKey;
END; (* TFileList.KeyOf *)
FUNCTION TFileList.Compare(key1,key2: POINTER): INTEGER;
(* This function tells the sorted collection how to sort its members.
(by Name, directories first [this is assured by the SortKey entry) *)
BEGIN
IF PString(key1)^ = PString(key2)^ then Compare := 0
ELSE
IF PString(key1)^ < PString(key2)^ then Compare := -1
ELSE Compare := +1;
END; (* TFileList.Compare *)
BEGIN
HeapError := @HeapFunc;
FileList := NIL; (* never leave a Pointer uninitialized ! *)
END.