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

    {
      Erase is the proper procedure to delete one file. Here's a program I
      wrote a while back that does the same thin DELTREE does. Look it over
      and see if it helps get you started. BTW, I modified this a bit to
      remove commercial lib refs so there may be a syntax bug or two...

      RFD.PAS - Copyright 1991 Steve Rogers
      Released to public domain since DOS6 has DelTree... :)
    }

    {$m 16384,0,8192}
    {$i-}

    uses
      crt,dos;

    {-----------------------}
    function rfd(const s : pathstr) : boolean;
    var
      f : file;
      d : searchrec;
      temp : boolean;

    begin
      writeln('Removing '+s+'\');

      findfirst(s+'\*.*',anyfile-directory,d);
      if (doserror=0) then begin

        { Use DOS to get rid of the lion's share of files }
        swapvectors;
        exec(getenv('COMSPEC'),'echo y|del '+s+'\*.* >nul');
        swapvectors;

        { Now get the stragglers }
        findfirst(s+'\*.*',anyfile-directory,d);
        while (doserror=0) do begin
          assign(f,s+'\'+d.name);
          setfattr(f,archive);
          erase(f);
          findnext(d);
        end;
      end;

      { Now process the subs }
      findfirst(s+'\*.*',directory,d);
      while (doserror=0) do begin
        if (d.attr and directory = directory) and (d.name[1]<>'.') then
          temp:= rfd(s+'\'+d.name);
        findnext(d);
      end;

      rmdir(s);
      rfd:= (ioresult=0);
    end;

    {-----------------------}
    begin
      clrscr;
      writeln('RFD - Remove Full Directory  Copyright 1991 Steve Rogers');

      if (paramcount<1) then
        writeln('Syntax is: RFD <directory>')
      else begin
        if rfd(paramstr(1)) then
          writeln(paramstr(1)+' removed. All files and subs deleted.')
        else
          writeln('Unable to find or remove '+paramstr(1));
      end;
    end.

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