program Del_ (Input, Output);
uses Dos;

{
Title   : DEL-.PAS  (Deletes ALL files but specified one(s) in a directory)
LastEdit: Feb 10, 1990
Author  : Gianfranco "Frankie" Lanzilli - CoSysOp OMNIANET BBS - FidoNet 2:335/304.2 - Roma
System  : Borland Turbo Pascal 5.5 (Ms-Dos environment)
}

type ListPtr  = ^FileList;
     FileList = record
                  FileName : string[12];
                  Next     : ListPtr
                end;

var C             : char;
    FileSpecs     : PathStr;
    Prompt        : boolean;
    Dir           : DirStr;
    Name          : NameStr;
    Ext           : ExtStr;
    List, Head, D : ListPtr;
    Info          : SearchRec;
    Error         : integer;
    Counter       : word;
    F             : file;

function ReadKey : char;
  var Regs : registers;
  begin  {ReadKey}
    Regs.AH := $08;
    MsDos(Regs);
    ReadKey := Chr(Regs.AL)
  end;  {ReadKey}

function UpCaseStr (S : string) : string;
  var K : byte;
      T : string;
  begin  {UpCaseStr}
    T := '';
    for K := 0 to Length(S) do
      T[K] := UpCase(S[K]);
    UpCaseStr := T
  end;  {UpCaseStr}

begin  {MAIN}
  C := '*';
  FileSpecs := '';
  Prompt := false;
  if (ParamCount >= 1) then
    begin
      if (ParamStr(1) = '?') then
        begin
          Writeln;
          Writeln('Sintax:    DEL- [/P] <FileFileSpecs>          (Parameters order is ininfluent)');
          Writeln;
          Writeln('DEL- will delete ALL files BUT specified one(s) in the working directory.');
          Writeln('If present, the optional parameter:  /P  will force the program to prompt');
          Writeln('the user for a confirm on deletion of Read-Only, Hidden and System files,');
          Writeln('everytime encountered. If:  /P  is omitted, the program won''t give theese');
          Writeln('prompts and will NOT! delete Read-Only and/or Hidden and/or System files,');
          Writeln('just like Dos'' DEL command does.  Dos'' WILDCARDS *, ? are welcome!');
          Writeln;
          Writeln('Examples:');
          Writeln;
          Writeln('  DEL- *.PAS            del ALL files BUT *.PAS in current dir, no prompt');
          Writeln('  DEL- D:\DATA\C??OS.*  del ALL files BUT C??OS.* in D:\DATA\, no prompt');
          Writeln('  DEL-                  this deletes ALL files but R-O, H, S (with confirm)');
          Writeln('  DEL- *.*              this just won''t delete anything...');
          Writeln('  DEL-/P *.PAS          same as the first, but prompt for R-O, H, S files');
          Writeln('  DEL-/P C:\DEMO\0*.*   similar to the previous, but applied to a Path');
          Writeln('  DEL-/P                same as DEL- alone, with prompts for R-O, H, S');
          Writeln('  DEL-/P C:*.*          this won''t delete anything, and won''t prompt too...');
          Writeln;
          Writeln('DEL- is just another utility program by Gianfranco "Frankie" Lanzilli, Rome (I)');
          Halt
        end;
      for Counter := 1 to ParamCount do
        if (UpCaseStr(ParamStr(Counter)) = '/P') then
          Prompt := true
        else
          if (FileSpecs = '') then
            FileSpecs := UpCaseStr(ParamStr(Counter))
          else
            begin
              Writeln('Invalid parameter(s) given.');
              Halt
            end
    end;
  if (FileSpecs = '') then
    begin
      Write('Do you mean that should I delete ALL files in current dir  <Y/N> ? ');
      repeat
        C := UpCase(ReadKey)
      until ((C = 'N') or (C = 'Y'));
      Writeln(C);
      if (C = 'N') then
        Halt
    end;
  FSplit(FileSpecs,Dir,Name,Ext);
  New(List);
  Head := List;
  List^.Next := nil;
  if (C <> 'Y') then
    begin
      FindFirst(FileSpecs,$27,Info);
      Error := DosError;
      if ((Error = 3) and (FileSpecs <> '')) then
        begin
          Writeln('Incorrect PathName given.');
          Halt
        end;
      if (Error = 18) then
        begin
          Writeln('Specified file(s) not found.');
          Halt
        end;
      while (Error = 0) do
        begin
          New(List^.Next);
          List := List^.Next;
          List^.FileName := Info.Name;
          List^.Next := nil;
          FindNext(Info);
          Error := DosError
        end
    end;
  Counter := 0;
  FindFirst(Dir+'*.*',$27,Info);
  while (DosError = 0) do
    begin
      List := Head;
      while ((List^.Next <> nil) and (List^.Next^.FileName <> Info.Name)) do
        List := List^.Next;
      if (List^.Next <> nil) then
        begin
          D := List^.Next;
          List^.Next := List^.Next^.Next;
          Dispose(D)
        end
      else
        if ((Info.Attr <> $20) and (Info.Attr <> $00)) then
          begin
            if Prompt then
              begin
                Write(Dir,Info.Name,' is marked');
                if ((Info.Attr and 1) <> 0) then
                  Write(' READ-ONLY');
                if ((Info.Attr and 2) <> 0) then
                  Write(' HIDDEN');
                if ((Info.Attr and 4) <> 0) then
                  Write(' SYSTEM');
                Write('. Delete  <Y/N> ? ');
                repeat
                  C := UpCase(ReadKey)
                until ((C = 'N') or (C = 'Y'));
                Writeln(C);
                if (C = 'Y') then
                  begin
                    Assign(F,Dir+Info.Name);
                    SetFAttr(F,$20);
                    Writeln('Deleting:  ',Dir,Info.Name);
                    Erase(F);
                    Inc(Counter)
                  end
              end
          end
        else
          begin
            Assign(F,Dir+Info.Name);
            Writeln('Deleting:  ',Dir,Info.Name);
            Erase(F);
            Inc(Counter)
          end;
      FindNext(Info)
    end;
  Writeln;
  Writeln('   ',Counter,' file(s) deleted.')
end.  {MAIN}