home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tools / tvision1 / diropt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-06  |  16.4 KB  |  462 lines

  1. (* ------------------------------------------------------ *)
  2. (*                      DIROPT.PAS                        *)
  3. (*   Demonstrationsprogramm für die objektorientierte     *)
  4. (*   Toolbox: Analyse und Optimierung von Verzeichnissen. *)
  5. (*          (c) 1991 Gerd Cebulla & DMV-Verlag            *)
  6. (* ------------------------------------------------------ *)
  7. PROGRAM DirOpt;
  8. {$B-}
  9.  
  10. USES
  11.   Crt, Dos, DiskMan, FileMan;
  12.  
  13. TYPE
  14.   Optimizer = OBJECT (DiskManager)
  15.     FM            : pFileManager;
  16.     DirName       : PathStr;
  17.     ClusTotal,
  18.     ClusNeeded    : WORD;
  19.     TotalEntries  : LONGINT;
  20.     CriticalPhase : BOOLEAN;
  21.  
  22.     CONSTRUCTOR Init(Laufwerk : CHAR);
  23.     DESTRUCTOR  Done;                               VIRTUAL;
  24.     FUNCTION    TryAgain : BOOLEAN;                 VIRTUAL;
  25.     PROCEDURE   SetDir(Verzeichnis : PathStr);
  26.     PROCEDURE   Analyze;                            VIRTUAL;
  27.     PROCEDURE   Optimize;
  28.   END; { Optimizer }
  29.  
  30.   CONSTRUCTOR Optimizer.Init(Laufwerk : CHAR);
  31.   BEGIN
  32.     FM            := NIL;
  33.     CriticalPhase := FALSE;
  34.     IF NOT DiskManager.Init(Laufwerk) THEN Fail;
  35.     NEW(FM, Init(@Self));
  36.     IF FM = NIL THEN BEGIN
  37.       Done;
  38.       Fail;
  39.     END;
  40.     DirName      := '';
  41.     TotalEntries := -1;
  42.   END; { Optimizer.Init }
  43.  
  44.   DESTRUCTOR Optimizer.Done;
  45.   BEGIN
  46.     IF FM <> NIL THEN BEGIN
  47.       Dispose(FM, Done);
  48.       FM := NIL;
  49.     END;
  50.     DiskManager.Done;
  51.   END; { Optimizer.Done }
  52.  
  53.   FUNCTION Optimizer.TryAgain : BOOLEAN;
  54.     { Ersatz für DiskManager.TryAgain. Wird von ReadSector }
  55.     { WriteSector bei Lese-/Schreibfehlern aufgerufen und  }
  56.     { läßt den Benutzer entscheiden, ob das Programm       }
  57.     { abgebrochen oder der Datenträgerzugriff wiederholt   }
  58.     { werden soll.                                         }
  59.   VAR
  60.     Taste : CHAR;
  61.   BEGIN
  62.     CASE Lo(DiskError) OF
  63.       dskWriteProtected :
  64.         WriteLn('Diskette ist schreibgeschützt!');
  65.       dskDriveNotReady :
  66.         WriteLn('Laufwerk ist nicht bereit!');
  67.     ELSE
  68.       WriteLn('Fehler bei Datenträgerzugriff!');
  69.     END;
  70.     IF CriticalPhase THEN BEGIN
  71.       HighVideo;
  72.       WriteLn('ACHTUNG: Das Programm befindet sich '+
  73.               'zur Zeit in einer kritischen Phase!');
  74.       WriteLn('Wenn Sie sich jetzt für "Abbruch" '+
  75.               'entscheiden,');
  76.       WriteLn('müssen Sie mit Datenverlusten rechnen!');
  77.       NormVideo;
  78.     END;
  79.     Write('[W]iederholen oder [A]bbruch? ');
  80.     REPEAT
  81.       Taste := ReadKey;
  82.     UNTIL Pos(Taste, 'WwAa') > 0;
  83.     WriteLn(Taste);
  84.     TryAgain := UpCase(Taste) = 'W';
  85.   END; { Optimizer.TryAgain }
  86.  
  87.   PROCEDURE Optimizer.SetDir(Verzeichnis : PathStr);
  88.     { Über diese Methode wird der Instanz das zu           }
  89.     { bearbeitende Verzeichnis bekanntgegeben. Alle        }
  90.     { Aufrufe von "Analyze" und "Optimize" beziehen sich   }
  91.     { auf das hier übergebene Verzeichnis.                 }
  92.   BEGIN
  93.     DirName := Verzeichnis;
  94.     IF DirName[Length(DirName)] = '\' THEN
  95.       DEC(DirName[0]);        { '\' am String-Ende löschen }
  96.     TotalEntries := -1;
  97.   END; { Optimizer.SetDir }
  98.  
  99.   PROCEDURE Optimizer.Analyze;
  100.     { Untersucht das über SetDir angemeldete Verzeichnis   }
  101.     { auf nicht fortlaufende Einträge etc. und gibt einen  }
  102.     { Statusbericht aus.                                   }
  103.   TYPE
  104.     EntryType = (Frei, Datei, Verzeichnis);
  105.   VAR
  106.     LastEntry : EntryType;      { Typ des zuletzt          }
  107.                                 { untersuchten Eintrags    }
  108.     DirPtr    : pDirEntry;      { Zeiger auf Eintrag       }
  109.     Dirs,                       { Gesamtzahl Unterver-     }
  110.                                 { zeichniseinträge         }
  111.     FragDirs,                   { nicht fortlaufende       }
  112.                                 { Verzeichniseinträge      }
  113.     Files,                      { Gesamtzahl Dateieinträge }
  114.     FragFiles,                  { nicht fortlaufende       }
  115.                                 { Dateieinträge            }
  116.     FreeEntries,                { Gesamtzahl freier        }
  117.                                 { Einträge                 }
  118.     Erased,                     { gelöschte Einträge       }
  119.     Unused    : LONGINT;        { unbenutzte Einträge      }
  120.     DirEntriesPerCluster : WORD;
  121.   BEGIN
  122.     DiskError    := dskOk;
  123.     WriteLn('Verzeichnis wird analysiert ...');
  124.  
  125.     TotalEntries := 0;   Dirs         := 0;
  126.     FragDirs     := 0;   Files        := 0;
  127.     FragFiles    := -1;  FreeEntries  := 0;
  128.     Erased       := 0;   Unused       := 0;
  129.  
  130.     DirPtr := FM^.GetFirstEntry(Concat(DirName, '\*.*'));
  131.     IF (DirPtr^.Name[1] = #0) OR
  132.        (DirPtr^.Name[1] = #$E5) THEN
  133.       LastEntry := Frei
  134.     ELSE IF DirPtr^.Attribute AND Directory <> 0 THEN
  135.       LastEntry := Verzeichnis
  136.     ELSE BEGIN
  137.       LastEntry := Datei;
  138.       FragFiles := 0;
  139.     END;
  140.     WHILE DiskError = dskOk DO BEGIN
  141.       INC(TotalEntries);
  142.       IF (DirPtr^.Name[1] = #0) OR
  143.          (DirPtr^.Name[1] = #$E5) THEN BEGIN
  144.                           { gelöschter oder freier Eintrag }
  145.         INC(FreeEntries);
  146.         IF DirPtr^.Name[1] = #0 THEN INC(Unused)
  147.                                 ELSE INC(Erased);
  148.         LastEntry := Frei;
  149.       END ELSE IF DirPtr^.Attribute AND
  150.                   Directory <> 0 THEN BEGIN
  151.                                         { Unterverzeichnis }
  152.         INC(Dirs);
  153.         IF LastEntry <> Verzeichnis THEN BEGIN
  154.           INC(FragDirs);
  155.           LastEntry := Verzeichnis;
  156.         END;
  157.       END ELSE BEGIN                       { normale Datei }
  158.         INC(Files);
  159.         IF LastEntry <> Datei THEN BEGIN
  160.           INC(FragFiles);
  161.           LastEntry := Datei;
  162.         END;
  163.       END;
  164.       DirPtr := FM^.GetNextEntry;
  165.     END;
  166.     IF FragFiles = -1 THEN FragFiles := 0;
  167.     IF DiskError = dskNoMoreFiles THEN BEGIN
  168.       DiskError := dskOk;
  169.       IF Length(DirName) = 2 THEN BEGIN
  170.                            { Größe des Stammverzeichnisses }
  171.                            { kann nicht verändert werden   }
  172.         ClusTotal  := 0;
  173.         ClusNeeded := 0;
  174.       END ELSE BEGIN
  175.                  { Berechnung der vom Verzeichnis belegten }
  176.                  { und der tatsächlich benötigten Cluster  }
  177.         DirEntriesPerCluster := DirEntriesPerSector *
  178.                                 SectorsPerCluster;
  179.         ClusTotal  := Succ(Pred(TotalEntries) DIV
  180.                           DirEntriesPerCluster);
  181.         ClusNeeded := Succ(Pred(TotalEntries-FreeEntries)
  182.                       DIV DirEntriesPerCluster);
  183.       END;
  184.  
  185.       WriteLn;                       { Ergebnisse ausgeben }
  186.       WriteLn(#196#196#196#196#196#196+
  187.               ' VERZEICHNISANALYSE '+
  188.               #196#196#196#196#196#196);
  189.       WriteLn('Belegte Cluster      :':21, ClusTotal:11);
  190.       WriteLn('davon benötigt       :':21, ClusNeeded:11);
  191.       WriteLn('Anzahl Verzeichnisse :':21, Dirs:11);
  192.       WriteLn('davon fragmentiert   :':21, FragDirs:11);
  193.       WriteLn('Anzahl Dateien       :':21, Files:11);
  194.       WriteLn('davon fragmentiert   :':21, FragFiles:11);
  195.       WriteLn('Freie Einträge       :':21, FreeEntries:11);
  196.       WriteLn('davon gelöscht       :':21, Erased:11);
  197.       WriteLn('davon unbenutzt      :':21, Unused:11);
  198.       WriteLn;
  199.     END;
  200.   END; { Optimizer.Analyze }
  201.  
  202.   PROCEDURE Optimizer.Optimize;
  203.     { Führt für das per SetDir übergebene Verzeichnis eine }
  204.     { Zugriffsoptimierung durch, indem alle                }
  205.     { Unterverzeichniseinträge an den Anfang des           }
  206.     { Verzeichnisses kopiert und gelöschte Einträge        }
  207.     { entfernt werden. Ggf. werden auch unnötig belegte    }
  208.     { Cluster freigegeben.                                 }
  209.   CONST
  210.     DontTouch = Hidden OR SysFile OR VolumeID;
  211.         { versteckte und Systemdateien sowie Volume-Labels }
  212.         { sind von der Optimierung ausgenommen             }
  213.   VAR
  214.     SecPtr       : pDirSector;
  215.     DirPtr       : pDirEntry;
  216.     Entry1,
  217.     Entry2       : DirEntry;
  218.     Index,
  219.     Index1,
  220.     Index2       : LONGINT;
  221.     ClusterNr,
  222.     NextCluster,
  223.     Count        : WORD;
  224.     Gefunden     : BOOLEAN;
  225.   BEGIN
  226.     DiskError := dskOk;
  227.     IF TotalEntries = -1 THEN Analyze;
  228.     WriteLn('Verzeichnis wird optimiert ...');
  229.     CriticalPhase := TRUE;
  230.     DirPtr        := FM^.GetFirstEntry(DirName);
  231.     WHILE (DiskError = dskOk) AND
  232.           (DirPtr^.Attribute AND Directory = 0) DO
  233.       DirPtr := FM^.GetNextEntry;
  234.     ClusterNr := DirPtr^.FirstCluster;
  235.     IF DiskError = dskOk THEN
  236.       FM^.Load(0);        { Verzeichnis in Puffer einlesen }
  237.                { Stufe 1: alle Unterverzeichniseinträge an }
  238.                { den Anfang des Verzeichnisses kopieren    }
  239.     Index1   := 0;
  240.     Index2   := 0;
  241.     Gefunden := TRUE;
  242.     WHILE (DiskError = dskOk) AND Gefunden DO BEGIN
  243.       Gefunden := FALSE;
  244.       WHILE (DiskError = dskOk) AND (Index1 < TotalEntries)
  245.             AND NOT Gefunden DO BEGIN
  246.         SecPtr := pDirSector(FM^.GetFileSector(Index1 DIV
  247.                                       DirEntriesPerSector));
  248.         DirPtr := @SecPtr^[Index1 MOD DirEntriesPerSector];
  249.         Gefunden := (DirPtr^.Attribute AND
  250.                     (DontTouch OR Directory) = 0) OR
  251.                     (DirPtr^.Name[1] = #0) OR
  252.                     (DirPtr^.Name[1] = #$E5);
  253.         INC(Index1);
  254.       END;
  255.       IF (DiskError = dskOk) AND Gefunden THEN BEGIN
  256.         Entry1 := DirPtr^;
  257.         IF Index2 < Index1 THEN Index2 := Index1;
  258.         Gefunden := FALSE;
  259.         WHILE (DiskError = dskOk) AND
  260.               (Index2 < TotalEntries) AND
  261.               NOT Gefunden DO BEGIN
  262.           SecPtr:= pDirSector(FM^.GetFileSector(Index2 DIV
  263.                                       DirEntriesPerSector));
  264.           DirPtr:= @SecPtr^[Index2 MOD DirEntriesPerSector];
  265.           Gefunden := (DirPtr^.Attribute AND
  266.                       (DontTouch OR Directory) = Directory)
  267.                       AND (DirPtr^.Name[1] <> #0) AND
  268.                       (DirPtr^.Name[1] <> #$E5);
  269.           INC(Index2);
  270.         END;
  271.         IF (DiskError = dskOk) AND Gefunden THEN BEGIN
  272.                                     { Einträge vertauschen }
  273.           Entry2  := DirPtr^;
  274.           DirPtr^ := Entry1;
  275.           SecPtr  := pDirSector
  276.                      (FM^.GetFileSector(Pred(Index1) DIV
  277.                           DirEntriesPerSector));
  278.           IF DiskError = dskOk THEN
  279.             SecPtr^[PRED(Index1) MOD
  280.             DirEntriesPerSector] := Entry2;
  281.         END;
  282.       END;
  283.     END;
  284.                           { Stufe 2: Dateieinträge in      }
  285.                           { lückenlose Reihenfolge bringen }
  286.     Index1   := 0;
  287.     Index2   := 0;
  288.     Gefunden := TRUE;
  289.     WHILE (DiskError = dskOk) AND Gefunden DO BEGIN
  290.       Gefunden := FALSE;
  291.       WHILE (DiskError = dskOk) AND
  292.             (Index1 < TotalEntries) AND
  293.             NOT Gefunden DO BEGIN
  294.         SecPtr := pDirSector
  295.                   (FM^.GetFileSector(Index1 DIV
  296.                        DirEntriesPerSector));
  297.         DirPtr := @SecPtr^[Index1 MOD DirEntriesPerSector];
  298.         Gefunden := (DirPtr^.Name[1] = #0) OR
  299.                     (DirPtr^.Name[1] = #$E5);
  300.         INC(Index1);
  301.       END;
  302.       IF (DiskError = dskOk) AND Gefunden THEN BEGIN
  303.         Entry1 := DirPtr^;
  304.         IF Index2 < Index1 THEN
  305.           Index2 := Index1;
  306.         Gefunden := FALSE;
  307.         WHILE (DiskError = dskOk) AND
  308.               (Index2 < TotalEntries) AND
  309.               NOT Gefunden DO BEGIN
  310.           SecPtr := PDirSector(FM^.GetFileSector(Index2 DIV
  311.                                DirEntriesPerSector));
  312.           DirPtr:= @SecPtr^[Index2 MOD DirEntriesPerSector];
  313.           Gefunden := (DirPtr^.Attribute AND
  314.                       (DontTouch OR Directory) = 0) AND
  315.                       (DirPtr^.Name[1] <> #0) AND
  316.                       (DirPtr^.Name[1] <> #$E5);
  317.           INC(Index2);
  318.         END;
  319.         IF (DiskError = dskOk) AND Gefunden THEN BEGIN
  320.                                     { Einträge vertauschen }
  321.           Entry2  := DirPtr^;
  322.           DirPtr^ := Entry1;
  323.           SecPtr  := pDirSector
  324.                      (FM^.GetFileSector(Pred(Index1) DIV
  325.                           DirEntriesPerSector));
  326.           IF DiskError = dskOk THEN
  327.             SecPtr^[Pred(Index1) MOD
  328.               DirEntriesPerSector] := Entry2;
  329.         END;
  330.       END;
  331.     END;
  332.                   { Stufe 3: gelöschte Einträge rauswerfen }
  333.     Index := 0;
  334.     WHILE (DiskError = dskOk) AND
  335.           (Index < TotalEntries) DO BEGIN
  336.       SecPtr := PDirSector(FM^.GetFileSector(Index DIV
  337.                                DirEntriesPerSector));
  338.       DirPtr := @SecPtr^[Index MOD DirEntriesPerSector];
  339.       IF (DiskError = dskOk) AND
  340.          (DirPtr^.Name[1] = #$E5) THEN
  341.         DirPtr^.Name[1] := #0;
  342.       INC(Index);
  343.     END;
  344.                           { Verzeichnis auf Datenträger    }
  345.                           { schreiben und Puffer freigeben }
  346.     FM^.Unload;
  347.     IF (DiskError = dskOk) AND
  348.        (ClusNeeded < ClusTotal) THEN BEGIN
  349.               { Stufe 4: nicht benötigte Cluster freigeben }
  350.       NextCluster := ClusterNr;
  351.       Count       := 1;
  352.       WHILE (DiskError = dskOk) AND
  353.             (Count <= ClusNeeded) DO BEGIN
  354.                        { letzten benötigten Cluster suchen }
  355.         ClusterNr   := NextCluster;
  356.         NextCluster := GetFatEntry(ClusterNr);
  357.         INC(Count);
  358.       END;
  359.       IF DiskError = dskOk THEN
  360.         PutFatEntry(ClusterNr, $FFFF);
  361.           { Code für "letzter Cluster der Datei" eintragen }
  362.       WHILE (DiskError = dskOk) AND
  363.             (Count <= ClusTotal) DO BEGIN
  364.                              { restliche Cluster freigeben }
  365.         ClusterNr   := NextCluster;
  366.         NextCluster := GetFatEntry(ClusterNr);
  367.         IF DiskError = dskOk THEN
  368.           PutFatEntry(ClusterNr, 0);
  369.                    { Code für "Cluster ist frei" eintragen }
  370.         INC(Count);
  371.       END;
  372.       IF DiskError = dskOk THEN
  373.         WriteFat;       { geänderte FAT auf Disk schreiben }
  374.     END;
  375.     CriticalPhase := FALSE;
  376.     IF DiskError = dskOk THEN
  377.       WriteLn('* Optimierung abgeschlossen *');
  378.   END; { Optimizer.Optimize }
  379.  
  380.   PROCEDURE Hilfe;
  381.     { Hilfestellung ausgeben }
  382.   BEGIN
  383.     WriteLn('Dieses Programm analysiert '+
  384.             'ein (Unter-)Verzeichnis');
  385.     WriteLn('und führt auf Wunsch eine '+
  386.             'Zugriffsoptimierung durch.');
  387.     WriteLn;
  388.     Writeln('Aufruf: DIROPT Verzeichnisname');
  389.   END; { Hilfe }
  390.  
  391.   PROCEDURE Abbruch;
  392.     { Fehlermeldung ausgeben und Programm mit Exit-Code }
  393.     { beenden                                           }
  394.   BEGIN
  395.     IF DiskError = dskOk THEN
  396.       DiskError := 255;
  397.     IF DiskError < 256 THEN BEGIN
  398.       CASE DiskError OF
  399.         dskPathNotFound, dskNoMoreFiles :
  400.           WriteLn('Verzeichnis nicht gefunden');
  401.         dskNoMemory :
  402.           WriteLn('Nicht genug Hauptspeicher');
  403.       ELSE
  404.         WriteLn('Programm abgebrochen');
  405.       END;
  406.       Halt(DiskError);
  407.     END ELSE BEGIN
  408.       WriteLn('Programm abgebrochen');
  409.       Halt(Hi(DiskError));
  410.     END;
  411.   END; { Abbruch }
  412.  
  413.   {$F+}
  414.   FUNCTION HeapFunc(Size : WORD) : INTEGER;
  415.   {$F-}
  416.     { verhindert Programmabbruch bei Heap-Fehlern }
  417.   BEGIN
  418.     HeapFunc := 1;
  419.   END; { HeapFunc }
  420.  
  421. VAR
  422.   Opt         : ^Optimizer;
  423.   Verzeichnis : PathStr;
  424.   Taste       : CHAR;
  425. BEGIN
  426.   WriteLn('DIRECTORY OPTIMIZER V1,0  *****  '+
  427.           '(c) 1991 Gerd Cebulla & DMV-Verlag');
  428.   WriteLn;
  429.   IF (ParamCount <> 1) OR (ParamStr(1) = '?') THEN BEGIN
  430.     Hilfe;
  431.     Halt(1);
  432.   END;
  433.     { eigene Fehlerroutine für Heapverwaltung installieren }
  434.   HeapError := @HeapFunc;
  435.     { Verzeichnisnamen in Großbuchstaben umwandeln }
  436.     { und um vollständigen Suchpfad erweitern      }
  437.   Verzeichnis := FExpand(ParamStr(1));
  438.   WriteLn(Verzeichnis);
  439.   WriteLn;
  440.     { Optimizer initialisieren }
  441.   NEW(Opt, Init(Verzeichnis[1]));
  442.   IF Opt = NIL THEN Abbruch;
  443.                        { nicht genug Heap oder Disk-Fehler }
  444.   Opt^.SetDir(Verzeichnis);     { Verzeichnis anmelden     }
  445.   Opt^.Analyze;                 { Verzeichnis analysieren  }
  446.   IF DiskError <> dskOk THEN BEGIN
  447.     Dispose(Opt, Done);
  448.     Abbruch;
  449.   END;
  450.   Write('Verzeichnis optimieren [J/N]? ');
  451.   Taste := ReadKey;
  452.   WriteLn(Taste);
  453.   IF UpCase(Taste) = 'J' THEN BEGIN
  454.     Opt^.Optimize;
  455.     IF DiskError = dskOk THEN Opt^.Analyze;
  456.   END;
  457.   Dispose(Opt, Done);
  458.   IF DiskError <> dskOk THEN Abbruch;
  459. END.
  460. (* ------------------------------------------------------ *)
  461. (*                Ende von DIROPT.PAS                     *)
  462.