home *** CD-ROM | disk | FTP | other *** search
- (* ------------------------------------------------------ *)
- (* DIROPT.PAS *)
- (* Demonstrationsprogramm für die objektorientierte *)
- (* Toolbox: Analyse und Optimierung von Verzeichnissen. *)
- (* (c) 1991 Gerd Cebulla & DMV-Verlag *)
- (* ------------------------------------------------------ *)
- PROGRAM DirOpt;
- {$B-}
-
- USES
- Crt, Dos, DiskMan, FileMan;
-
- TYPE
- Optimizer = OBJECT (DiskManager)
- FM : pFileManager;
- DirName : PathStr;
- ClusTotal,
- ClusNeeded : WORD;
- TotalEntries : LONGINT;
- CriticalPhase : BOOLEAN;
-
- CONSTRUCTOR Init(Laufwerk : CHAR);
- DESTRUCTOR Done; VIRTUAL;
- FUNCTION TryAgain : BOOLEAN; VIRTUAL;
- PROCEDURE SetDir(Verzeichnis : PathStr);
- PROCEDURE Analyze; VIRTUAL;
- PROCEDURE Optimize;
- END; { Optimizer }
-
- CONSTRUCTOR Optimizer.Init(Laufwerk : CHAR);
- BEGIN
- FM := NIL;
- CriticalPhase := FALSE;
- IF NOT DiskManager.Init(Laufwerk) THEN Fail;
- NEW(FM, Init(@Self));
- IF FM = NIL THEN BEGIN
- Done;
- Fail;
- END;
- DirName := '';
- TotalEntries := -1;
- END; { Optimizer.Init }
-
- DESTRUCTOR Optimizer.Done;
- BEGIN
- IF FM <> NIL THEN BEGIN
- Dispose(FM, Done);
- FM := NIL;
- END;
- DiskManager.Done;
- END; { Optimizer.Done }
-
- FUNCTION Optimizer.TryAgain : BOOLEAN;
- { Ersatz für DiskManager.TryAgain. Wird von ReadSector }
- { WriteSector bei Lese-/Schreibfehlern aufgerufen und }
- { läßt den Benutzer entscheiden, ob das Programm }
- { abgebrochen oder der Datenträgerzugriff wiederholt }
- { werden soll. }
- VAR
- Taste : CHAR;
- BEGIN
- CASE Lo(DiskError) OF
- dskWriteProtected :
- WriteLn('Diskette ist schreibgeschützt!');
- dskDriveNotReady :
- WriteLn('Laufwerk ist nicht bereit!');
- ELSE
- WriteLn('Fehler bei Datenträgerzugriff!');
- END;
- IF CriticalPhase THEN BEGIN
- HighVideo;
- WriteLn('ACHTUNG: Das Programm befindet sich '+
- 'zur Zeit in einer kritischen Phase!');
- WriteLn('Wenn Sie sich jetzt für "Abbruch" '+
- 'entscheiden,');
- WriteLn('müssen Sie mit Datenverlusten rechnen!');
- NormVideo;
- END;
- Write('[W]iederholen oder [A]bbruch? ');
- REPEAT
- Taste := ReadKey;
- UNTIL Pos(Taste, 'WwAa') > 0;
- WriteLn(Taste);
- TryAgain := UpCase(Taste) = 'W';
- END; { Optimizer.TryAgain }
-
- PROCEDURE Optimizer.SetDir(Verzeichnis : PathStr);
- { Über diese Methode wird der Instanz das zu }
- { bearbeitende Verzeichnis bekanntgegeben. Alle }
- { Aufrufe von "Analyze" und "Optimize" beziehen sich }
- { auf das hier übergebene Verzeichnis. }
- BEGIN
- DirName := Verzeichnis;
- IF DirName[Length(DirName)] = '\' THEN
- DEC(DirName[0]); { '\' am String-Ende löschen }
- TotalEntries := -1;
- END; { Optimizer.SetDir }
-
- PROCEDURE Optimizer.Analyze;
- { Untersucht das über SetDir angemeldete Verzeichnis }
- { auf nicht fortlaufende Einträge etc. und gibt einen }
- { Statusbericht aus. }
- TYPE
- EntryType = (Frei, Datei, Verzeichnis);
- VAR
- LastEntry : EntryType; { Typ des zuletzt }
- { untersuchten Eintrags }
- DirPtr : pDirEntry; { Zeiger auf Eintrag }
- Dirs, { Gesamtzahl Unterver- }
- { zeichniseinträge }
- FragDirs, { nicht fortlaufende }
- { Verzeichniseinträge }
- Files, { Gesamtzahl Dateieinträge }
- FragFiles, { nicht fortlaufende }
- { Dateieinträge }
- FreeEntries, { Gesamtzahl freier }
- { Einträge }
- Erased, { gelöschte Einträge }
- Unused : LONGINT; { unbenutzte Einträge }
- DirEntriesPerCluster : WORD;
- BEGIN
- DiskError := dskOk;
- WriteLn('Verzeichnis wird analysiert ...');
-
- TotalEntries := 0; Dirs := 0;
- FragDirs := 0; Files := 0;
- FragFiles := -1; FreeEntries := 0;
- Erased := 0; Unused := 0;
-
- DirPtr := FM^.GetFirstEntry(Concat(DirName, '\*.*'));
- IF (DirPtr^.Name[1] = #0) OR
- (DirPtr^.Name[1] = #$E5) THEN
- LastEntry := Frei
- ELSE IF DirPtr^.Attribute AND Directory <> 0 THEN
- LastEntry := Verzeichnis
- ELSE BEGIN
- LastEntry := Datei;
- FragFiles := 0;
- END;
- WHILE DiskError = dskOk DO BEGIN
- INC(TotalEntries);
- IF (DirPtr^.Name[1] = #0) OR
- (DirPtr^.Name[1] = #$E5) THEN BEGIN
- { gelöschter oder freier Eintrag }
- INC(FreeEntries);
- IF DirPtr^.Name[1] = #0 THEN INC(Unused)
- ELSE INC(Erased);
- LastEntry := Frei;
- END ELSE IF DirPtr^.Attribute AND
- Directory <> 0 THEN BEGIN
- { Unterverzeichnis }
- INC(Dirs);
- IF LastEntry <> Verzeichnis THEN BEGIN
- INC(FragDirs);
- LastEntry := Verzeichnis;
- END;
- END ELSE BEGIN { normale Datei }
- INC(Files);
- IF LastEntry <> Datei THEN BEGIN
- INC(FragFiles);
- LastEntry := Datei;
- END;
- END;
- DirPtr := FM^.GetNextEntry;
- END;
- IF FragFiles = -1 THEN FragFiles := 0;
- IF DiskError = dskNoMoreFiles THEN BEGIN
- DiskError := dskOk;
- IF Length(DirName) = 2 THEN BEGIN
- { Größe des Stammverzeichnisses }
- { kann nicht verändert werden }
- ClusTotal := 0;
- ClusNeeded := 0;
- END ELSE BEGIN
- { Berechnung der vom Verzeichnis belegten }
- { und der tatsächlich benötigten Cluster }
- DirEntriesPerCluster := DirEntriesPerSector *
- SectorsPerCluster;
- ClusTotal := Succ(Pred(TotalEntries) DIV
- DirEntriesPerCluster);
- ClusNeeded := Succ(Pred(TotalEntries-FreeEntries)
- DIV DirEntriesPerCluster);
- END;
-
- WriteLn; { Ergebnisse ausgeben }
- WriteLn(#196#196#196#196#196#196+
- ' VERZEICHNISANALYSE '+
- #196#196#196#196#196#196);
- WriteLn('Belegte Cluster :':21, ClusTotal:11);
- WriteLn('davon benötigt :':21, ClusNeeded:11);
- WriteLn('Anzahl Verzeichnisse :':21, Dirs:11);
- WriteLn('davon fragmentiert :':21, FragDirs:11);
- WriteLn('Anzahl Dateien :':21, Files:11);
- WriteLn('davon fragmentiert :':21, FragFiles:11);
- WriteLn('Freie Einträge :':21, FreeEntries:11);
- WriteLn('davon gelöscht :':21, Erased:11);
- WriteLn('davon unbenutzt :':21, Unused:11);
- WriteLn;
- END;
- END; { Optimizer.Analyze }
-
- PROCEDURE Optimizer.Optimize;
- { Führt für das per SetDir übergebene Verzeichnis eine }
- { Zugriffsoptimierung durch, indem alle }
- { Unterverzeichniseinträge an den Anfang des }
- { Verzeichnisses kopiert und gelöschte Einträge }
- { entfernt werden. Ggf. werden auch unnötig belegte }
- { Cluster freigegeben. }
- CONST
- DontTouch = Hidden OR SysFile OR VolumeID;
- { versteckte und Systemdateien sowie Volume-Labels }
- { sind von der Optimierung ausgenommen }
- VAR
- SecPtr : pDirSector;
- DirPtr : pDirEntry;
- Entry1,
- Entry2 : DirEntry;
- Index,
- Index1,
- Index2 : LONGINT;
- ClusterNr,
- NextCluster,
- Count : WORD;
- Gefunden : BOOLEAN;
- BEGIN
- DiskError := dskOk;
- IF TotalEntries = -1 THEN Analyze;
- WriteLn('Verzeichnis wird optimiert ...');
- CriticalPhase := TRUE;
- DirPtr := FM^.GetFirstEntry(DirName);
- WHILE (DiskError = dskOk) AND
- (DirPtr^.Attribute AND Directory = 0) DO
- DirPtr := FM^.GetNextEntry;
- ClusterNr := DirPtr^.FirstCluster;
- IF DiskError = dskOk THEN
- FM^.Load(0); { Verzeichnis in Puffer einlesen }
- { Stufe 1: alle Unterverzeichniseinträge an }
- { den Anfang des Verzeichnisses kopieren }
- Index1 := 0;
- Index2 := 0;
- Gefunden := TRUE;
- WHILE (DiskError = dskOk) AND Gefunden DO BEGIN
- Gefunden := FALSE;
- WHILE (DiskError = dskOk) AND (Index1 < TotalEntries)
- AND NOT Gefunden DO BEGIN
- SecPtr := pDirSector(FM^.GetFileSector(Index1 DIV
- DirEntriesPerSector));
- DirPtr := @SecPtr^[Index1 MOD DirEntriesPerSector];
- Gefunden := (DirPtr^.Attribute AND
- (DontTouch OR Directory) = 0) OR
- (DirPtr^.Name[1] = #0) OR
- (DirPtr^.Name[1] = #$E5);
- INC(Index1);
- END;
- IF (DiskError = dskOk) AND Gefunden THEN BEGIN
- Entry1 := DirPtr^;
- IF Index2 < Index1 THEN Index2 := Index1;
- Gefunden := FALSE;
- WHILE (DiskError = dskOk) AND
- (Index2 < TotalEntries) AND
- NOT Gefunden DO BEGIN
- SecPtr:= pDirSector(FM^.GetFileSector(Index2 DIV
- DirEntriesPerSector));
- DirPtr:= @SecPtr^[Index2 MOD DirEntriesPerSector];
- Gefunden := (DirPtr^.Attribute AND
- (DontTouch OR Directory) = Directory)
- AND (DirPtr^.Name[1] <> #0) AND
- (DirPtr^.Name[1] <> #$E5);
- INC(Index2);
- END;
- IF (DiskError = dskOk) AND Gefunden THEN BEGIN
- { Einträge vertauschen }
- Entry2 := DirPtr^;
- DirPtr^ := Entry1;
- SecPtr := pDirSector
- (FM^.GetFileSector(Pred(Index1) DIV
- DirEntriesPerSector));
- IF DiskError = dskOk THEN
- SecPtr^[PRED(Index1) MOD
- DirEntriesPerSector] := Entry2;
- END;
- END;
- END;
- { Stufe 2: Dateieinträge in }
- { lückenlose Reihenfolge bringen }
- Index1 := 0;
- Index2 := 0;
- Gefunden := TRUE;
- WHILE (DiskError = dskOk) AND Gefunden DO BEGIN
- Gefunden := FALSE;
- WHILE (DiskError = dskOk) AND
- (Index1 < TotalEntries) AND
- NOT Gefunden DO BEGIN
- SecPtr := pDirSector
- (FM^.GetFileSector(Index1 DIV
- DirEntriesPerSector));
- DirPtr := @SecPtr^[Index1 MOD DirEntriesPerSector];
- Gefunden := (DirPtr^.Name[1] = #0) OR
- (DirPtr^.Name[1] = #$E5);
- INC(Index1);
- END;
- IF (DiskError = dskOk) AND Gefunden THEN BEGIN
- Entry1 := DirPtr^;
- IF Index2 < Index1 THEN
- Index2 := Index1;
- Gefunden := FALSE;
- WHILE (DiskError = dskOk) AND
- (Index2 < TotalEntries) AND
- NOT Gefunden DO BEGIN
- SecPtr := PDirSector(FM^.GetFileSector(Index2 DIV
- DirEntriesPerSector));
- DirPtr:= @SecPtr^[Index2 MOD DirEntriesPerSector];
- Gefunden := (DirPtr^.Attribute AND
- (DontTouch OR Directory) = 0) AND
- (DirPtr^.Name[1] <> #0) AND
- (DirPtr^.Name[1] <> #$E5);
- INC(Index2);
- END;
- IF (DiskError = dskOk) AND Gefunden THEN BEGIN
- { Einträge vertauschen }
- Entry2 := DirPtr^;
- DirPtr^ := Entry1;
- SecPtr := pDirSector
- (FM^.GetFileSector(Pred(Index1) DIV
- DirEntriesPerSector));
- IF DiskError = dskOk THEN
- SecPtr^[Pred(Index1) MOD
- DirEntriesPerSector] := Entry2;
- END;
- END;
- END;
- { Stufe 3: gelöschte Einträge rauswerfen }
- Index := 0;
- WHILE (DiskError = dskOk) AND
- (Index < TotalEntries) DO BEGIN
- SecPtr := PDirSector(FM^.GetFileSector(Index DIV
- DirEntriesPerSector));
- DirPtr := @SecPtr^[Index MOD DirEntriesPerSector];
- IF (DiskError = dskOk) AND
- (DirPtr^.Name[1] = #$E5) THEN
- DirPtr^.Name[1] := #0;
- INC(Index);
- END;
- { Verzeichnis auf Datenträger }
- { schreiben und Puffer freigeben }
- FM^.Unload;
- IF (DiskError = dskOk) AND
- (ClusNeeded < ClusTotal) THEN BEGIN
- { Stufe 4: nicht benötigte Cluster freigeben }
- NextCluster := ClusterNr;
- Count := 1;
- WHILE (DiskError = dskOk) AND
- (Count <= ClusNeeded) DO BEGIN
- { letzten benötigten Cluster suchen }
- ClusterNr := NextCluster;
- NextCluster := GetFatEntry(ClusterNr);
- INC(Count);
- END;
- IF DiskError = dskOk THEN
- PutFatEntry(ClusterNr, $FFFF);
- { Code für "letzter Cluster der Datei" eintragen }
- WHILE (DiskError = dskOk) AND
- (Count <= ClusTotal) DO BEGIN
- { restliche Cluster freigeben }
- ClusterNr := NextCluster;
- NextCluster := GetFatEntry(ClusterNr);
- IF DiskError = dskOk THEN
- PutFatEntry(ClusterNr, 0);
- { Code für "Cluster ist frei" eintragen }
- INC(Count);
- END;
- IF DiskError = dskOk THEN
- WriteFat; { geänderte FAT auf Disk schreiben }
- END;
- CriticalPhase := FALSE;
- IF DiskError = dskOk THEN
- WriteLn('* Optimierung abgeschlossen *');
- END; { Optimizer.Optimize }
-
- PROCEDURE Hilfe;
- { Hilfestellung ausgeben }
- BEGIN
- WriteLn('Dieses Programm analysiert '+
- 'ein (Unter-)Verzeichnis');
- WriteLn('und führt auf Wunsch eine '+
- 'Zugriffsoptimierung durch.');
- WriteLn;
- Writeln('Aufruf: DIROPT Verzeichnisname');
- END; { Hilfe }
-
- PROCEDURE Abbruch;
- { Fehlermeldung ausgeben und Programm mit Exit-Code }
- { beenden }
- BEGIN
- IF DiskError = dskOk THEN
- DiskError := 255;
- IF DiskError < 256 THEN BEGIN
- CASE DiskError OF
- dskPathNotFound, dskNoMoreFiles :
- WriteLn('Verzeichnis nicht gefunden');
- dskNoMemory :
- WriteLn('Nicht genug Hauptspeicher');
- ELSE
- WriteLn('Programm abgebrochen');
- END;
- Halt(DiskError);
- END ELSE BEGIN
- WriteLn('Programm abgebrochen');
- Halt(Hi(DiskError));
- END;
- END; { Abbruch }
-
- {$F+}
- FUNCTION HeapFunc(Size : WORD) : INTEGER;
- {$F-}
- { verhindert Programmabbruch bei Heap-Fehlern }
- BEGIN
- HeapFunc := 1;
- END; { HeapFunc }
-
- VAR
- Opt : ^Optimizer;
- Verzeichnis : PathStr;
- Taste : CHAR;
- BEGIN
- WriteLn('DIRECTORY OPTIMIZER V1,0 ***** '+
- '(c) 1991 Gerd Cebulla & DMV-Verlag');
- WriteLn;
- IF (ParamCount <> 1) OR (ParamStr(1) = '?') THEN BEGIN
- Hilfe;
- Halt(1);
- END;
- { eigene Fehlerroutine für Heapverwaltung installieren }
- HeapError := @HeapFunc;
- { Verzeichnisnamen in Großbuchstaben umwandeln }
- { und um vollständigen Suchpfad erweitern }
- Verzeichnis := FExpand(ParamStr(1));
- WriteLn(Verzeichnis);
- WriteLn;
- { Optimizer initialisieren }
- NEW(Opt, Init(Verzeichnis[1]));
- IF Opt = NIL THEN Abbruch;
- { nicht genug Heap oder Disk-Fehler }
- Opt^.SetDir(Verzeichnis); { Verzeichnis anmelden }
- Opt^.Analyze; { Verzeichnis analysieren }
- IF DiskError <> dskOk THEN BEGIN
- Dispose(Opt, Done);
- Abbruch;
- END;
- Write('Verzeichnis optimieren [J/N]? ');
- Taste := ReadKey;
- WriteLn(Taste);
- IF UpCase(Taste) = 'J' THEN BEGIN
- Opt^.Optimize;
- IF DiskError = dskOk THEN Opt^.Analyze;
- END;
- Dispose(Opt, Done);
- IF DiskError <> dskOk THEN Abbruch;
- END.
- (* ------------------------------------------------------ *)
- (* Ende von DIROPT.PAS *)
-