home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / tricks / savebak.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-07  |  3.9 KB  |  135 lines

  1. (* ------------------------------------------------------ *)
  2. (*                     SAVEBAK.PAS                        *)
  3. (* Alle Dateien mit der Endung .BAK werden in Dateien mit *)
  4. (* den fortlaufenden Endungen .001, .002 ... umbenannt.   *)
  5. (*             Compiler: Quick Pascal 1.0                 *)
  6. (*          (c) 1990 Andreas Timm & TOOLBOX               *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM SaveBak;
  9.  
  10. USES Dos;
  11.  
  12. VAR
  13.   BakDatei,
  14.   NoDatei        : SearchRec;
  15.   Datei          : Text;
  16.   NewName,
  17.   AktuellesLaufwerk,
  18.   Pfad           : STRING;
  19.   MaxNo,
  20.   NewNo          : INTEGER;
  21.  
  22.  
  23.   FUNCTION DateiName(VAR Datei : SearchRec) : NameStr;
  24.     { Ermittelt den Dateinamen OHNE Extension }
  25.   BEGIN
  26.     DateiName := Copy(Datei.Name, 1,
  27.                       Pos('.', Datei.Name) - 1);
  28.   END;
  29.  
  30.   FUNCTION Extension(VAR Datei : SearchRec) : ExtStr;
  31.     { Ermittelt die Extension ohne Punkt }
  32.   BEGIN
  33.     Extension := Copy(Datei.Name,
  34.                       Pos('.', Datei.Name) + 1, 3);
  35.   END;
  36.  
  37.   FUNCTION NumExtension(VAR Datei : SearchRec) : Integer;
  38.     { Ermittelt die Extension als Integer-Zahl         }
  39.     { Falls die Umwandlung erfolglos war (Buchstaben), }
  40.     { wird eine Null zurückgegeben                     }
  41.   VAR
  42.     Value, Code : INTEGER;
  43.   BEGIN
  44.     Val(Copy(Datei.Name, Pos('.', Datei.Name) + 1, 3),
  45.         Value, Code);
  46.     IF Code = 0 THEN
  47.       NumExtension := Value
  48.     ELSE
  49.       NumExtension := 0;
  50.   END;
  51.  
  52.   FUNCTION StrExtension(VAR NumExt : Integer) : ExtStr;
  53.     { Wandelt die Extension in einen String um  }
  54.     { Höchste Zahl ist 999                      }
  55.   VAR
  56.     NumStr : STRING;
  57.   BEGIN
  58.     Str(NumExt, NumStr);
  59.     CASE NumExt OF
  60.       1..9     : NumStr := '.00' + NumStr;
  61.       10..99   : NumStr := '.0'  + NumStr;
  62.       100..999 : NumStr := '.'   + NumStr;
  63.       1000     : NumStr := '.'   + '999';
  64.     END;
  65.     StrExtension := NumStr;
  66.   END;
  67.  
  68. BEGIN
  69.   WriteLn;
  70.   { Falls in der Kommandozeile ein Pfad eingegeben wurde, }
  71.   { hänge ein Backslash an                                }
  72.   IF ParamStr(1) <> '' THEN
  73.     Pfad := ParamStr(1) + '\'
  74.   ELSE
  75.     Pfad := '';
  76.  
  77.   { Suche nach der ersten Datei mit der Endung BAK         }
  78.  
  79.   FindFirst(Pfad + '*.bak', AnyFile, BakDatei);
  80.  
  81.   { Change Directory ins gewünschte Laufwerk               }
  82.  
  83.   IF ParamStr(1) <> '' THEN BEGIN
  84.     GetDir(0, AktuellesLaufwerk);
  85.     {$I-}
  86.     ChDir(ParamStr(1));
  87.     ChDir(AktuellesLaufwerk);
  88.     {$I+}
  89.   END;
  90.  
  91.   { Falls IOResult <> 0 ist, konnte nicht in den           }
  92.   { angegebenen Pfad verzweigt werden. Der Kommando-       }
  93.   { zeilenparameter war dann falsch.                       }
  94.  
  95.   IF (DosError = 0) AND (IOResult = 0) THEN BEGIN
  96.     REPEAT
  97.       MaxNo := 0;
  98.  
  99.       { Suche nach der ersten Datei mit dem Dateinamen     }
  100.       { einer gefundenen BAK - Datei                       }
  101.  
  102.       FindFirst(Pfad + DateiName(BakDatei) + '.*',
  103.                 AnyFile, NoDatei);
  104.       REPEAT
  105.     IF (NumExtension(NoDatei) >= 0) AND
  106.            (NumExtension(NoDatei) > MaxNo) THEN
  107.       MaxNo := NumExtension(NoDatei);
  108.     FindNext(NoDatei);
  109.       UNTIL DosError = 18;
  110.                { DosError = 18 bedeutet: nix mehr gefunden }
  111.  
  112.       NewNo := MaxNo + 1;
  113.  
  114.       { Bestimme den neuen Namen der BAK - Datei }
  115.  
  116.       NewName := DateiName(BakDatei) + StrExtension(NewNo);
  117.       Assign(Datei, Pfad + BakDatei.Name);
  118.       IF NewNo > 999 THEN
  119.         Erase(Datei)
  120.       ELSE BEGIN
  121.     IF ParamStr(1) <> '' THEN BEGIN
  122.       ChDir(ParamStr(1));
  123.       Rename(Datei, NewName);
  124.       ChDir(AktuellesLaufwerk);
  125.     END ELSE
  126.       Rename(Datei, NewName);
  127.       END;
  128.       WriteLn(BakDatei.Name:12, '  ----> ', NewName:12);
  129.       FindNext(BakDatei);
  130.     UNTIL DosError = 18;
  131.     WriteLn;
  132.   END;
  133. END.
  134. (* ------------------------------------------------------ *)
  135. (*                Ende von SAVEBAK.PAS                    *)