home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / dosfunc / dirlib.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-04  |  9.1 KB  |  191 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                              DIRLIB.PAS                                 *)
  3. (*              (c) 1987  Michael Ceol & PASCAL INT.                       *)
  4. (* Betriebssystem- und compilerunabhaengige Routinen der Directory-Biblio- *)
  5. (* thek. Diese rufen wiederum die "low level" Routinen in DIRMT.TUR,       *)
  6. (* DIRMT.PSP bzw. DIRCP.TUR auf, um den eigentlichen Job zu erledigen.     *)
  7.  
  8. (*                       ein bischen Konvertierung:                        *)
  9. (* ----------------------------------------------------------------------- *)
  10. (*    String in eine ASCIIZ-Zeichenfolge konvertieren, wie es von den      *)
  11. (*                     Betriebssystemen benoetigt wird:                    *)
  12. PROCEDURE StrChr (VAR st: Dir_Str; VAR ch: Dir_Chr0);
  13. VAR i : INTEGER;
  14. BEGIN
  15.   FOR i := 1 TO Length(st) DO ch[i] := st[i];
  16.   ch[Succ(Length(st))] := Chr(0);
  17. END;
  18. (* ----------------------------------------------------------------------- *)
  19. (*   Dateinamen aus einem "Dir_Rec" (name[8], ext[3]) in einen gueltigen   *)
  20. (*           Dateinamen des Formats "name.ext" konvertieren:               *)
  21. PROCEDURE MakeFileName (VAR direntry: Dir_Rec; VAR filename: Dir_Str);
  22. VAR i : INTEGER;
  23. BEGIN
  24.   filename := '';
  25.   WITH direntry DO BEGIN
  26.     FOR i := 1 TO 8 DO      (* die aufgefuellten Leerzeichen muessen weg ! *)
  27.       IF name[i] <> ' ' THEN filename := Concat(filename, name[i]);
  28.     IF ext <> '   ' THEN BEGIN       (* gibt's Extension ? (3 Leerzeichen) *)
  29.       filename := Concat(filename, '.');             (* ja, Trennpunkt und *)
  30.       FOR i := 1 TO 3 DO                             (* Extension anfuegen *)
  31.         IF ext[i] <> ' ' THEN filename := Concat(filename, ext[i]);
  32.     END;
  33.   END;
  34. END;
  35. (* ----------------------------------------------------------------------- *)
  36. (*    Das Gleiche fuer den i-ten Eintrag eines eingelesenen Directorys:    *)
  37. PROCEDURE MakeDirFileName (index: INTEGER; VAR directory: Dir_Typ;
  38.                                            VAR filename : Dir_Str);
  39. BEGIN
  40.   WITH directory DO
  41.     IF (index > 0) AND (index <= num) THEN
  42.       MakeFileName(items[index],filename);
  43. END;
  44.  
  45. (*                    nun zu den Directory-Funktionen:                     *)
  46. (* ----------------------------------------------------------------------- *)
  47. (* Wie in DIR??TYP.PAS erwaehnt, muss die DTA dynamisch verwaltet werden.  *)
  48. (* Man muss VOR Gebrauch der folgenden Funktionen mit "NewDTA" eine eigene *)
  49. (* DTA erschaffen, und diese mit "DispDTA" wieder freigeben, wenn nicht    *)
  50. (* mehr benoetigt. Der Zeiger auf diese DTA muss aus dem gleichen Grund in *)
  51. (* einer globalen Variablen gehalten werden:                               *)
  52. PROCEDURE NewDirDTA;
  53. BEGIN  New(DirDTA)  END;
  54.  
  55. PROCEDURE DispDirDTA;
  56. BEGIN  Dispose(DirDTA)  END;
  57. (* ----------------------------------------------------------------------- *)
  58. (* "SetDTA" teilt dem BS eine neue DTA-Adresse mit, "GetDTA" ermittelt die *)
  59. (* gerade vom BS verwendete DTA-Adresse:                                   *)
  60. PROCEDURE SetDTA (DTA: DTA_Ptr);
  61. BEGIN  IF DTA <> NIL THEN FSetDTA(DTA)  END;
  62.  
  63. PROCEDURE GetDTA (VAR DTA: DTA_Ptr);
  64. BEGIN  DTA := FGetDTA;  END;
  65. (* ----------------------------------------------------------------------- *)
  66. (* Den ersten mit der Suchspezifikation "search" (kann auch '*' oder '?'   *)
  67. (* enthalten) und mit dem Attribut uebereinstimmenden Directory-Eintrag    *)
  68. (* suchen. Wird einer gefunden, enthaelt die Variable "DirResult" den Wert *)
  69. (* 0, ansonsten einen Fehlercode (s. DIRCONST.PAS). Bei Erfolg wird der    *)
  70. (* gefundene Eintrag als Dir-Record ausgegeben:                            *)
  71. PROCEDURE DirFirst (search: Dir_Str; attr: INTEGER; VAR entry: Dir_Rec);
  72. VAR oldDTA : DTA_Ptr;  temp : Dir_Chr0;  i : INTEGER;
  73. BEGIN
  74.        (* fuer den Volume-Eintrag eine wirklich exklusive Suche erzwingen: *)
  75.   IF AndInt(attr,DirVol) = DirVol THEN attr := DirVol;
  76.          (* aktuelle DTA sichern und fuer Dir-Funktionen eigene verwenden: *)
  77.   GetDTA(oldDTA);   SetDTA(DirDTA);
  78.   StrChr(search,temp); (* Zeichenfolge der Suchspez. zu eine ASCIIZ-Folge. *)
  79.   DirResult := FSFirst(temp, attr);              (* Betriebssystem-Aufruf. *)
  80.   DTAtoDirEntry(entry);      (* Info aus DTA in unseren Dir-Record bringen *)
  81.   SetDTA(oldDTA);                       (* wieder alte DTA benutzen lassen *)
  82. END;
  83. (* ----------------------------------------------------------------------- *)
  84. (* den naechsten mit der bei "DirFirst" festgelegten Suchspez. ueberein-   *)
  85. (* stimmenden Eintrag suchen. Fuer "DirResult" gilt oben beschriebenes.    *)
  86. PROCEDURE DirNext (VAR entry: Dir_Rec);
  87. VAR oldDTA: DTA_Ptr;
  88. BEGIN
  89.   GetDTA(oldDTA);  SetDTA(DirDTA);  DirResult := FSNext;
  90.   SetDTA(oldDTA);  DTAtoDirEntry(entry);
  91. END;
  92. (* ----------------------------------------------------------------------- *)
  93. (* alle mit Suchspez. uebereinstimmenden Eintraege suchen und in unseren   *)
  94. (* Directory-Puffer in der Reihenfolge des Auftretens eintragen:           *)
  95. PROCEDURE Dir (search: Dir_Str; attr: INTEGER; VAR directory: Dir_Typ);
  96. VAR entry: Dir_Rec;
  97. BEGIN
  98.   WITH directory DO BEGIN
  99.     num := 0;   DirFirst(search, attr, entry);
  100.     WHILE DirResult = DOSfnok DO BEGIN    (* solange kein Fehler auftritt. *)
  101.       num := Succ(num);  items[num] := entry;   DirNext(entry);
  102.     END;
  103.   END;
  104. END;
  105. (* ----------------------------------------------------------------------- *)
  106. (*    gelesenes Verzeichnis nach 'sortkey' sortieren, wobei Unterver-      *)
  107. (*          zeichnisse immer an den Anfang gebracht werden:                *)
  108. PROCEDURE SortDir (sortkey: INTEGER; VAR directory: Dir_Typ);
  109. VAR i, j, p : INTEGER;  help : Dir_Rec;
  110.  
  111. PROCEDURE Swap(i1, i2: INTEGER); (* zwei Eintrage im Directory vertauschen *)
  112.   BEGIN
  113.     WITH directory DO BEGIN
  114.       help := items[i1]; items[i1] := items[i2]; items[i2] := help;
  115.     END;
  116.   END;
  117.  
  118. (*$A+*)                         (* Turbo Pascal: rekursiven Code erzeugen! *)
  119. (*    Vergleichsfunktion fuer die Sortierung durch den verf. Shell-Sort:   *)
  120. FUNCTION lower(sortkey, i1, i2: INTEGER): BOOLEAN;
  121.   VAR tmp: ARRAY [1..3] OF Dir_Str;
  122.   BEGIN
  123.     lower := FALSE;
  124.     IF i2 > 0 THEN
  125.       WITH directory DO BEGIN
  126.                (* Strings (Name, Extension, Datum) von Unterverzeichnissen
  127.                   kleiner als die von Dateien "machen":                    *)
  128.         tmp[1] := '!';  tmp[2] := '!';
  129.         IF items[i1].attr = DirDir THEN tmp[1] := ' ';        (* ' ' < '!' *)
  130.         IF items[i2].attr = DirDir THEN tmp[2] := ' ';
  131.         CASE sortkey OF
  132.           DirDate: BEGIN
  133.                                           (* juengste Eintraege (groesstes
  134.                                              Datum als String) nach vorn:  *)
  135.                      tmp[3] := tmp[1]; tmp[1] := tmp[2]; tmp[2] := tmp[3];
  136.                      tmp[1] := Concat(tmp[1],items[i1].date);
  137.                      tmp[2] := Concat(tmp[2],items[i2].date);
  138.                      lower := tmp[1] > tmp[2];
  139.                                      (* notfalls noch Uhrzeit vergleichen: *)
  140.                      IF tmp[1] = tmp[2] THEN
  141.                        IF items[i1].time > items[i2].time THEN
  142.                          lower := TRUE
  143.                                         (* gut, dann halt noch nach Namen: *)
  144.                        ELSE IF items[i1].time = items[i2].time THEN
  145.                          lower := lower(DirName,i1,i2)
  146.                    END;
  147.           DirSize: BEGIN
  148.                                        (* die groessten Dateien nach vorn: *)
  149.                           (* zwischen Verzeichnis und Datei unterscheiden: *)
  150.                      IF (tmp[1] = ' ') OR (tmp[2] = ' ') THEN
  151.                        lower := items[i1].size < items[i2].size
  152.                      ELSE
  153.                        lower := items[i1].size > items[i2].size;
  154.                      IF items[i1].size = items[i2].size THEN
  155.                        lower := lower(DirName,i1,i2);
  156.                    END;
  157.                                              (* folgendes ist klar, oder ? *)
  158.         DirExt : BEGIN
  159.                      tmp[1] := Concat(tmp[1],items[i1].ext,items[i1].name);
  160.                      tmp[2] := Concat(tmp[2],items[i2].ext,items[i2].name);
  161.                      lower := tmp[1] < tmp[2];
  162.                    END;
  163.           ELSE     BEGIN
  164.                      tmp[1] := Concat(tmp[1],items[i1].name,items[i1].ext);
  165.                      tmp[2] := Concat(tmp[2],items[i2].name,items[i2].ext);
  166.                      lower := tmp[1] < tmp[2];
  167.                    END;
  168.         END;
  169.       END;
  170.   END;
  171. (*$A-*)
  172.  
  173. BEGIN (* verfeinerter Shell-Sort, s. 'Sortieren in Modula 2' *)
  174.   WITH directory DO BEGIN
  175.     p := num;
  176.     WHILE p > 1 DO BEGIN
  177.       p := p DIV 2;
  178.       FOR i := 1 TO num-p DO
  179.         IF lower(sortkey,i+p,i) THEN BEGIN
  180.           Swap(i,i+p);
  181.           j := i;
  182.           WHILE (j >= 1+p) AND lower(sortkey,j,j-p) DO BEGIN
  183.             Swap(j,j-p);  j := j - p;
  184.           END;
  185.         END;
  186.     END;
  187.   END;
  188. END;
  189. (* ----------------------------------------------------------------------- *)
  190. (*                              DIRLIB.PAS                                 *)
  191.