home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / praxis / gf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-22  |  9.7 KB  |  307 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       GF.PAS                           *)
  3. (*       (c) 1989  Thomas Kellerer  &  TOOLBOX            *)
  4. PROGRAM GlobalFind;
  5.  
  6. USES Dos, Crt;
  7.  
  8. VAR DirEintrag   : SearchRec;
  9.  
  10.     OldExit      : POINTER;
  11.     StartDir,
  12.     AktDir,
  13.     ZielDir,
  14.     Such,
  15.     Pfad, Test   : String;
  16.     FName        : String;
  17.     Anzahl       : WORD;
  18.     OK,Loesch,
  19.     Ask,SubDir,
  20.     Size,Remove  : Boolean;
  21.     Par          : BYTE;
  22.     FSize,FSlack : LONGINT;
  23.     CLSize       : WORD;
  24.  
  25. {$F+}
  26. PROCEDURE Exit;
  27. BEGIN
  28.   IF AktDir <> '' THEN  ChDir(AktDir);
  29.   ChDir(StartDir);         (* Zum Startverzeichnis zurück *)
  30.   ExitProc := OldExit;
  31. END;
  32. {$f-}
  33.  
  34. PROCEDURE DeleteFile(Name : String);
  35.             (* Löscht eine Datei auf Diskette/Platte      *)
  36.             (* Schneller als Turbo's Assign/Erase Gespann *)
  37. VAR regs : Registers;
  38.  
  39. BEGIN
  40.   Name := Name + Chr(0);         (* 0 als Stringabschluss *)
  41.   regs.ax := $4100;
  42.   regs.ds := Seg(Name);
  43.   regs.dx := Ofs(Name) + 1;      (* Längenbyte übergehen  *)
  44.   MsDos(regs);
  45. END;
  46.  
  47. FUNCTION HoleCLSize : WORD;
  48.             (* Hole Cluster-Size. Gibt die Anzahl der     *)
  49.             (* Sektoren pro Cluster zurück. Wird benötigt *)
  50.             (* um den Physikalischen Platz auf der Platte *)
  51.             (* zu berechnen                               *)
  52. VAR regs : Registers;
  53. BEGIN
  54.   regs.ax := $1c00;        (* Information über beliebiges *)
  55.                            (* Laufwerk holen              *)
  56.   regs.dl := $0;           (* 0 = aktuelles Laufwerk      *)
  57.   MsDos(regs);
  58.   HoleClSize := regs.al * regs.cx;
  59. END;
  60.  
  61. FUNCTION HoleJN(Text : String) : CHAR;
  62. VAR ch : CHAR;
  63. BEGIN
  64.   Write(Text,' (J/N)');
  65.   REPEAT
  66.     ch := UpCase(ReadKey);
  67.   UNTIL (ch = 'J') OR (ch = 'N');
  68.   HoleJN := ch;
  69. END;
  70.  
  71. PROCEDURE WriteDateTime(Datum : DateTime);
  72. (* Schreibt Zeit/Datum formatiert als 01.01.1989 12:10    *)
  73.  
  74.   PROCEDURE Put(i : WORD);
  75.   BEGIN
  76.     IF i < 10 THEN Write('0', i)
  77.               ELSE Write(i);
  78.   END;
  79.  
  80. BEGIN
  81.   Put(Datum.Day);   Write('.');
  82.   Put(Datum.Month); Write('.');
  83.   Put(Datum.Year);  Write('   ');
  84.   Put(Datum.Hour);  Write(':');
  85.   Put(Datum.Min);
  86. END;
  87.  
  88. PROCEDURE WriteF(s : String);
  89. (* Gibt Zeichenkette linksbündig auf 14 Zeichen Länge aus *)
  90. BEGIN
  91.   REPEAT
  92.     s := s + ' ';
  93.   UNTIL Length(s) = 14;
  94.   Write(s);
  95. END;
  96.  
  97. PROCEDURE TrenneName(angabe : String; VAR pfad : String;
  98.                                       VAR name : String);
  99.                      (* Trennt einen übergebenen Namen in *)
  100.                      (* Pfad und Dateinamen auf           *)
  101. VAR k, len : BYTE;
  102. BEGIN
  103.   k := Length(angabe);
  104.   WHILE (angabe[k] <> '\') AND (angabe[k] <> ':')
  105.                            AND (k <> 0) DO BEGIN
  106.     Dec(k);
  107.   END;
  108.   IF k = 0 THEN Pfad := ''
  109.            ELSE Pfad := Copy(angabe, 1, k-1);
  110.   IF angabe[k] = ':' THEN Pfad := Pfad + ':';
  111.   IF (angabe[k] = '\') AND (Length(Pfad) = 2)
  112.                        AND (Pfad[2] = ':') THEN
  113.     pfad := pfad + '\';
  114.   Name := Copy(angabe, k+1, len-k);
  115.   IF (Name = '') AND (Pfad <> '') THEN Name := '*.*';
  116. END;
  117.  
  118. PROCEDURE ToUpper(VAR arg : String);
  119.                         (* 'UpCase' für eine Zeichenkette *)
  120. VAR k : Integer;
  121. BEGIN
  122.    FOR k := 1 TO Length(arg) DO arg[k] := UpCase(arg[k]);
  123. END;
  124.  
  125. PROCEDURE LoescheDateien(Name : String; VAR zahl : WORD;
  126.                          VAR Groesse, Slack : LONGINT);
  127.      (* Zeigt alle Dateien mit der Bezeichnung Name im    *)
  128.      (* aktuellen Directory an. Falls sie gelöscht werden *)
  129.      (* sollen, wird dies auch getan.                     *)
  130. VAR lauf    : WORD;
  131.     datei   : FILE;
  132.     DirInfo : SearchRec;
  133.     AktDir  : String;
  134.     Del     : BOOLEAN;
  135.     FDatum  : DateTime;
  136.     y       : Byte;
  137.     h       : LongInt;
  138.     DelName : String;
  139.  
  140. BEGIN
  141.   GetDir(0, AktDir);
  142.   FindFirst(Name, 7, DirInfo);
  143.   IF DOSError = 0 THEN WriteLn(#13,#10,AktDir);
  144.   WHILE (DOSError=0) DO BEGIN
  145.     IF Loesch THEN BEGIN
  146.       IF Ask THEN BEGIN
  147.         Write(DirInfo.Name);
  148.         Del := (HoleJN('  Löschen?') = 'J');
  149.         DelLine; Write(#13);
  150.       END ELSE
  151.         Del := TRUE;
  152.       IF Del THEN BEGIN
  153.         DeleteFile(DirInfo.Name);
  154.         Inc(Zahl);
  155.       END;
  156.     END;
  157.     Write('   ');
  158.     WriteF(DirInfo.Name);
  159.     IF Del AND Loesch THEN
  160.       WriteLn('  Gelöscht...')
  161.     ELSE BEGIN
  162.       UnpackTime(DirInfo.Time, FDatum);
  163.       Write('  ');
  164.       WriteDateTime(FDatum);
  165.       WriteLn(DirInfo.Size:8, ' Bytes');
  166.       Groesse := Groesse + DirInfo.Size;
  167.       h := DirInfo.Size DIV CLSize;
  168.       IF h * CLSize = DirInfo.Size THEN
  169.         slack := slack + h * CLSize
  170.       ELSE
  171.         slack := slack + (h + 1) * CLSize;
  172.     END;
  173.     IF NOT Loesch THEN Inc(Zahl);
  174.     FindNext(DirInfo);
  175.   END;
  176. END;
  177.  
  178. PROCEDURE BearbeiteDir(Datei : String; VAR Zahl : WORD;
  179.                        VAR gr, sl : LONGINT);
  180. (* Durchsucht das aktuelle Directory nach Sub-Directories *)
  181. VAR DirInfo : SearchRec;
  182. BEGIN
  183.    LoescheDateien(Datei, Zahl, gr, sl);
  184.                          (* Alle Dateien anzeigen/Löschen *)
  185.    FindFirst('*.*', Directory, DirInfo);    (* SubDir ??? *)
  186.  
  187.    WITH DirInfo DO
  188.      WHILE DOSError = 0 DO BEGIN
  189.        IF (Attr = Directory) AND (Name[1] <> '.') THEN BEGIN
  190.        (* Falls es das Attribut 'Directory' hat und nicht *)
  191.        (* 'nach oben zeigt' so wird gewechselt. Die       *)
  192.        (* Funktion FindFirst liefert nämlich das '.' und  *)
  193.        (* '..' am Anfang eines Unterverzeichnisses auch   *)
  194.        (* zurück...                                       *)
  195.           ChDir(DirInfo.Name);       (* SubDir bearbeiten *)
  196.           BearbeiteDir(Datei,Zahl,gr,sl);    (* Rekursion *)
  197.           ChDir('..');          (* Und zurück zum Ausgang *)
  198.           IF Remove THEN BEGIN
  199.                 (* Soll das Directory gelöschte werden ?? *)
  200. {$I-}
  201.             RmDir(DirInfo.Name);
  202. {$I+}
  203.             IF IOResult <> 0 THEN
  204.               WriteLn('Directory ', DirInfo.Name,
  205.                       'nicht leer. Nicht gelöscht')
  206.             ELSE
  207.               WriteLn('Directory ', DirInfo.Name,
  208.                       ' gelöscht');
  209.          END;
  210.        END;
  211.        FindNext(DirInfo);        (* Weitersuchen bis Ende *)
  212.      END;
  213. END;
  214.  
  215. BEGIN
  216.   OldExit := ExitProc;
  217.           (* Exit Pointer verbiegen, damit bei Ctrl&Break *)
  218.   ExitProc := @Exit;
  219.       (* wieder das ursprüngliche Verzeichnis eingestellt *)
  220.   FSize := 0; FSlack := 0;                        (* wird *)
  221.   GetDir(0, StartDir);
  222.                 (* Aktuelles Verzeichnis holen und merken *)
  223.   CheckBreak := TRUE;
  224.  
  225.   (* Falls eine Umleitung auf Dos-Ebene mit '>' gewünscht *)
  226.   (* ist z.B.: gf *.* > prn, so müssen die Standard-      *)
  227.   (* Ein/Ausgaberoutinen von DOS verwendet werden. Dabei  *)
  228.   (* ist dann aber ein Abbruch mit CTRL & BREAK nicht     *)
  229.   (* mehr möglich.                                        *)
  230.   (*   Assign(Input, '');  Reset(Input);     *)
  231.   (*   Assign(Output, ''); Rewrite(Output);  *)
  232.   (*   DirectVideo := FALSE;                 *)
  233.  
  234.   IF (ParamCount = 0) OR (ParamStr(1) = '?') THEN BEGIN
  235.                                         (* Hilfe Ausgeben *)
  236.     WriteLn('Gebrauch:  gf name [/d] [/s] [/f] [/n] [/r]');
  237.     WriteLn;
  238.     WriteLn('/d   Löschen der gefunden Dateien');
  239.     WriteLn('/f   Löschen ohne zu fragen');
  240.     WriteLn('/s   Gesamtgröße der Dateien');
  241.     WriteLn('/n   Sub-Directories NICHT durchsuchen');
  242.     WriteLn('/r   Sub-Directiores löschen');
  243.     WriteLn;
  244.     WriteLn('Name : Beliebieger MS-DOS Datei-Name ',
  245.             '(mit Wildcard)');
  246.   END ELSE BEGIN
  247.          (* Parameter wurde übergeben also kanns losgehen *)
  248.     Such := ParamStr(1);                     (* Dateiname *)
  249.     TrenneName(Such, Pfad, FName);
  250.     AktDir := '';
  251.     IF Pfad <> '' THEN BEGIN
  252.            (* Soll in einem anderem Pfad gesucht werden ? *)
  253.       IF Pfad[1] <> StartDir[1] THEN  (* Laufwerkswechsel *)
  254.         GetDir(Ord(UpCase(Pfad[1])) - 64, AktDir);
  255. {$I-}
  256.         ChDir(Pfad);  (* versuche Verzeichnis zu wechseln *)
  257. {$I+}
  258.       END;
  259.       Anzahl := 0;
  260.       IF IOResult = 0 THEN BEGIN
  261.                  (* Verzeichniswechsel war erfolgreich... *)
  262.         CLSize := HoleCLSize;
  263.         Ask    := TRUE;          (* Standardeinstellungen *)
  264.         SubDir := TRUE;
  265.         Loesch := FALSE;
  266.         Size   := FALSE;
  267.         Remove := FALSE;
  268.         FOR Par := 2 TO ParamCount DO BEGIN
  269.                                     (* Schalter auswerten *)
  270.           Test := ParamStr(par);
  271.           IF (Test[1] = '\') OR (Test[1] = '/') THEN BEGIN
  272.             ToUpper(Test);
  273.             CASE Test[2] OF
  274.               'F' : Ask    := FALSE;
  275.               'S' : Size   := TRUE;
  276.               'D' : Loesch := TRUE;
  277.               'N' : SubDir := FALSE;
  278.               'R' : Remove := TRUE;
  279.             END;
  280.           END;
  281.         END;
  282.         IF SubDir THEN
  283.           BearbeiteDir(FName, Anzahl, FSize, FSlack)
  284.         ELSE      (* Nur aktuelles Verzeichnis bearbeiten *)
  285.           LoescheDateien(FName, Anzahl, FSize, FSlack);
  286.         IF AktDir <> '' THEN
  287.           ChDir(AktDir);
  288.         ChDir(StartDir);
  289.         IF Loesch THEN
  290.           WriteLn(Anzahl,' Datei(en) gelöscht')
  291.         ELSE BEGIN
  292.           WriteLn(Anzahl,' Datei(en) gefunden');
  293.         IF Size THEN BEGIN
  294.           Writeln('Gesamt:                    ',FSize:8,
  295.                   ' Bytes');
  296.           WriteLn('Tatsächlicher Platzbedarf: ',FSlack:8,
  297.                   ' Bytes');
  298.           WriteLn('Verschwendet:              ',
  299.                   FSlack-FSize:8,' Bytes');
  300.         END;
  301.       END;
  302.     END ELSE
  303.       WriteLn('Pfad nicht gefunden');
  304.   END;
  305. END.
  306. (* ------------------------------------------------------ *)
  307. (*                  Ende von GF.PAS                       *)