home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 10 / tricks / ndel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-08  |  4.7 KB  |  180 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      NDEL.PAS                          *)
  3. (*                 Löschen mit Ausnahmen                  *)
  4. (*            (c) 1990 Thomas Seban & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM NDel;
  7.  
  8. {$M 8192,0,0}
  9. {$V-}
  10.  
  11. USES
  12.   Dos, Crt;
  13.  
  14. VAR
  15.   Regs        : Registers;
  16.   Ausn        : ARRAY [1..10] OF STRING [12];
  17.   Pfad        : PathStr;
  18.   Dirpfad     : DirStr;
  19.   Name        : NameStr;
  20.   Ext         : ExtStr;
  21.   DeleteStr   : STRING;
  22.   AnzahlAusn,
  23.   Id          : BYTE;
  24.   Abfrage     : BOOLEAN;
  25.  
  26.   PROCEDURE UpString(VAR UpName : STRING);
  27.   VAR
  28.     Index : BYTE;
  29.   BEGIN
  30.     FOR Index := 1 TO Length(UpName) DO
  31.       UpName[Index] := UpCase(UpName[Index]);
  32.   END;
  33.  
  34.   FUNCTION Search(Name : STRING; Zeichen : CHAR) : BOOLEAN;
  35.   VAR
  36.     Index : BYTE;
  37.   BEGIN
  38.     Search := FALSE;
  39.     FOR Index := 1 TO Length(Name) DO
  40.       IF Name[Index] = Zeichen THEN
  41.         Search := TRUE;
  42.   END;
  43.  
  44.   FUNCTION SameChar(Zeichen1, Zeichen2 : CHAR) : BOOLEAN;
  45.   BEGIN
  46.     IF Zeichen1 = Zeichen2 THEN
  47.       SameChar := TRUE
  48.     ELSE IF Zeichen2 = '?' THEN
  49.       IF Zeichen1 <> '.' THEN
  50.         SameChar := TRUE
  51.       ELSE
  52.         SameChar := FALSE
  53.     ELSE
  54.       SameChar := FALSE;
  55.   END;
  56.  
  57.   FUNCTION Equal(Name1, Name2 : STRING) : BOOLEAN;
  58.   VAR
  59.     Id1, Id2 : BYTE;
  60.   BEGIN
  61.     Equal := TRUE;
  62.     IF Name2 <> '*.*' THEN BEGIN
  63.       IF NOT Search(Name2, '*') THEN BEGIN
  64.         IF Length(Name1) = Length(Name2) THEN BEGIN
  65.           FOR Id2 := 1 TO Length(Name2) DO
  66.             IF (NOT SameChar(Name1[Id2], Name2[Id2])) THEN
  67.               Equal := FALSE;
  68.         END ELSE
  69.           Equal := FALSE;
  70.       END ELSE BEGIN
  71.         Id1 := 1;
  72.         Id2 := 1;
  73.         WHILE Id2 <= Length(Name2) DO BEGIN
  74.           IF SameChar(Name1[Id1], Name2[Id2]) THEN BEGIN
  75.             Inc(Id1);
  76.             Inc(Id2);
  77.           END ELSE BEGIN
  78.             IF Name2[Id2] = '*' THEN BEGIN
  79.               WHILE (Name2[Id2] <> '.') AND
  80.                     (Id2 <= Length(Name2)) DO Inc(Id2);
  81.               WHILE (Name1[Id1] <> '.') AND
  82.                     (Id1 <= Length(Name1)) DO Inc(Id1);
  83.             END ELSE BEGIN
  84.               Equal := FALSE;
  85.               Inc(Id1);
  86.               Inc(Id2);
  87.             END;
  88.           END;
  89.         END;
  90.       END;
  91.     END;
  92.   END;
  93.  
  94.   PROCEDURE DeleteDatei(Name : STRING);
  95.   BEGIN
  96.     Name    := Name + #0;
  97.     Regs.ah := $41;
  98.     Regs.ds := Seg(Name);
  99.     Regs.dx := Ofs(Name) + 1;
  100.     MsDos(Regs);
  101.     IF (Regs.flags AND 1) = 1 THEN
  102.       Write('Datei ', Name,' konnte nicht gelöscht werden');
  103.   END;
  104.  
  105.   FUNCTION OkDel(Name : STRING) : BOOLEAN;
  106.   VAR
  107.     Taste : CHAR;
  108.     Ok    : BOOLEAN;
  109.   BEGIN
  110.     Ok := TRUE;
  111.     IF Equal(Name, DeleteStr) THEN BEGIN
  112.       FOR Id := 1 TO AnzahlAusn DO
  113.         IF Equal(Name, Ausn[Id]) THEN
  114.           Ok := FALSE;
  115.       END ELSE
  116.         Ok := FALSE;
  117.     IF Abfrage AND Ok THEN BEGIN
  118.       Write('Soll ', Name, ' gelöscht werden (j/n) ? ');
  119.       REPEAT
  120.         Taste := ReadKey;
  121.       UNTIL (Taste = 'j') OR (Taste = 'n');
  122.       IF Taste = 'n' THEN Ok := FALSE;
  123.       WriteLn(Taste);
  124.     END;
  125.     OkDel := Ok;
  126.   END;
  127.  
  128.   PROCEDURE Dir(Pfad : STRING);
  129.   VAR
  130.     S : SearchRec;
  131.   BEGIN
  132.     FindFirst(Pfad + '\*.*', AnyFile, S);
  133.     WHILE (DosError <> 18) DO BEGIN
  134.       IF S.Attr <> $10 THEN
  135.         IF OkDel(S.Name) THEN
  136.           DeleteDatei(Pfad + '\' + S.Name);
  137.        FindNext(S);
  138.     END;
  139.   END;
  140.  
  141. BEGIN
  142.   IF paramcount = 0 THEN BEGIN
  143.     WriteLn;
  144.     WriteLn(' NDEL - löschen von Dateien mit Ausnahmen');
  145.     WriteLn(' (c) 1990 Thomas Seban & TOOLBOX');
  146.     WriteLn;
  147.     WriteLn(' Syntax:');
  148.     WriteLn(' NDEL <Name> [/P] <Ausnahme1..Ausnahme10>');
  149.     Writeln;
  150.     writeln(' Wildcards werden akzeptiert.');
  151.   END ELSE BEGIN
  152.     Pfad := ParamStr(1);
  153.     UpString(Pfad);
  154.     Abfrage := TRUE;
  155.     IF Copy(Pfad, Length(Pfad) - 1, 2) = '/P' THEN
  156.       Pfad := Copy(Pfad, 1, Length(Pfad) - 2)
  157.     ELSE
  158.       Abfrage := FALSE;
  159.     FSplit(Pfad, DirPfad, Name, Ext);   { TP 5.x, UNIT Dos }
  160.     DeleteStr := Name + Ext;
  161.     IF DirPfad = '' THEN
  162.       GetDir(0, DirPfad);             { 0 => akt. Laufwerk }
  163.     FOR Id := 1 TO ParamCount - 1 DO BEGIN
  164.       Ausn[Id] := ParamStr(Id + 1);
  165.       UpString(Ausn[Id]);
  166.     END;
  167.     AnzahlAusn := Id;
  168.     IF Id > 10 THEN AnzahlAusn := 10;
  169.     IF ParamCount = 1 THEN BEGIN
  170.       Ausn[Id] := '';
  171.       AnzahlAusn := 1;
  172.     END;
  173.     IF DirPfad[Length(DirPfad)] = '\' THEN
  174.       DirPfad := Copy(DirPfad, 1, Length(DirPfad) - 1);
  175.     Dir(DirPfad);
  176.   END;
  177. END.
  178. (* ------------------------------------------------------ *)
  179. (*                   Ende von NDEL.PAS                    *)
  180.