Category : Utilities for DOS and Windows Machines
Archive   : 4UTILS83.ZIP
Filename : DESCRIPT.PAS

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; (* 4DOS maximum description length *)
DirSize = ' ';

CONST SortByName = 1;
SortByExt = 2;
SortBySize = 3;
SortByDate = 4;
SortByNameRev = 5;
SortByExtRev = 6;
SortBySizeRev = 7;
SortByDateRev = 8;

TYPE NameExtStr = STRING[1+8+1+3];
SizeStr = STRING[9];
DescStr = STRING[MaxDescLen];
ProgInfo = STRING;
SortKeyStr = STRING[14];

VAR DescLong : BOOLEAN;
DispLen : BYTE;
Template : STRING;

TYPE PFileData = ^TFileData;
TFileData = OBJECT(TObject)
IsADir : BOOLEAN;
Name : NameStr;
Ext : ExtStr;
Size : LONGINT;
DateRec : DateTime;
Attr : BYTE;
ProgInfo : PString; (* ^STRING; *)
Desc : PString; (* ^DescStr; *)

CONSTRUCTOR Init(Search: SearchRec);
CONSTRUCTOR AssignValues(AnIsADir: BOOLEAN;
AName : NameStr; AnExt: ExtStr;
ASize : LONGINT; ADateRec: DateTime;
AnAttr: BYTE; AProgInfo: STRING;
ADesc : DescStr);
DESTRUCTOR Done; VIRTUAL;

PROCEDURE AssignDesc(ADesc: DescStr);
PROCEDURE AssignProgInfo(AProgInfo: STRING);

FUNCTION GetDesc: DescStr;
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: WORD;

CONSTRUCTOR Init(Path: PathStr; FileMask: NameExtStr;
ALimit: INTEGER);

FUNCTION Compare(key1,key2: POINTER): INTEGER; VIRTUAL;
END;


(* these constants are used for the new Justification entry in 4UTILS.INI *)
CONST Left = 0;
LeftLeft = 1;
RightLeft = 2;

VAR Justify : BYTE;
FullSize : BOOLEAN;
UseHidden: BOOLEAN;

VAR FileList : PFileList;
SortKey : BYTE;

PROCEDURE Abort(msg: STRING);

FUNCTION NILCheck(APtr: POINTER): POINTER;
(* APtr = NIL ? If yes, give a fatal error message and abort. *)

PROCEDURE ResortFileList;
(* Resorts the current File List *)

PROCEDURE EvaluateINIFileSettings;

IMPLEMENTATION USES Memory, Drivers,
HandleINIFile;

(* Allocate a 2KB text buffer for faster reads of DESCRIPT.ION *)
VAR Buffer: ARRAY[1..2048] OF CHAR;

VAR HelpStr1 : DescStr;
HelpStr2 : SizeStr;
HelpStr3 : NameExtStr;

PROCEDURE Abort(msg: STRING);
(* Fatal error, abort the program and return an errorlevel of -1 *)

BEGIN
(* NormVideo;
ClrScr; *)
Write(msg);
HALT(255);
END;

