home *** CD-ROM | disk | FTP | other *** search
/ The CIA World Factbook 1992 / k3bimage.iso / sel / 12 / 0047 / eraser.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-02  |  2.6 KB  |  82 lines

  1. program eraser;
  2.  
  3.  uses
  4.   dos,crt;
  5.  var
  6.   i            : integer;
  7.   f            : file;
  8.   name,path    : pathstr;
  9.   ch           : char;
  10. {--------------------------------------}
  11.  { Recursive procedure (selfcalling) which scans given directory for files   }
  12.  { and subdirectories. If subdirectory was found, then procedure calls itself}
  13.  { to scan new subdirectory. Also it changes file attributes to normal, so   }
  14.  { even hidden, system and read-only files will be erased.                   }
  15.  procedure browse(p : string);
  16.   var
  17.    find : searchrec;
  18.   begin
  19.    writeln;
  20.    findfirst(p+'\*.*',anyfile,find); { search given directory for file   }
  21.    if doserror=0 then                { if directory not empty and while  }
  22.     while doserror=0 do              { it is not empty do as follow      }
  23.      begin
  24.       if (find.name<>'.') and (find.name<>'..') then
  25.        begin
  26.        if (find.attr and $10)=0 then  { file found, change attr. and erase }
  27.         begin
  28.          name:=p+'\'+find.name;
  29.          inc(i);
  30.          writeln(i:3,'. ',name);
  31.          assign(f,name);
  32.          setfattr(f,0);
  33.          erase(f);
  34.         end
  35.        else
  36.         browse(p+'\'+find.name);      { directory found, call itself       }
  37.        end;
  38.       findnext(find);
  39.      end;
  40.    writeln;
  41.    writeln('*** Removing ',p);
  42.    rmdir(p);
  43.   end;
  44. {----------------------------------------------------}
  45.  begin                                        {  Main program body      }
  46.   clrscr;
  47.   gotoxy(25,1);
  48.   write('*** Andy''s Directory Eraser ***');
  49.   writeln;
  50.   writeln;
  51.   if paramstr(1)='' then                       { No command string recieved }
  52.    begin                                       { ask user to enter one      }
  53.     write(' Enter directory to be erased : ');
  54.     readln(path);
  55.    end
  56.   else
  57.    path:=paramstr(1);
  58.   for i:=1 to length(path) do
  59.    path[i]:=upcase(path[i]);
  60.   i:=0;
  61.   textcolor(4);
  62.   textbackground(7);
  63.   writeln(' Program will remove ANY directory, even with deep subdirectories');
  64.   writeln(' inside. Press F1 to continue or any other key to abort : ');
  65.   ch:=readkey;
  66.   textcolor(10);                                { Check if user knows what's }
  67.   textbackground(0);                            { going on                   }
  68.   if ch=#0 then
  69.    ch:=readkey
  70.   else
  71.    halt;                                        { Stop if F1 is not pressed  }
  72.   if ch<>#59 then
  73.    halt;
  74.   writeln;
  75.   writeln(' ERASING : ');                       { Else report current file   }
  76.   browse(path);
  77.   writeln;
  78.   writeln ('That''s All ...');
  79.  end.
  80.  
  81.  
  82.