Turbo Toolbox/Turbo_Toolbox.iso/1989/11/praxis/search.pas

Pascal/Delphi Source File | 1989-02-21 | 12.2 KB | 399 lines

(* ------------------------------------------------------ *)
(*                    SEARCH.PAS                          *)
(* Dateisuche nach Suffix, Attributen, Größe, Datum, Zeit *)
(*     (c) 1989   TOOLBOX  &  Karsten Gieselmann          *)
(* ------------------------------------------------------ *)
{$R-,S-,I-,V-,B-,N-}    (* größtmögliche Geschwindigkeit! *)
{$M 16384, 0, 0}

PROGRAM Search;

USES
  Dos;                                 (* benötigte Units *)

VAR
  Dir,                    (* Name des Startverzeichnisses *)
  FileMask         : STRING;   (* zu suchende Dateigruppe *)
  AttrMask         : WORD;             (* Attributvorgabe *)
  EntriesFound,          (* Anzahl der gefundenen Dateien *)
  MinSize,MaxSize,                 (* Dateigrößen-Bereich *)
  MinTime,MaxTime  : LONGINT;      (* Datum-/Zeit-Bereich *)
  FullDisplay      : BOOLEAN;
                     (* Anzeige: nur Dateiname oder mehr? *)

(*  gibt einen Dateieintrag auf die Standardausgabe aus   *)

PROCEDURE DisplayEntry(Path : STRING; Entry : SearchRec);
VAR
  DT : DateTime;
  k  : BYTE;

  FUNCTION Str(Value : LONGINT; Len : BYTE;
               FillZeroes : Boolean) : STRING;
    (* verwandelt eine Zahl in eine Zeichenkette und füllt
       die restlichen Positionen mit Leerzeichen bzw. mit
       Nullen (FillZeroes=TRUE) aus. *)
  VAR
    V : STRING;
    k : BYTE;
  BEGIN
    System.Str(Value:Len, V);
    If FillZeroes THEN
      FOR k:=1 TO Len DO
        IF V[k]=' ' THEN V[k] := '0';
    Str := V;
  END;

BEGIN
  Inc(EntriesFound);
  WITH Entry DO
    IF FullDisplay THEN BEGIN
      k := 1;
      WHILE (k <= Length(Name)) AND
            (Name[k] <> '.') DO BEGIN
        Write(Name[k]);
        Inc(k);
      END;
      IF Name[k] = '.' THEN
        Write('':10-k, Copy(Name, k+1, 3),
              '':k+3-Length(Name))
      ELSE
        Write('':13-k);
      UnPackTime(Time, DT); Dec(DT.Year, 1900);
      WITH DT DO
        WriteLn(Size:9, '':2,
                Str(Day,  2, FALSE), '.',
                Str(Month,2,  TRUE), '.',
                Str(Year, 2,  TRUE), '  ',
                Str(Hour, 2, FALSE), ':',
                Str(Min,  2,  TRUE))
    END ELSE
      WriteLn(Path, Name);
  END;


(* Absuchen von "Path" und aller zugehörigen
                                      Unterverzeichnisse  *)
PROCEDURE ScanDir(Path : STRING);
VAR
  Entry : SearchRec;
