[Back to ARCHIVES SWAG index] [Back to Main SWAG index] [Original]

    {
              ZNDEL version 2.1   -  Public Domain / Freeware

            Exclusive-Delete utility ( originally 'ZIP-NOT-DEL' ? )

                  E. de Neve    CompuServe ID: 100121,1070

       Version 2.1  November 1, 1994

       New in version 2.1
         - fixed bug in redirection detection
         - confirmation prompt will now bypass redirection

       Version 2.0  August 17, 1994

       New in version 2.0 :
         - recognizes 12 of the most common archive format extensions
         - full DIR-style wildcard support
         - confirmation asked before deleting
         - no confirmation needed in assigned working directories
         - realistic limits & safety checks for maximum number of files
         - switch to override prompting, useful in batch files

       Version 1.0  (Original)  Written  Sept. 21, 1991  by  G. Palmer

    }

    {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-} {* compiler switches *}
    Program Zndel2;

    Uses Dos, Crt;

    Type
      FullNameStr = String [12];

    Const
      Assume_Yes: Boolean = False;

      Maxdelete   =  2000;
      Maxsave     =  32;
      Maxworkdirs =  32;

      MetaBufSize =  4000;  { I/O buffer used when patching .exe file }

      ConfigStart: String [5] = '(CFG<'; { mark start of config area }
      Nr_workdirs: Byte =  0;
      Workdirs: Array [1..MaxWorkDirs] Of FullNameStr =
      ('', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '',
      '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '');
      ConfigEnd: String [5] = '>CFG)'; { end of config area }

      MaxArchExt  =  12;
      ArchExt: Array [1..MaxArchExt] Of String [3] =
      ( 'ZIP', 'ARJ', 'LZH', 'ARC', 'LIM', 'UC2',
      'PAK', 'SQZ', 'HAP', 'SDN', 'ZOO', 'SIT' );

      VaLetSet: Set Of Char = [ '#'..')', '!', '@', '^', '~', '_', '{',
      '}', '-', '0'..'9', 'A'..'Z', 'a'..'z'];
      { set of valid letters that make up an unambiguous file/dir name }

    Var
      CH:                     Char;
      I:                      Word;
      Afile:                  File;
      NormOut:                Text;
      Nr_Names_To_Save:       Word;
      Nr_Files_To_Delete:     Word;
      Nr_Files_Found:         Word;
      Nr_Files_to_Protect:    Word;
      TempStr, UpStr:         FullNameStr;
      Files_To_Delete :       Array [1..maxdelete]   Of FullNameStr;
      Names_To_Save:          Array [1..maxsave]     Of FullNameStr;
      Search_Record:          SearchRec;
      MetaBuffer:             Array [0..MetaBufSize] Of Byte;

    Procedure Show_Info;
    Begin
      WriteLn;
      WriteLn ('Deletes all files in the current directory, except:');
      WriteLn ('        Files listed on the command line, DIR-style wildcards allowed.');
      WriteLn ('        Archived files ( ZIP, LZH, ARC, ARJ, LIM, ZOO etc. )');
      WriteLn ('        Hidden, System and ReadOnly files.');
      WriteLn;
      WriteLn ('Usage:  ZNDEL [/Y] [filespec (filespec) ]  delete all but filespecs & archives');
      WriteLn ('                ÀÄÄ>   assume YES on all prompting');
      WriteLn ('        ZNDEL /S       show current settings');
      WriteLn ('        ZNDEL /?       show this help text');
      WriteLn;
      WriteLn ('        ZNDEL /W  [workdir (workdir) ]   assign working directories ');
      WriteLn;
      WriteLn ('        ZNDEL will always ask for confirmation before deleting files,');
      WriteLn ('        unless the current directory is one of the assigned working dirs.');
      Halt;
    End;

    Procedure WildExpand (Var inname: String);

    Var workname: String [12]; {name}
      Havecard: Boolean;
      S, D, P: Byte;           {counters source,destin,point}
      ic: Char;

    Procedure PartExpand;
    Begin
      If HaveCard Then IC := '?'
      Else
        If (S > Byte (inname [0] ) ) Or (P > 0) Then IC := ' ' Else
        Begin
          IC := UpCase (inname [S] );
          If IC = '*' Then
          Begin Havecard := True; IC := '?'; End
          Else
            If IC = '.' Then
            Begin P := S; IC := ' '; End;
          Inc (S);
        End; {real ic digest}

      Workname [D] := IC;
      Inc (D);
    End;

    Begin

      S := 1; { source }
      D := 1; { destin }
      P := 0; { point-pos }

      workname [0] := #12;
      workname [9] := '.';

      HaveCard := (Inname [0] > #0) And (inname [1] = '.');

      While (Byte (inname [0] ) > S) And (Inname [S] = ' ') Do Inc (S);
      { 'remove' front spaces... }

      Repeat {copy into name8}
        PartExpand;
      Until D = 9;

      S := 1; {FIND any point if it exists..}
      While (P = 0) And (S <= Byte (Inname [0] ) ) Do
      Begin
        If inname [S] = '.' Then P := S Else Inc (S);
      End;

      Havecard := ( (P = 0) And (Inname [0] > #0) )  Or (Inname [0] = #1);

      S := P; {on point }
      P := 0;

      Inc (S); {both get over point}
      Inc (D);

      PartExpand; {ext 3 chars}
      PartExpand;
      PartExpand;

      Inname := WorkName;
    End;

    Function MatchWild (Var WW1, SS2: String): Boolean; {count on BOTH being expanded..}
    Var CC: Byte;
    Begin

      {loop both strings, if wild has non-? char that doesnt match SS2 char,
      OR SS2 char has ? that doesn't match SPACE, then exit}

      matchwild := False;

      For CC := 1 To 12 Do If WW1 [CC] <> SS2 [CC] Then
      Begin
        If ( (ww1 [cc] = ' ') And (ss2 [cc] <> '?') )
           Or
           ( (WW1 [CC] <> '?') )
        Then Exit;
      End;

      Matchwild := True;
    End;

    Function SameName (Wild, Sample: String): Boolean;
    Begin
      { Note: WILD must be an already expanded 13-character wildcard string}
      Wildexpand (Sample);
      Samename := matchwild (Wild, Sample);
    End;

    Procedure Show_Config;
    Begin
      Write ('Assigned working directories:   ');
      If Nr_Workdirs = 0 Then WriteLn ('None.');
      For I := 1 To Nr_Workdirs Do Write (Workdirs [I], '  ');
      WriteLn;
      Halt;
    End;

    Function ValidDirName (Var Workstring: String): Boolean;
    Var I: Byte;
      NumPoints: Byte;
      PointStart: Byte;
      ExtSize: Byte;
      NameSize: Byte;
    Begin
      PointStart := 0;
      For I := 1 To Length (WorkString) Do
      Begin
        If (Workstring [i] = '.') And (Pointstart = 0) Then
        Begin {point digest}
          If I > 1 Then PointStart := I
          Else Begin ValidDirName := False; Exit; End;
          {too many points, or starts with point..}
        End
        {no point - then must be valid filename letter}
        Else
          If Not (Workstring [i] In VaLetSet)
          Then Begin ValidDirName := False; Exit; End;
      End;

      {finally, check if the extension OR filename are not too big: }

      If ( (Pointstart = 0) And (Length (Workstring) > 8) )
         Or ( Pointstart > 9)
         Or ( ( Pointstart > 1) And (Length (WorkString) > (Pointstart + 3) ) )
      Then ValidDirname := False
      Else
        ValidDirName := True;
    End;

    Procedure UpcaseString (Var Workstring: String);
      Var I: Byte;
      Begin
        For I := 1 To Length (WorkString) Do WorkString [i] := UpCase (WorkString [i] );
      End;

    Function FindLocation (Var Infile: File;  Sample: String): LongInt;

     { universal 'binary file' search routine, works with files }
     { of any length, even if much larger than 64Kb             }
     { searches a file for sample string using the 'Metabuffer' }
     { assumes the file INFILE was already open for reading     }

    Var I: LongInt;
      J: Word;
      Location: LongInt;
      BytesRead: Word;
      SearchIndex: LongInt;
    Begin

      SearchIndex := 0;
      FindLocation := 0;

      If Length (Sample) = 0 Then Exit;

      Repeat
        Seek (InFile, Searchindex);

        BlockRead (InFile, Metabuffer, SizeOf (Metabuffer), BytesRead);

        If BytesRead < Length (Sample) Then Exit; {file or buffer too small..}

        For I := 0 To (BytesRead - Length (Sample) ) Do
          If MetaBuffer [i] = Byte (Sample [1] ) Then
          Begin
            J := 1;

            While (J < Length (Sample) ) And
                  ( Metabuffer [I + J] = Byte (Sample [J + 1] ) )
            Do Inc (J);

            If J = Length (Sample)  Then Begin
              FindLocation := SearchIndex + I;
              Exit;
            End;

          End;

        If BytesRead < SizeOf (Metabuffer) Then Exit;    { at end of file}

        SearchIndex := SearchIndex + BytesRead - Length (Sample) + 1;

        { This ensures overlap between consecutive buffer reads; because
        of this overlap, the whole procedure will still work even in
        the extreme case when Sizeof(Metabuffer)=Length(Sample)  !!! }

      Until False;

    End;

    Procedure Config_Workdirs;
     Var BytesRead, BytesWritten: Word; {dummy args for Blockread/write}
       PatchAddr1, PatchAddr2: Word;
       I, J: Word;
       NewDirs: Word;
       ParamString: String;
     Begin
       { put supplied working dir names into array }

       NewDirs := ParamCount;       { First parameter was /W }

       Nr_Workdirs := 0;            { disregard old settings }

       For i := 2 To NewDirs Do     { expand & add to SAVE specs list }
         If (Nr_workdirs < MaxWorkDirs) Then   { check for max nr of dirs }
         Begin
           ParamString := ParamStr (i);
           UpcaseString (ParamString);
           If ParamString [1] = '/' Then Show_Info; { wrong place for option }

           If ValidDirName (ParamString) Then Begin
             Inc (Nr_Workdirs);
             If Paramstring [Byte (Paramstring [0] ) ] = '.' {get rid of ugly points at end}
             Then Dec (Byte (paramstring [0] ) );
             WorkDirs [Nr_Workdirs] := ParamString;
           End;
         End;

       { Find 'home' directory, find ZNDEL.EXE (or whatever our name was)
       find out where to insert the new workdirs data structure,
       then copy them to it. }

       Assign (Afile, ParamStr (0) ); { it's ME ! }
       FileMode := 2;               { default, read and write possible }
       Reset (Afile, 1);            { open, counting will be done in BYTES }

       If IOResult <> 0 Then Begin
         WriteLn ('Configuration failed - file not found.');
         WriteLn;
         Halt;
       End;

       PatchAddr1 := FindLocation (Afile, Configstart);
       PatchAddr2 := FindLocation (Afile, ConfigEnd);

       If IOResult <> 0 Then Begin
         WriteLn ('Configuration failed - error reading file.');
         WriteLn;
         Halt;
       End;

       If  (PatchAddr1 = 0) Or (PatchAddr2 = 0)
           Or ( (PatchAddr2 - PatchAddr1) <> (Ofs (ConfigEnd) - Ofs (ConfigStart) ) )
       Then Begin
         WriteLn ('Error - incompatible structure in: ', ParamStr (0) );
         WriteLn;
         Halt;
       End;

       { Now seek to config area in file and copy our own data to it.. }
       { The area to patch starts just after 'configstart' at Nr_Workdirs}

       Seek (Afile, PatchAddr1 + Length (ConfigStart) );

       BlockWrite (Afile, Nr_Workdirs, ( SizeOf (Nr_Workdirs) + SizeOf (Workdirs) ),
       BytesWritten);

       Close (Afile);

       If IOResult <> 0 Then WriteLn (' Error trying to update options.')
       Else
       Begin
         WriteLn ('New settings written to ', ParamStr (0) );
         Show_Config;
       End;

       Halt;
     End;

    Procedure Get_Command_Line_Args;
    Var
      I:   Word;
      ParamString : String;
      Nr_Params, DigestParam: Byte;

    Begin
      Nr_Params := ParamCount;
      If Nr_Params = 0  Then Exit;

      DigestParam := 1;

      ParamString := ParamStr (1);
      UpcaseString (ParamString);

      If ParamString = '/W' Then  Config_Workdirs;
      If ParamString = '/S' Then  Show_Config;

      If ParamString = '/Y' Then  Begin
        Assume_Yes := True;
        Inc (DigestParam);
      End;

      If ParamString = '/?' Then  Show_Info;

      { no valid options so interpret the rest as filespecs of files to be saved }

      Nr_Names_to_save := 0;

      For i := DigestParam To Nr_Params Do   { expand & add to SAVE specs list }
        If Nr_Names_to_Save < MaxSave Then         { check for max nr of names }
        Begin
          ParamString := ParamStr (i);
          If ParamString [1] = '/' Then Show_Info;    { wrong place for option }
          WildExpand (ParamString);
          Inc (Nr_Names_to_Save);
          Names_to_Save [Nr_Names_to_save] := ParamString;
        End;

    End;

    Procedure Check_If_Protected (Curr_file: String);
    Var  I: Integer;
    Begin
      Inc (Nr_Files_Found);
      Inc (Nr_Files_to_Protect);  { start and assume it's protected }

      If ( (Search_Record.Attr And ReadOnly) = ReadOnly) Then Exit; { Protected }

      For I := 1 To MaxArchExt Do              { does it have a known extension? }
        If Pos ('.' + ArchExt [I] , Curr_file) > 1 Then Exit;

      For I := 1 To Nr_Names_to_Save Do                 { was it on cmd line? }
        If SameName (Names_to_Save [i], Curr_File)  Then Exit;

      Dec (Nr_Files_to_Protect);  { not protected after all }
      Inc (Nr_Files_To_Delete);

      Files_To_Delete [ Nr_Files_to_Delete ] := Curr_File;  { add to delete list }

    End;

    Function InWorkDir: Boolean;
    Var ThisDir: String;
      T: Word;
    Begin

      InWorkDir := True;

      { Test if we are in a working dir, or any one of its subdirs.... }

      GetDir (0, thisdir);
      Thisdir := Thisdir + '\';
      For T := 1 To Nr_WorkDirs Do
      Begin
        If Pos ('\' + WorkDirs [T] + '\', Thisdir) > 0 Then Exit;
      End;

      InWorkDir := False;
    End;

    Procedure SayPrott; { ask for confirmation }
    Begin
      WriteLn (NormOut,'! WARNING - this is not a known working directory.');
      Write (NormOut,'Are you sure (Y/N)? ');
      While KeyPressed Do CH := ReadKey;
      CH := ReadKey;
      WriteLn (NormOut,CH);
      If UpCase (CH) <> 'Y' Then Halt;
    End;

    Procedure Bye;
    Begin
      WriteLn;
      WriteLn (NormOut,'ZNDEL 2.1  aborted.  Some files not deleted.');
      Halt;
    End;

    Function Redirected: Boolean;
     { detect if user wants redirectable output }
    Assembler;
    Asm
      MOV   AX, 04400h  { query device info }
      MOV   BX, 1       { for device STDOUT }
      INT   021h
      XOR   AX, AX
      TEST  DL, 1 shl 7 { bit 7 clear: redirected to file }
      JZ   @redirred
      TEST  DL, 1 shl 1 { bit 1 set: device is standard output }
      JNZ  @standard
     @redirred:
      INC   AX          { true if redirected }
     @standard:
    End;

    Begin
      AssignCrt(NormOut); { save default mode of screen output to CRT }
        Rewrite(NormOut); { open for writing }

      If  Redirected Then  Begin
        {  In Borland/Turbo Pascal, using CRT bypasses DOS so the  }
        {  output is not redirectable. Here we reroute the output  }
        {  to the official DOS STDOUT device again, but only when  }
        {  the user wanted to redirect the output.                 }
        Assign  (Output, '');  { Put pascal output back on real STDOUT.. }
        Rewrite (Output);      { Open for writing }
      End;

      While KeyPressed Do CH := ReadKey;

      WriteLn ('ZNDEL 2.1  Exclusive Delete utility by G. Palmer and E. de Neve    Freeware');

      Get_Command_Line_Args;

      If (Not InWorkDir) Then If (Not Assume_Yes) Then SayPrott;

      Nr_Files_Found      := 0;
      Nr_Files_to_Protect := 0;
      Nr_Files_to_Delete  := 0;

      { Reading directory .. }

      FindFirst ('*.*', Archive, Search_Record);
      If (DosError = 0) Then Check_if_protected (Search_Record.Name);

      While (DosError = 0) And (Nr_Files_to_Delete < Maxdelete)
      Do Begin
        FindNext (Search_Record);
        If (DosError = 0) Then Check_if_protected (Search_Record.Name);
        If KeyPressed Then bye;       { chance to cancel }
      End;

      {   Deleting files .. }

      If (Nr_Files_to_Delete > 0 ) Then
      Begin
        If KeyPressed Then bye;       { chance to cancel }

        For I := 1 To Nr_Files_To_Delete Do
        Begin
          If KeyPressed Then bye;     { chance to cancel }
          Assign (Afile, Files_To_Delete [I] );
          Erase (Afile);
        End;

      End;

      WriteLn;
      WriteLn ('    Files found: ', Nr_Files_found);
      WriteLn ('Protected files: ', Nr_Files_to_Protect);
      WriteLn ('  Files deleted: ', Nr_Files_to_Delete);

    End.

    { -------------------------------------------------------------------------}

             ZNDEL version 2.1   -  Public Domain / Freeware

         Exclusive-Delete utility ( originally 'Zip-Not-DEL' ? )

         This program deletes all the files in the current directory
         except archives, files specified on the command line, and
         files marked as system, hidden, or read-only.

         Very convenient for cleaning up after de-archiving, e.g in
         working- and download directories.

     Usage:

         ZNDEL [/Y] [filespec (filespec) ]  delete all but filespecs & archives
                 ÀÄÄ>   assume YES on all prompting (useful in batch files)

         ZNDEL /S                           show current workdir assignments
         ZNDEL /W  [workdir (workdir) ]     assign working directories

         ZNDEL /?                           show the help text

     Examples:

         delete all but the assembler sources       ZNDEL *.asm
         to keep prog1.pas, prog2.txt etc.          ZNDEL prog?
         combined effect of above examples          ZNDEL prog? *.asm
         the same, without prompting                ZNDEL /Y prog? *.asm

     Configuration:

         You can configure ZNDEL to work automatically without
         prompting for quick cleanups in specific directories.
         Make sure to specify only simple directory names, do not
         include drive ID's or subdirectories, for example:

         ZNDEL /W  download  stuff  temp

         This makes ZNDEL recognize these directories or any of
         their subdirectories as special working directories, in
         which ZNDEL will never ask for confirmation.

         The commands  C:\DOWNLOAD\GAME> ZNDEL

                  and  C:\COMMPROG\STUFF\MISC> ZNDEL

         will both work without confirmation because GAME is a
         subdirectory of DOWNLOAD, and MISC is a subdir of STUFF.

     Tech notes & details:

       The included source file ZNDEL.PAS was tested and
       compiled using Borland Pascal 7.0.

       For configuration, the .EXE file itself is modified,
       which will not work when it is compressed by an
       executable compressor like LZEXE or PKLITE.
       Configuration will work OK when ZNDEL.EXE has
       been renamed.

       Because wildcards in ZNDEL are used to specify files
       to save rather than files to delete, the DIR wildcard
       convention, which is much more flexible than the
       DEL wildcard (= internal MS-DOS) convention, is
       simulated with all its details and quirks.
       For example, in DIR style, "." and "*" both mean "*.*",
       and "progname" means "progname.*".

       All output can be suppressed or redirected, e.g. by
       redirecting to the NUL device, as in  ZNDEL /Y  > NUL

       Pascal programmers may find some of the code useful for
       their own programs, especially the redirection routines,
       the self-modification trick including a "binary file search"
       routine (which works on files of unlimited size) and the
       wildcard evaluation. Use the code any way you like.

     Legal stuff:

       There is no warranty of this software's suitability for
       any purpose, nor any acceptance of liability, express or
       implied. By using this free software, you agree to this.

     Version history:

       Version 2.1  November 1, 1994

       New in version 2.1
         - fixed bug in redirection detection
         - confirmation prompt will now bypass redirection

       Version 2.0  August 17, 1994

       New in version 2.0 :
         - recognizes 12 of the most common archive format extensions
         - full DIR-style wildcard support
         - confirmation asked before deleting
         - no confirmation needed in assigned working directories
         - realistic limits & safety checks for maximum number of files
         - switch to override prompting, useful in batch files

       Version 1.0  (Original)  Written  Sept. 21, 1991  by  G. Palmer

       Original:  Written Sept 21, 1991  by  G.Palmer

[Back to ARCHIVES SWAG index] [Back to Main SWAG index] [Original]