home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / 4utils83.zip / DESCRIPT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-28  |  22KB  |  675 lines
  1. UNIT DescriptionHandling;
  2. {$L+,X+,V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0 (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.    This unit stores/retrieves the file data and descriptions by using
  28.    a TCollection (a Turbo Vision Object).
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Objects, Dos, StringDateHandling;
  33.  
  34. CONST MaxDescLen = 200; (* 4DOS maximum description length *)
  35.       DirSize    = '  <DIR> ';
  36.  
  37. CONST SortByName    = 1;
  38.       SortByExt     = 2;
  39.       SortBySize    = 3;
  40.       SortByDate    = 4;
  41.       SortByNameRev = 5;
  42.       SortByExtRev  = 6;
  43.       SortBySizeRev = 7;
  44.       SortByDateRev = 8;
  45.  
  46. TYPE  NameExtStr = STRING[1+8+1+3];
  47.       SizeStr    = STRING[9];
  48.       DescStr    = STRING[MaxDescLen];
  49.       ProgInfo   = STRING;
  50.       SortKeyStr = STRING[14];
  51.  
  52. VAR   DescLong   : BOOLEAN;
  53.       DispLen    : BYTE;
  54.       Template   : STRING;
  55.  
  56. TYPE  PFileData  = ^TFileData;
  57.       TFileData  = OBJECT(TObject)
  58.                     IsADir   : BOOLEAN;
  59.                     Name     : NameStr;
  60.                     Ext      : ExtStr;
  61.                     Size     : LONGINT;
  62.                     DateRec  : DateTime;
  63.                     Attr     : BYTE;
  64.                     ProgInfo : PString; (* ^STRING;     *)
  65.                     Desc     : PString; (* ^DescStr;    *)
  66.  
  67.                     CONSTRUCTOR Init(Search: SearchRec);
  68.                     CONSTRUCTOR AssignValues(AnIsADir: BOOLEAN;
  69.                                              AName : NameStr; AnExt: ExtStr;
  70.                                              ASize : LONGINT; ADateRec:  DateTime;
  71.                                              AnAttr: BYTE;    AProgInfo: STRING;
  72.                                              ADesc : DescStr);
  73.                     DESTRUCTOR  Done; VIRTUAL;
  74.  
  75.                     PROCEDURE AssignDesc(ADesc: DescStr);
  76.                     PROCEDURE AssignProgInfo(AProgInfo: STRING);
  77.  
  78.                     FUNCTION  GetDesc: DescStr;
  79.                     FUNCTION  GetProgInfo: STRING;
  80.  
  81.                     FUNCTION FormatScrollableDescription(off,len: BYTE): STRING;
  82.                    END;
  83.  
  84. CONST ListOK           = 0;
  85.       ListTooManyFiles = 1;
  86.       ListOutOfMem     = 2;
  87.  
  88. TYPE  PFileList  = ^TFileList;
  89.       TFileList  = OBJECT(TSortedCollection)
  90.                     Status      : BYTE;
  91.                     MaxFileLimit: WORD;
  92.  
  93.                     CONSTRUCTOR Init(Path: PathStr; FileMask: NameExtStr;
  94.                                      ALimit: INTEGER);
  95.  
  96.                     FUNCTION Compare(key1,key2: POINTER): INTEGER; VIRTUAL;
  97.                    END;
  98.  
  99.  
  100. (* these constants are used for the new Justification entry in 4UTILS.INI *)
  101. CONST Left      = 0;
  102.       LeftLeft  = 1;
  103.       RightLeft = 2;
  104.  
  105. VAR   Justify  : BYTE;
  106.       FullSize : BOOLEAN;
  107.       UseHidden: BOOLEAN;
  108.  
  109. VAR   FileList : PFileList;
  110.       SortKey  : BYTE;
  111.  
  112. PROCEDURE Abort(msg: STRING);
  113.  
  114. FUNCTION NILCheck(APtr: POINTER): POINTER;
  115. (* APtr = NIL ? If yes, give a fatal error message and abort. *)
  116.  
  117. PROCEDURE ResortFileList;
  118. (* Resorts the current File List *)
  119.  
  120. PROCEDURE EvaluateINIFileSettings;
  121.  
  122. IMPLEMENTATION USES Memory,  Drivers,
  123.                     HandleINIFile;
  124.  
  125. (* Allocate a 2KB text buffer for faster reads of DESCRIPT.ION *)
  126. VAR Buffer: ARRAY[1..2048] OF CHAR;
  127.  
  128. VAR HelpStr1   : DescStr;
  129.     HelpStr2   : SizeStr;
  130.     HelpStr3   : NameExtStr;
  131.  
  132. PROCEDURE Abort(msg: STRING);
  133. (* Fatal error, abort the program and return an errorlevel of -1 *)
  134.  
  135. BEGIN
  136. (* NormVideo;
  137.  ClrScr; *)
  138.  Write(msg);
  139.  HALT(255);
  140. END;
  141.  
  142. {$F+}
  143. FUNCTION HeapFunc(Size: WORD): INTEGER;
  144. (* This is Turbo Pascal Heap Function, which is called whenever the heap
  145.    manager is unable to complete an allocation request.                  *)
  146.  
  147. BEGIN
  148.  HeapFunc := 1;   (* Return NIL if out of heap *)
  149. END;
  150. {$F-}
  151.  
  152. FUNCTION NILCheck(APtr: POINTER): POINTER;
  153. (* Aborts when a NIL pointer has been detected. This prevents
  154.    deferencing a NIL pointer, which could be catastrophic
  155.    (spontaneous rebooting etc.)                               *)
  156.  
  157. BEGIN
  158.  IF APtr = NIL THEN Abort('NIL Pointer detected!')
  159.                ELSE NILCheck := APtr;
  160. END;
  161.  
  162. (*---------------------------------------------------------------------*)
  163. (* The real work starts here. *)
  164.  
  165. CONSTRUCTOR TFileData.Init(Search: SearchRec);
  166. (* Regular Constructor method. Constructs a FileData "object" on
  167.    the heap and fills in the appropriate values.
  168.    Called from TFileList.Init                                           *)
  169.  
  170. VAR TimeRec  : DateTime;
  171.     Dir      : DirStr;
  172.     s        : STRING;
  173.  
  174. BEGIN
  175.  TObject.Init;
  176.  
  177.  FSplit(Search.Name,Dir,Name,Ext);
  178.  UnpackTime(Search.Time,DateRec);
  179.  
  180.  Attr     := Search.Attr;
  181.  
  182.  ProgInfo := NIL;
  183.  Desc     := NIL;
  184.  Size     := Search.Size;
  185.  
  186.  IsADir := (Search.Attr AND Directory = Directory);
  187.  IF IsADir THEN
  188.   IF (Name = '') THEN (* Name = '' holds for the . and .. entries *)
  189.    BEGIN
  190.     Name := UpStr(Ext); Ext := '';
  191.    END
  192.   ELSE
  193.    BEGIN
  194.     UpString(Name); UpString(Ext);
  195.    END;
  196. END;
  197.  
  198. CONSTRUCTOR TFileData.AssignValues(AnIsADir: BOOLEAN;
  199.                                    AName : NameStr; AnExt: ExtStr;
  200.                                    ASize : LONGINT; ADateRec: DateTime;
  201.                                    AnAttr: BYTE;    AProgInfo: STRING;
  202.                                    ADesc : DescStr);
  203. (* Alternate Constructor method. Constructs a FileData "object" on
  204.    the heap and fills in the appropriate values.
  205.    Called form ReSortFileList when re-sorting a file list.             *)
  206.  
  207. BEGIN
  208.  TObject.Init;
  209.  
  210.  IsADir := AnIsADir;
  211.  
  212.  Name := AName; Ext := AnExt; Size := ASize; DateRec := ADateRec;
  213.  Attr := AnAttr;
  214.  
  215.  ProgInfo := NIL; ProgInfo := NewStr(AProgInfo);
  216.  Desc     := NIL; Desc     := NewStr(ADesc);
  217. END;
  218.  
  219. DESTRUCTOR TFileData.Done;
  220. (* Removes a FileData object from the heap. *)
  221.  
  222. BEGIN
  223.  DisposeStr(ProgInfo); ProgInfo := NIL;
  224.  DisposeStr(Desc);     Desc     := NIL;
  225.  
  226.  TObject.Done;
  227. END;
  228.  
  229. PROCEDURE TFileData.AssignDesc(ADesc: DescStr);
  230. (* Dynamic version of "Desc := ADesc" *)
  231.  
  232. BEGIN
  233.  IF Desc <> NIL THEN BEGIN DisposeStr(Desc); Desc := NIL; END;
  234.  
  235.  Desc := NewStr(ADesc);
  236.  IF (ADesc <> '') AND (Desc = NIL) THEN
  237.   Abort('AssignDesc: NIL Pointer detected!')
  238. END;
  239.  
  240. PROCEDURE TFileData.AssignProgInfo(AProgInfo: STRING);
  241. (* Dynamic version of "ProgInfo := AProgInfo" *)
  242. BEGIN
  243.  IF ProgInfo <> NIL THEN BEGIN DisposeStr(ProgInfo); ProgInfo := NIL; END;
  244.  
  245.  ProgInfo := NewStr(AProgInfo);
  246.  IF (AProgInfo <> '') AND (ProgInfo = NIL) THEN
  247.   Abort('AssignProgInfo: NIL Pointer detected!')
  248. END;
  249.  
  250. FUNCTION TFileData.GetDesc: DescStr;
  251. (* Returns the description of a file *)
  252.  
  253. BEGIN
  254.  IF Desc <> NIL THEN GetDesc := Desc^
  255.                 ELSE GetDesc := '';
  256. END;
  257.  
  258. FUNCTION TFileData.GetProgInfo: STRING;
  259. (* Returns the program information *)
  260.  
  261. BEGIN
  262.  IF ProgInfo <> NIL THEN GetProgInfo := ProgInfo^
  263.                     ELSE GetProgInfo := '';
  264. END;
  265.  
  266. FUNCTION TFileData.FormatScrollableDescription(off,len: BYTE): STRING;
  267. (* Formats a description line. We do not return the full descrption,
  268.    in order to enable scrolling we return only the substring from off
  269.    to off+len.                                                        *)
  270.  
  271. VAR ia  : ARRAY[0..4] OF PString;
  272.     ia2 : ARRAY[0..1] OF PString;
  273.     Date: DateStr;
  274.     Time: TimeStr;
  275.     s   : STRING;
  276.  
  277. BEGIN
  278.  HelpStr1 := Copy(GetDesc,off,len); (* HelpStr must be global; @ doesn't
  279.                                        work with local strings
  280.                                        [ I know, it looks clumsy, but this
  281.                                          is a restriction of FormatStr ] *)
  282.  IF IsADir THEN
  283.   BEGIN
  284.    HelpStr2 := DirSize;
  285.   END
  286.  ELSE
  287.   BEGIN
  288.    IF FullSize THEN Str(Size:8,HelpStr2)
  289.                ELSE HelpStr2 := FormattedLongIntStr(Size DIV 1024,7)+'K';
  290.   END;
  291.  
  292.  Date := FormDate(DateRec); Time := FormTime(DateRec);
  293.  
  294.  CASE Justify OF
  295.   Left      : HelpStr3 := Name+Ext;
  296.   LeftLeft  : BEGIN
  297.                ia2[0] := @Name; ia2[1] := @Ext;
  298.                FormatStr(HelpStr3,'%-8s%-4s',ia2);
  299.               END;
  300.   RightLeft : BEGIN
  301.                ia2[0] := @Name; ia2[1] := @Ext;
  302.                FormatStr(HelpStr3,'%8s%-4s',ia2);
  303.               END;
  304.  END;
  305.  
  306.  ia[0] := @HelpStr3;
  307.  ia[1] := @HelpStr2;
  308.  ia[2] := @Date;
  309.  ia[3] := @Time;
  310.  ia[4] := @HelpStr1;
  311.  
  312.  FormatStr(s,Template,ia);
  313.  FormatScrollableDescription := s;
  314. END;
  315.  
  316. CONSTRUCTOR TFileList.Init(Path: PathStr; FileMask: NameExtStr;
  317.                            ALimit: INTEGER);
  318.  
  319. (* TFileList.Init may be called on two occasions:
  320.    1) Normal case (Path <> '', ALimit is meaningless):
  321.       a directory will be read in. Init will build a list of
  322.       FileData objects by inserting the directory entries in a
  323.       TSortedCollection.
  324.    2) Sorting     (Path =  '', ALimit : Size of the FileList-Collection):
  325.       a TFileList-Collection already exists, but the user wants to
  326.       re-sort it. In this case, the Init procedures allocates the space
  327.       for the new collection and exists. The actual inserting of the
  328.       entries is done by ReSortFileList.                                   *)
  329.  
  330. CONST CR      = #13;
  331.       LF      = #10;
  332.       EOFMark = #26;
  333.  
  334. VAR DescFileExists : BOOLEAN;
  335.     DescFound      : BOOLEAN;
  336.     DescFile       : TEXT;
  337.     DescLine       : STRING;
  338.     DescName       : NameExtStr;
  339.     DescStart      : BYTE;
  340.     DescEnd        : BYTE;
  341.     Desc           : STRING;
  342.     ProgInfo       : STRING;
  343.     sr             : SearchRec;
  344.     ListEntry      : PFileData;
  345.     mfl            : LONGINT;
  346.     c              : ARRAY[0..1] OF CHAR;
  347.     l              : BYTE;
  348.     Index          : INTEGER;
  349.  
  350.   FUNCTION DescMatches(Item: POINTER): BOOLEAN; FAR;
  351.   (* Search the file with a given Name (in DescName) and return TRUE
  352.      if found.                                                        *)
  353.  
  354.   VAR n : NameExtStr;
  355.  
  356.   BEGIN
  357.    IF Item <> NIL THEN
  358.     BEGIN
  359.      n := DownStr(PFileData(Item)^.Name+PFileData(Item)^.Ext);
  360.      DescMatches := (n = DescName);
  361.     END
  362.    ELSE DescMatches := FALSE;
  363.   END;
  364.  
  365.  
  366. BEGIN
  367.  (* Case 2: Sorting *)
  368.  IF Path = '' THEN MaxFileLimit := ALimit (* when sorting *)
  369.  ELSE
  370.   BEGIN
  371.    (* Grab either the maximum size of memory available (if less than 64KB)
  372.       or the maximum collection size.
  373.       This restriction is directly imposed by DOS's segmentation [64KB
  374.       data limit !!. It could be avoided be using a proper Operating System *)
  375.  
  376.    mfl := (MemAvail-2048) DIV SizeOf(POINTER);
  377.  
  378.    IF mfl < 0 THEN Abort('File List Init: Out of memory!');
  379.  
  380.    IF mfl > MaxCollectionSize THEN MaxFileLimit := MaxCollectionSize
  381.                               ELSE MaxFileLimit := INTEGER(mfl);
  382.   END;
  383.  
  384.  TSortedCollection.Init(MaxFileLimit,0); Status := ListOK;
  385.  Duplicates := TRUE;
  386.  
  387.  (* Case 2: When sorting, we are done *)
  388.  
  389.  (* Case 1: Reading in a directory: *)
  390.  IF Path <> '' THEN
  391.   BEGIN
  392.    (* First, collect all files in the current directory. *)
  393.    FindFirst(FileMask,ReadOnly+Archive+Directory+BYTE(UseHidden)*Hidden+SysFile, sr);
  394.    WHILE (DosError = 0) AND (Status = ListOK) AND (Count < MaxCollectionSize) DO
  395.     BEGIN
  396.      DownString(sr.Name);
  397.  
  398.      IF MemAvail < SizeOf(TFileData) THEN Status := ListOutOfMem
  399.      ELSE
  400.       BEGIN
  401.        ListEntry := NIL; ListEntry := New(PFileData,Init(sr));
  402.        IF ListEntry <> NIL THEN TSortedCollection.Insert(ListEntry)
  403.                            ELSE Status := ListOutOfMem;
  404.                                 (* Oops, out of mem, New returned a
  405.                                    NIL pointer *)
  406.       END;
  407.  
  408.      FindNext(sr);
  409.     END; (* while *)
  410.    IF DosError = 18 THEN DosError := 0; (* No more files is ok ! *)
  411.  
  412.    IF Count = MaxFileLimit THEN Status := ListTooManyFiles;
  413.    (* Oops, more than MaxFileLimit files reside in this directory. *)
  414.  
  415.    (* Next, open a DESCRIPT.ION file and read out the descriptions. *)
  416.    IF DosError = 0 THEN
  417.     BEGIN
  418.       FindFirst('DESCRIPT.ION',Hidden + Archive,sr);
  419.       DescFileExists := (DosError = 0);
  420.       IF DosError = 18 THEN DosError := 0; (* No more files is ok ! *)
  421.  
  422.       IF DescFileExists THEN
  423.        BEGIN
  424.         {$I-}
  425.         Assign(DescFile,'DESCRIPT.ION');
  426.         SetTextBuf(DescFile,Buffer);
  427.         Reset(DescFile);
  428.         {$I+}
  429.         REPEAT
  430.          DescLine := '';
  431.          c[0] := #0;
  432.          REPEAT
  433.           c[1] := c[0];
  434.           Read(DescFile,c[0]);
  435.           IF (c[0] <> CR) AND (c[0] <> LF) AND (c[0] <> EOFMark) THEN
  436.            DescLine := DescLine + c[0];
  437.          UNTIL ((c[0] = CR) AND (c[1] = LF)) OR
  438.                 (c[0] = CR) OR  (c[0] = LF)  OR (c[0] = EOFMark);
  439.          l := Length(DescLine);
  440.  
  441.          DescStart := Pos(' ',DescLine);
  442.          IF DescStart = 0 THEN DescStart := Length(DescLine)+1;
  443.          DescName := Copy(DescLine,1,DescStart-1);
  444.  
  445.          DescEnd := Pos(#4,DescLine);
  446.          IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  447.          IF (DescEnd-1) - (DescStart+1) > MaxDescLen THEN DescLong := TRUE;
  448.  
  449.          Desc := Copy(DescLine,DescStart+1,(DescEnd-DescStart-1));
  450.          StripLeadingSpaces(Desc);
  451.          StripTrailingSpaces(Desc);
  452.          DownString(DescName);
  453.  
  454.          ListEntry := FirstThat(@DescMatches);
  455.          IF ListEntry <> NIL THEN ListEntry^.AssignDesc(Desc);
  456.          ProgInfo := Copy(DescLine,DescEnd,255);
  457.          IF Listentry <> NIL THEN ListEntry^.AssignProgInfo(ProgInfo);
  458.         UNTIL Eof(DescFile);
  459.         {$I-}
  460.         Close(DescFile);
  461.         {$I+}
  462.        END; (* IF DescFileExists ... *)
  463.      END; (* IF DosError ... *)
  464.   END; (* IF Path <> '' ... *)
  465. END; (* TFileList.Init *)
  466.  
  467. FUNCTION TFileList.Compare(key1, key2: POINTER): INTEGER;
  468. (* This function tells the sorted collection how to sort its members.
  469.    (by Name, directories first *)
  470.  
  471. VAR d1, d2 : BOOLEAN;
  472.     k1, k2 : NameExtStr;
  473.     l1, l2 : LONGINT;
  474.  
  475.  FUNCTION StringCompare(k1, k2: NameExtStr): INTEGER;
  476.  
  477.  BEGIN
  478.   IF k1 = k2 THEN StringCompare := 0
  479.   ELSE
  480.    IF k1 < k2 THEN StringCompare := -1
  481.    ELSE StringCompare := +1;
  482.  END;
  483.  
  484.  FUNCTION LongintCompare(l1, l2: LONGINT): INTEGER;
  485.  
  486.  BEGIN
  487.   IF l1 = l2 THEN LongintCompare := 0
  488.   ELSE
  489.    IF l1 < l2 THEN LongintCompare := -1
  490.    ELSE LongintCompare := +1;
  491.  END;
  492.  
  493. BEGIN
  494.  (* Exceptions are . and .., handle them first *)
  495.  IF (key1 = NIL) OR (key2 = NIL) THEN
  496.   BEGIN
  497.    IF (key1 = NIL) AND (key2 <> NIL) THEN Compare := -1
  498.    ELSE
  499.    IF (key1 = NIL) AND (key2 =  NIL) THEN Compare := 0
  500.    ELSE Compare := +1;
  501.   END
  502.  ELSE
  503.  IF (PFileData(key1)^.Name[1] = '.') OR (PFileData(key2)^.Name[1] = '.') THEN
  504.   BEGIN
  505.    IF PFileData(key1)^.Name[1] = '.' THEN Compare := -1
  506.                                      ELSE Compare := +1;
  507.   END
  508.  ELSE
  509.   BEGIN
  510.    d1 := PFileData(key1)^.IsADir;  d2 := PFileData(key2)^.IsADir;
  511.    CASE SortKey OF
  512.     SortByName, SortByNameRev:
  513.                 BEGIN
  514.                  k1 := PFileData(key1)^.Name+PFileData(key1)^.Ext;
  515.                  k2 := PFileData(key2)^.Name+PFileData(key2)^.Ext;
  516.                 END;
  517.     SortByExt, SortByExtRev:
  518.                 BEGIN
  519.                  k1 := PFileData(key1)^.Ext+PFileData(key1)^.Ext;
  520.                  k2 := PFileData(key2)^.Ext+PFileData(key2)^.Ext;
  521.                 END;
  522.     SortBySize, SortBySizeRev:
  523.                 BEGIN
  524.                  l1 := PFileData(key1)^.Size; l2 := PFileData(key2)^.Size;
  525.                 END;
  526.     SortByDate, SortByDateRev:
  527.                 BEGIN
  528.                  l1 := PFileData(key1)^.DateRec.Min   +
  529.                        PFileData(key1)^.DateRec.Hour  * 100 +
  530.                        PFileData(key1)^.DateRec.Day   * 10000 +
  531.                        PFileData(key1)^.DateRec.Month * 1000000 +
  532.                        PFileData(key1)^.DateRec.Year  * 100000000;
  533.                  l2 := PFileData(key2)^.DateRec.Min   +
  534.                        PFileData(key2)^.DateRec.Hour  * 100 +
  535.                        PFileData(key2)^.DateRec.Day   * 10000 +
  536.                        PFileData(key2)^.DateRec.Month * 1000000 +
  537.                        PFileData(key2)^.DateRec.Year  * 100000000;
  538.                 END;
  539.    END;
  540.  
  541.    IF (SortKey = SortByName) OR (SortKey = SortByExt) THEN
  542.     BEGIN
  543.      IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := StringCompare(k1,k2)
  544.      ELSE
  545.       IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
  546.       ELSE
  547.       IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
  548.       ELSE Compare := StringCompare(k1,k2); (* both keys are directories *)
  549.     END
  550.    ELSE
  551.    IF (SortKey = SortByNameRev) OR (SortKey = SortByExtRev) THEN
  552.     BEGIN
  553.      IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := StringCompare(k2,k1)
  554.      ELSE
  555.       IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
  556.       ELSE
  557.       IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
  558.       ELSE Compare := StringCompare(k2,k1); (* both keys are directories *)
  559.     END
  560.    ELSE
  561.    IF (SortKey = SortBySize) OR (SortKey = SortByDate) THEN
  562.     BEGIN
  563.      IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := LongintCompare(l1,l2)
  564.      ELSE
  565.       IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
  566.       ELSE
  567.       IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
  568.       ELSE Compare := LongintCompare(l1,l2); (* both keys are directories *)
  569.     END
  570.    ELSE
  571.    IF (SortKey = SortBySizeRev) OR (SortKey = SortByDateRev) THEN
  572.     BEGIN
  573.      IF (d1 = FALSE) AND (d2 = FALSE) THEN Compare := LongintCompare(l2,l1)
  574.      ELSE
  575.       IF (d1 = FALSE) AND (d2 = TRUE) THEN Compare := +1 (* key2 is a dir *)
  576.       ELSE
  577.       IF (d1 = TRUE) AND (d2 = FALSE) THEN Compare := -1 (* key1 is a dir *)
  578.       ELSE Compare := LongintCompare(l2,l1); (* both keys are directories *)
  579.     END
  580.   END;
  581. END; (* TFileList.Compare *)
  582.  
  583. PROCEDURE ResortFileList;
  584. (* Resorts the current File List.
  585.    Resorting an already sorted list is in Turbo Vision
  586.    awkward and pretty costly.
  587.  
  588.    You basically have to duplicate the whole list, by repeatedly calling
  589.    Insert, which will do the work for you.
  590.    [ This is the easiest way, you could  - of course - do the sorting
  591.      `by foot', but this would duplicate the code above!             ]   *)
  592.  
  593. VAR NewFileList : PFileList;
  594.     i           : WORD;
  595.  
  596.     ListEntry: PFileData;
  597.     p        : PFileData;
  598.  
  599. (* PROCEDURE InsertFileData(Item: POINTER); FAR;
  600.  
  601.  VAR ListEntry: PFileData;
  602.      p        : PFileData;
  603.  
  604.  BEGIN
  605.    IF Item <> NIL  THEN
  606.     BEGIN
  607.      p := PFileData(Item); ListEntry := NIL;
  608.      ListEntry := New(PFileData,AssignValues(p^.IsADir,p^.Name,p^.Ext,
  609.                                              p^.Size, p^.DateRec,p^.Attr,
  610.                                              p^.GetProgInfo,p^.GetDesc));
  611.      IF ListEntry <> NIL THEN NewFileList^.Insert(ListEntry);
  612.     END;
  613.  END; *)
  614.  
  615. BEGIN
  616.  NewFileList := New(PFileList,Init('','',FileList^.Count));
  617.  (* create an empty FileList with FileList^.Count elements *)
  618.  
  619. (* FileList^.ForEach(@InsertFileData); *)
  620.  WHILE FileList^.Count > 0 DO
  621.   BEGIN
  622.    p := PFileData(FileList^.At(0)); ListEntry := NIL;
  623.    IF p <> NIL THEN
  624.     BEGIN
  625.      ListEntry := New(PFileData,AssignValues(p^.IsADir,p^.Name,p^.Ext,
  626.                                              p^.Size, p^.DateRec,p^.Attr,
  627.                                              p^.GetProgInfo,p^.GetDesc));
  628.      IF ListEntry <> NIL THEN NewFileList^.Insert(ListEntry);
  629.      FileList^.AtFree(0);
  630.     END;
  631.   END;
  632.  Dispose(FileList,Done); FileList := NewFileList;
  633. END;
  634.  
  635. PROCEDURE EvaluateINIFileSettings;
  636.  
  637. VAR c: WORD;
  638.     s: STRING;
  639.  
  640. BEGIN
  641.  s := DownStr(ReadSettingsString('generaldisplay','justify','left.left'));
  642.  IF s = 'left'       THEN Justify := Left
  643.  ELSE
  644.  IF s = 'left.left'  THEN Justify := LeftLeft
  645.  ELSE
  646.  IF s = 'right.left' THEN Justify := RightLeft
  647.  ELSE
  648.   Justify := Left;
  649.  
  650.  FullSize  := (ReadSettingsChar('generaldisplay','fullsize','n') = 'y');
  651.  UseHidden := (ReadSettingsChar('generaldisplay','hidden'  ,'n') = 'y');
  652.  
  653.  s := ReadSettingsString('generaldisplay','sortcriteria','name');
  654.  IF s = 'name'      THEN SortKey := SortByName
  655.  ELSE
  656.  IF s = 'ext'       THEN SortKey := SortByExt
  657.  ELSE
  658.  IF s = 'size'      THEN SortKey := SortBySize
  659.  ELSE
  660.  IF s = 'date'      THEN SortKey := SortByDate
  661.  ELSE
  662.  IF s = 'rev-name'  THEN SortKey := SortByNameRev
  663.  ELSE
  664.  IF s = 'rev-ext'   THEN SortKey := SortByExtRev
  665.  ELSE
  666.  IF s = 'rev-size'  THEN SortKey := SortBySizeRev
  667.  ELSE
  668.  IF s = 'rev-date'  THEN SortKey := SortByDateRev;
  669. END;
  670.  
  671. BEGIN
  672.  HeapError := @HeapFunc;
  673.  FileList  := NIL; (* never leave a Pointer uninitialized ! *)
  674. END.
  675.