BEGIN
  WITH Entry DO BEGIN
    FindFirst(Path+FileMask, $27 OR AttrMask, Entry);
    WHILE DosError = 0 DO BEGIN
      IF Attr AND AttrMask = AttrMask THEN
        IF (MinSize <= Size) AND (Size <= MaxSize) THEN
          IF (MinTime <= Time) AND (Time <= MaxTime) THEN
            IF (Name[1] <> '.') THEN
              DisplayEntry(Path, Entry);
      FindNext(Entry);
    END;
    FindFirst(Path+'*.*', Directory, Entry);
    WHILE DosError = 0 DO BEGIN
      IF Attr AND Directory = Directory THEN
        IF (Name[1] <> '.') THEN
                               (* '.' und '..' ignorieren *)
          ScanDir(Path+Name+'\');
                              (* Bearbeitung der Einträge *)
      FindNext(Entry);
    END;
  END;
END;

(* ----- Auslesen und Auswerten der Kommandozeile ------- *)

PROCEDURE ParseArguments;

CONST
  AttrError     = 'Unbekanntes Attribut in Parameterliste';
  SizeError     = 'Ungültige Dateigrößenangabe';
  DateTimeError = 'Ungültige Datum-Zeit-Angabe';
  PeriodError   = 'Ungültige Zeitspannen-Angabe';

VAR
  s,ErrorMessage,
  Lower,Upper    : STRING;
  Params         : ^STRING;
  k              : BYTE;

  PROCEDURE ErrorHalt;
    (* Ausgabe einer Fehlermeldung und Programmabbruch *)
  BEGIN
    WriteLn(ErrorMessage); Halt;
  END;

  FUNCTION Stripped(S : STRING) : STRING;
    (* entfernt führende und folgende Leerzeichen *)
  VAR
    a,b : BYTE;
  BEGIN
    a := 1;  b := Length(S);
    WHILE (a <= b) AND (S[a] = ' ') DO Inc(a);
    WHILE (b >= 1) AND (S[b] = ' ') DO Dec(b);
    Stripped := Copy(S, a, b-a+1);
  END;

  FUNCTION Argument(Switch : CHAR) : STRING;
    (* liefert den Argumentstring zu "Switch" *)
  VAR
    a,b : BYTE;
  BEGIN
    a := Pos('/'+Switch, Params^);
    IF a > 0 THEN BEGIN
      b := a + 2;
      WHILE (b <= Length(Params^)) AND
            (Params^[b] <> '/') DO Inc(b);
      Argument := Stripped(Copy(Params^, a+2, b-(a+2)));
    END ELSE
      Argument := '';
  END;

  FUNCTION ParseAttributes : WORD;
    (* Besetzung der Attributmaske gemäß
                                  Kommandozeilenparameter *)
  CONST
    Attributes : ARRAY[1..6] OF CHAR = 'RHSVDA';
  VAR
    k,m,p : BYTE;
    a     : STRING;
  BEGIN
    m := $00;
    a := Argument('A');
    IF a <> '' THEN
      FOR k := 1 TO Length(a) DO BEGIN
        p := Pos(a[k], Attributes);
        IF p > 0 THEN
          m := m OR (1 SHL (p-1))
        ELSE
          ErrorHalt;
      END;
    ParseAttributes := m;
  END;

  PROCEDURE ParseRange(Range : STRING;
                       VAR Left, Right : STRING);
    (* zerlegt eine Bereichsangabe "aa,bb" in oberen
                                         und unteren Teil *)
  VAR
    p : BYTE;
  BEGIN
    p := Pos(',', Range);
    IF p > 0 THEN BEGIN           (* echte Bereichsangabe *)
      Left := Stripped(Copy(Range, 1, p-1));
      Right := Stripped(Copy(Range, p+1, 255));
    END ELSE BEGIN       (* nur ein Wert, Left=Right=Wert *)
      Left := Range;
      Right := Left;
    END;
  END;

  FUNCTION ParseSize(Size : STRING;
                     DefSize : LONGINT) : LONGINT;
    (* liefert LONGINT-Zahl;
              wenn Size leer ist, wird DefSize angenommen *)
  VAR
    Value  : LONGINT;
    Result : INTEGER;
  BEGIN
    IF Size <> '' THEN BEGIN
      Val(Size, Value, Result);
      IF Result <> 0 THEN
        ErrorHalt;
      ParseSize := Value;
    END ELSE
      ParseSize := DefSize;
  END;

  PROCEDURE ParseNumber(VAR s : STRING; Seperator : CHAR;
                                        VAR Number : WORD);
   (* wandelt den Teilstring von s bis zum ersten Auftreten
      von Seperator in eine ganze Zahl um; bei Mißerfolg
      erfolgt Fehlermeldung/Abbruch. *)
  VAR
    p      : BYTE;
    Result : INTEGER;
    SubStr : STRING;
  BEGIN
    IF Seperator = ' ' THEN
      SubStr := s
    ELSE BEGIN
      p := Pos(Seperator, s);
      IF p = 0 THEN
        Exit;
      SubStr := Copy(s, 1, p-1);
      Delete(s, 1, p);
    END;
    IF SubStr <> '' THEN BEGIN
      Val(SubStr, Number, Result);
      IF Result <> 0 THEN
        ErrorHalt;
    END;
  END;

  FUNCTION ParseDateTime(DateTimeStr : STRING;
                          UpperBound : BOOLEAN) : LONGINT;
   (* konvertiert eine als Zeichenkette vorliegenden
      Datum-/Zeitangabe "DD.MM.YY HH:MM" in das von DOS
      benutzte gepackte Format (LONGINT); je nachdem, ob es
      sich bei der Zeitangabe um die obere oder untere
      Begrenzung eines Abschnitts handelt, werden anstelle
      fehlender Angaben gewisse Standardeinstellungen
      angenommen.                    *)
  VAR
    DT        : DateTime;
    b,d,t     : BYTE;
    Dummy     : WORD;
    p         : LONGINT;
    Date,Time : STRING;
  BEGIN
    d := Pos('.', DateTimeStr);
    t := Pos(':', DateTimeStr);
    WITH DT DO BEGIN                  (* Voreinstellungen *)
      IF UpperBound THEN BEGIN
        Sec := 59;
        GetDate(Year, Month, Day, Dummy);
        IF d > 0 THEN BEGIN
          Hour := 23; Min := 59;
        END ELSE
          GetTime(Hour, Min, Dummy, Dummy);
      END ELSE BEGIN
        IF t > 0 THEN
          GetDate(Year, Month, Day, Dummy)
        ELSE BEGIN
          Year := 1980; Month := 1; Day := 1;
        END;
        Hour := 0; Min := 0; Sec := 0;
      END;
      IF d > 0 THEN
        GetDate(Year, Dummy, Dummy, Dummy);
      b := Pos(' ', DateTimeStr);
      IF b > 0 THEN BEGIN
        Date := Stripped(Copy(DateTimeStr, 1, b-1));
        Time := Stripped(Copy(DateTimeStr, b+1, 255));
      END ELSE
        IF d > 0 THEN BEGIN
          Date := DateTimeStr;
          Time := '';
        END ELSE BEGIN
          Date := '';
          Time := DateTimeStr;
        END;
      ParseNumber(Date, '.', Day);
      ParseNumber(Date, '.', Month);
      ParseNumber(Date, ' ', Year);
      IF (80 <= Year) AND (Year <= 99) THEN Inc(Year, 1900);
      ParseNumber(Time, ':', Hour);
      ParseNumber(Time, ' ', Min);
      IF (Min > 60) OR (Hour > 24) OR (Day > 31)
                                   OR (Month > 12) THEN
        ErrorHalt;
    END;
    PackTime(DT, p);
    ParseDateTime := p;
  END;

  FUNCTION SubtractPeriod(Period : STRING) : LONGINT;
   (* subtrahiert die durch "Period" gegebene Zeitspanne
      HH:MM von der aktuellen Uhrzeit und liefert den
      entsprechenden gepackten Wert. Um das Problem der
      Zeitrückrechnung (extremes Beispiel: 01.01.89,
      00:05 minus 10 Minuten) nicht zu sehr in den
      Vordergrund treten zu lassen, werden nur Tageswechsel
      berücksichtigt.                      *)
  VAR
    DT               : DateTime;
    Hour,Min,Dummy   : WORD;
    cYear,cMonth,
    cDay, cHour,cMin : INTEGER;
    p                : LONGINT;
  BEGIN
    ParseNumber(Period, ':', Hour);
    ParseNumber(Period, ' ', Min);
    IF Hour*60+Min > 1440 THEN ErrorHalt;
    GetDate(WORD(cYear), WORD(cMonth), WORD(cDay), Dummy);
    GetTime(WORD(cHour), WORD(cMin), Dummy, Dummy);
    Dec(cMin, Min);
    IF cMin < 0 THEN BEGIN
      Inc(cMin, 60); Dec(cHour);
    END;
    Dec(cHour, Hour);
    IF cHour < 0 THEN BEGIN
      Inc(cHour, 24); Dec(cDay);
    END;
    WITH DT DO BEGIN
      Year := cYear; Month := cMonth; Day := cDay;
      Hour := cHour; Min := cMin; Sec := 59;
      PackTime(DT, p);
    END;
    SubtractPeriod := p;
  END;

BEGIN
  IF (ParamCount = 0) OR (ParamStr(1)='?') THEN BEGIN
                                    (* Hilfetext ausgeben *)
    WriteLn(^M^J,
      'SEARCH v1.0'^M^J^M^J,
      'Syntax:   SEARCH  Suchmaske  [Optionen]  [>Output]',
      ^M^J^M^J,'Optionen:'^M^J,
      '  /F(ull display)  zusätzliche Anzeige von Größe, ',
      'Datum und Zeit'^M^J,
      '  /C(urrent dir)   beginnt die Suche im aktuellen ',
      'Verzeichnis'^M^J,
      '  /A(ttr mask)     Attribut-Liste (ADHRS)'^M^J,
      '  /S(ize mask)     nnn,mmm'^M^J,
      '  /P(eriod mask)   HH:MM'^M^J,
      '  /T(ime mask)     DD.MM.YY HH:MM, DD.MM.YY HH:MM');
    Halt;
  END;
  Params := Ptr(PrefixSeg, $80);
                              (* Zeiger auf Kommandozeile *)
  FOR k:=1 TO Length(Params^) DO
    Params^[k] := UpCase(Params^[k]);
  IF Copy(ParamStr(1), 1, 1) = '/' THEN
    FileMask := '*.*'    (* keine Angabe: alle Dateinamen *)
  ELSE
    FileMask := ParamStr(1);                (* Dateimaske *)
  ErrorMessage := AttrError;
  AttrMask := ParseAttributes;
  FullDisplay := Pos('/F', Params^) > 0;
                                       (* Art der Ausgabe *)
  IF Pos('/C', Params^) > 0 THEN
    GetDir(0, Dir)
              (* Durchsuchen ab dem aktuellem Verzeichnis *)
  ELSE
    Dir := '';
           (* Durchsuchen aller vorhandenen Verzeichnisse *)
  s := Argument('S');                (* Dateigrößen-Maske *)
  ErrorMessage := SizeError;
  ParseRange(s, Lower, Upper);
  MinSize := ParseSize(Lower, 0);
  MaxSize := ParseSize(Upper, $7FFFFFFF);
  s := Argument('P');                 (* Datum-Zeit-Maske *)
  IF s <> '' THEN BEGIN        (* relative Bereichsangabe *)
    ErrorMessage := PeriodError;
    MinTime := SubtractPeriod(s);
    MaxTime := ParseDateTime('', TRUE);
  END ELSE BEGIN               (* absolute Bereichsangabe *)
    s := Argument('T');
    ErrorMessage := DateTimeError;
    ParseRange(s, Lower, Upper);
    MinTime := ParseDateTime(Lower, FALSE);
    MaxTime := ParseDateTime(Upper, TRUE);
  END;
END;

BEGIN                                    (* Hauptprogramm *)
  ParseArguments;
  EntriesFound := 0;
  ScanDir(Dir+'\');
  IF FullDisplay THEN BEGIN
    WriteLn;
    IF EntriesFound = 0 THEN
      Write('Keine')
    ELSE
      Write(EntriesFound);
    WriteLn(' Einträge gefunden.');
  END;
END.
(* ------------------------------------------------------ *)
(*                 Ende von SEARCH.PAS                    *)