{$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;

(*---------------------------------------------------------------------*)
(* The real work starts here. *)

CONSTRUCTOR TFileData.Init(Search: SearchRec);
(* Regular Constructor method. Constructs a FileData "object" on
the heap and fills in the appropriate values.
Called from TFileList.Init *)

VAR TimeRec : DateTime;
Dir : DirStr;
s : STRING;

BEGIN
TObject.Init;

FSplit(Search.Name,Dir,Name,Ext);
UnpackTime(Search.Time,DateRec);

Attr := Search.Attr;

ProgInfo := NIL;
Desc := NIL;
Size := Search.Size;

IsADir := (Search.Attr AND Directory = Directory);
IF IsADir THEN
IF (Name = '') THEN (* Name = '' holds for the . and .. entries *)
BEGIN
Name := UpStr(Ext); Ext := '';
END
ELSE
BEGIN
UpString(Name); UpString(Ext);
END;
END;

CONSTRUCTOR TFileData.AssignValues(AnIsADir: BOOLEAN;
AName : NameStr; AnExt: ExtStr;
ASize : LONGINT; ADateRec: DateTime;
AnAttr: BYTE; AProgInfo: STRING;
ADesc : DescStr);
(* Alternate Constructor method. Constructs a FileData "object" on
the heap and fills in the appropriate values.
Called form ReSortFileList when re-sorting a file list. *)

BEGIN
TObject.Init;

IsADir := AnIsADir;

Name := AName; Ext := AnExt; Size := ASize; DateRec := ADateRec;
Attr := AnAttr;

ProgInfo := NIL; ProgInfo := NewStr(AProgInfo);
Desc := NIL; Desc := NewStr(ADesc);
END;

DESTRUCTOR TFileData.Done;
(* Removes a FileData object from the heap. *)

BEGIN
DisposeStr(ProgInfo); ProgInfo := NIL;
DisposeStr(Desc); Desc := NIL;

TObject.Done;
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.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;
ia2 : ARRAY[0..1] OF PString;
Date: DateStr;
Time: TimeStr;
s : STRING;

BEGIN
HelpStr1 := 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 ] *)
IF IsADir THEN
BEGIN
HelpStr2 := DirSize;
END
ELSE
BEGIN
IF FullSize THEN Str(Size:8,HelpStr2)
ELSE HelpStr2 := FormattedLongIntStr(Size DIV 1024,7)+'K';
END;

Date := FormDate(DateRec); Time := FormTime(DateRec);

CASE Justify OF
Left : HelpStr3 := Name+Ext;
LeftLeft : BEGIN
ia2[0] := @Name; ia2[1] := @Ext;
FormatStr(HelpStr3,'%-8s%-4s',ia2);
END;
RightLeft : BEGIN
ia2[0] := @Name; ia2[1] := @Ext;
FormatStr(HelpStr3,'%8s%-4s',ia2);
END;
END;

ia[0] := @HelpStr3;
ia[1] := @HelpStr2;
ia[2] := @Date;
ia[3] := @Time;
ia[4] := @HelpStr1;

FormatStr(s,Template,ia);
FormatScrollableDescription := s;
END;

CONSTRUCTOR TFileList.Init(Path: PathStr; FileMask: NameExtStr;
ALimit: INTEGER);

(* TFileList.Init may be called on two occasions:
1) Normal case (Path <> '', ALimit is meaningless):
a directory will be read in. Init will build a list of
FileData objects by inserting the directory entries in a
TSortedCollection.
2) Sorting (Path = '', ALimit : Size of the FileList-Collection):
a TFileList-Collection already exists, but the user wants to
re-sort it. In this case, the Init procedures allocates the space
for the new collection and exists. The actual inserting of the
entries is done by ReSortFileList. *)

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;

FUNCTION DescMatches(Item: POINTER): BOOLEAN; FAR;
(* Search the file with a given Name (in DescName) and return TRUE
if found. *)

VAR n : NameExtStr;

BEGIN
IF Item <> NIL THEN
BEGIN
n := DownStr(PFileData(Item)^.Name+PFileData(Item)^.Ext);
DescMatches := (n = DescName);
END
ELSE DescMatches := FALSE;
END;


BEGIN
(* Case 2: Sorting *)
IF Path = '' THEN MaxFileLimit := ALimit (* when sorting *)
ELSE
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 < 0 THEN Abort('File List Init: Out of memory!');

IF mfl > MaxCollectionSize THEN MaxFileLimit := MaxCollectionSize
ELSE MaxFileLimit := INTEGER(mfl);
END;

TSortedCollection.Init(MaxFileLimit,0); Status := ListOK;
Duplicates := TRUE;

(* Case 2: When sorting, we are done *)

(* Case 1: Reading in a directory: *)
IF Path <> '' THEN
BEGIN
(* First, collect all files in the current directory. *)
FindFirst(FileMask,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 TSortedCollection.Insert(ListEntry)
ELSE Status := ListOutOfMem;
(* Oops, out of mem, New returned a
NIL pointer *)
END;

FindNext(sr);
END; (* while *)
IF DosError = 18 THEN DosError := 0; (* No more files is ok ! *)

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. *)
IF DosError = 0 THEN
BEGIN
FindFirst('DESCRIPT.ION',Hidden + Archive,sr);
DescFileExists := (DosError = 0);
IF DosError = 18 THEN DosError := 0; (* No more files is ok ! *)

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]);
IF (c[0] <> CR) AND (c[0] <> LF) AND (c[0] <> EOFMark) THEN
DescLine := DescLine + c[0];
UNTIL ((c[0] = CR) AND (c[1] = LF)) OR
(c[0] = CR) OR (c[0] = LF) OR (c[0] = EOFMark);
l := Length(DescLine);

DescStart := Pos(' ',DescLine);
IF DescStart = 0 THEN DescStart := Length(DescLine)+1;
DescName := Copy(DescLine,1,DescStart-1);

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-DescStart-1));
StripLeadingSpaces(Desc);
StripTrailingSpaces(Desc);
DownString(DescName);

ListEntry := FirstThat(@DescMatches);
IF ListEntry <> NIL THEN ListEntry^.AssignDesc(Desc);
ProgInfo := Copy(DescLine,DescEnd,255);
IF Listentry <> NIL THEN ListEntry^.AssignProgInfo(ProgInfo);
UNTIL Eof(DescFile);
{$I-}
Close(DescFile);
{$I+}
END; (* IF DescFileExists ... *)
END; (* IF DosError ... *)
END; (* IF Path <> '' ... *)
END; (* TFileList.Init *)

FUNCTION TFileList.Compare(key1, key2: POINTER): INTEGER;
(* This function tells the sorted collection how to sort its members.
(by Name, directories first *)

VAR d1, d2 : BOOLEAN;
k1, k2 : NameExtStr;
l1, l2 : LONGINT;

FUNCTION StringCompare(k1, k2: NameExtStr): INTEGER;

BEGIN
IF k1 = k2 THEN StringCompare := 0
ELSE
IF k1 < k2 THEN StringCompare := -1
ELSE StringCompare := +1;
END;

FUNCTION LongintCompare(l1, l2: LONGINT): INTEGER;

BEGIN
IF l1 = l2 THEN LongintCompare := 0
ELSE
IF l1 < l2 THEN LongintCompare := -1
ELSE LongintCompare := +1;
END;

BEGIN
(* Exceptions are . and .., handle them first *)
IF (key1 = NIL) OR (key2 = NIL) THEN
BEGIN
IF (key1 = NIL) AND (key2 <> NIL) THEN Compare := -1
ELSE
IF (key1 = NIL) AND (key2 = NIL) THEN Compare := 0
ELSE Compare := +1;
END
ELSE
IF (PFileData(key1)^.Name[1] = '.') OR (PFileData(key2)^.Name[1] = '.') THEN
BEGIN
IF PFileData(key1)^.Name[1] = '.' THEN Compare := -1
ELSE Compare := +1;
END
ELSE
BEGIN
d1 := PFileData(key1)^.IsADir; d2 := PFileData(key2)^.IsADir;
CASE SortKey OF
SortByName, SortByNameRev:
BEGIN
k1 := PFileData(key1)^.Name+PFileData(key1)^.Ext;
k2 := PFileData(key2)^.Name+PFileData(key2)^.Ext;
END;
SortByExt, SortByExtRev:
BEGIN
k1 := PFileData(key1)^.Ext+PFileData(key1)^.Ext;
k2 := PFileData(key2)^.Ext+PFileData(key2)^.Ext;
END;
SortBySize, SortBySizeRev:
BEGIN
l1 := PFileData(key1)^.Size; l2 := PFileData(key2)^.Size;
END;
SortByDate, SortByDateRev:
BEGIN
l1 := PFileData(key1)^.DateRec.Min +
PFileData(key1)^.DateRec.Hour * 100 +
PFileData(key1)^.DateRec.Day * 10000 +
PFileData(key1)^.DateRec.Month * 1000000 +
PFileData(key1)^.DateRec.Year * 100000000;
l2 := PFileData(key2)^.DateRec.Min +
PFileData(key2)^.DateRec.Hour * 100 +
PFileData(key2)^.DateRec.Day * 10000 +
PFileData(key2)^.DateRec.Month * 1000000 +
PFileData(key2)^.DateRec.Year * 100000000;
END;
END;

IF (SortKey = SortByName) OR (SortKey = SortByExt) THEN
BEGIN
IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := StringCompare(k1,k2)
ELSE
IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
ELSE
IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
ELSE Compare := StringCompare(k1,k2); (* both keys are directories *)
END
ELSE
IF (SortKey = SortByNameRev) OR (SortKey = SortByExtRev) THEN
BEGIN
IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := StringCompare(k2,k1)
ELSE
IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
ELSE
IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
ELSE Compare := StringCompare(k2,k1); (* both keys are directories *)
END
ELSE
IF (SortKey = SortBySize) OR (SortKey = SortByDate) THEN
BEGIN
IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := LongintCompare(l1,l2)
ELSE
IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
ELSE
IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
ELSE Compare := LongintCompare(l1,l2); (* both keys are directories *)
END
ELSE
IF (SortKey = SortBySizeRev) OR (SortKey = SortByDateRev) THEN
BEGIN
IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := LongintCompare(l2,l1)
ELSE
IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
ELSE
IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
ELSE Compare := LongintCompare(l2,l1); (* both keys are directories *)
END
END;
END; (* TFileList.Compare *)

PROCEDURE ResortFileList;
(* Resorts the current File List.
Resorting an already sorted list is in Turbo Vision
awkward and pretty costly.

You basically have to duplicate the whole list, by repeatedly calling
Insert, which will do the work for you.
[ This is the easiest way, you could - of course - do the sorting
`by foot', but this would duplicate the code above! ] *)

VAR NewFileList : PFileList;
i : WORD;

ListEntry: PFileData;
p : PFileData;

(* PROCEDURE InsertFileData(Item: POINTER); FAR;

VAR ListEntry: PFileData;
p : PFileData;

BEGIN
IF Item <> NIL THEN
BEGIN
p := PFileData(Item); ListEntry := NIL;
ListEntry := New(PFileData,AssignValues(p^.IsADir,p^.Name,p^.Ext,
p^.Size, p^.DateRec,p^.Attr,
p^.GetProgInfo,p^.GetDesc));
IF ListEntry <> NIL THEN NewFileList^.Insert(ListEntry);
END;
END; *)

BEGIN
NewFileList := New(PFileList,Init('','',FileList^.Count));
(* create an empty FileList with FileList^.Count elements *)

(* FileList^.ForEach(@InsertFileData); *)
WHILE FileList^.Count > 0 DO
BEGIN
p := PFileData(FileList^.At(0)); ListEntry := NIL;
IF p <> NIL THEN
BEGIN
ListEntry := New(PFileData,AssignValues(p^.IsADir,p^.Name,p^.Ext,
p^.Size, p^.DateRec,p^.Attr,
p^.GetProgInfo,p^.GetDesc));
IF ListEntry <> NIL THEN NewFileList^.Insert(ListEntry);
FileList^.AtFree(0);
END;
END;
Dispose(FileList,Done); FileList := NewFileList;
END;

PROCEDURE EvaluateINIFileSettings;

VAR c: WORD;
s: STRING;

BEGIN
s := DownStr(ReadSettingsString('generaldisplay','justify','left.left'));
IF s = 'left' THEN Justify := Left
ELSE
IF s = 'left.left' THEN Justify := LeftLeft
ELSE
IF s = 'right.left' THEN Justify := RightLeft
ELSE
Justify := Left;

FullSize := (ReadSettingsChar('generaldisplay','fullsize','n') = 'y');
UseHidden := (ReadSettingsChar('generaldisplay','hidden' ,'n') = 'y');

s := ReadSettingsString('generaldisplay','sortcriteria','name');
IF s = 'name' THEN SortKey := SortByName
ELSE
IF s = 'ext' THEN SortKey := SortByExt
ELSE
IF s = 'size' THEN SortKey := SortBySize
ELSE
IF s = 'date' THEN SortKey := SortByDate
ELSE
IF s = 'rev-name' THEN SortKey := SortByNameRev
ELSE
IF s = 'rev-ext' THEN SortKey := SortByExtRev
ELSE
IF s = 'rev-size' THEN SortKey := SortBySizeRev
ELSE
IF s = 'rev-date' THEN SortKey := SortByDateRev;
END;

BEGIN
HeapError := @HeapFunc;
FileList := NIL; (* never leave a Pointer uninitialized ! *)
END.