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

{
From: russchinoy@aol.com (RussChinoy)
>Does anyone have know of where I can get a hold of a routine to delete
>all files off a floppy disk regardless, including all subdirectores?

Here's the source to a little DOS utility that I wrote to do exactly what
you are looking for (actually, it's slightly more flexible since you can
specify the starting directory; you can just specify the root), using a
recursive routine.
}

{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
{$M 65520, 0, 0}

PROGRAM XRD;

{ This program deletes all files and subdirectories below the specified
  directory, and then removes the specified directory as well.          }

USES
    Dos,
    OpDos,
    OpCrt,
    OpString;

CONST
     Version = '1.01';

VAR
   XRDPath : PathStr;
   f       : file;

{*************************************************************************
**}

PROCEDURE Init;
VAR
   TempPath : PathStr;
   c        : char;
BEGIN
writeln;
writeln('XRD, Version ', Version, ', Copyright (c) 1992 RC Software');
writeln;
IF paramcount <> 1 THEN
   BEGIN
   writeln('   Purpose:  XRD removes the specified directory, and');
   writeln('             all files and subdirectories under it.');
   writeln;
   writeln('   Syntax:   XRD [d:]<path>');
   writeln;
   writeln('   Where:    d: is an optional drive specifier, and');
   writeln('             <path> is the path to be removed.');
   writeln;
   halt(1);
   END;

XRDPath := paramstr(1);

IF NOT IsDirectory(XRDPath) THEN
   BEGIN
   writeln('Error: specified path not found.');
   writeln;
   halt(2);
   END;

XRDPath := fexpand(XRDPath);

IF XRDPath[length(XRDPath)] <> '\'
   THEN XRDPath := XRDPath + '\';

XRDPath := StUpCase(XRDPath);

TempPath := copy(XRDPath, 1, length(XRDPath) - 1);

writeln('WARNING!!  You are about to remove the following directory');
writeln('           (and delete all files and subdirectories under it):');
writeln('           '#16' ', TempPath, ' ', #17);
write('Continue (Y/N)? ');

REPEAT
c := upcase(readkey);
IF c = #0 THEN
   BEGIN
   c := readkey;
   c := #255;
   END;
UNTIL c in ['Y', 'N'];
writeln(c);
writeln;

IF c = 'N' THEN halt(3);
END;

{*************************************************************************
**}

PROCEDURE DeleteAllFilesInDir(DirName : PathStr);
VAR
   s : searchrec;
BEGIN
FindFirst(DirName + '*.*', AnyFile, s);
WHILE DosError = 0 DO
      BEGIN
      IF (s.Attr <> Directory) AND
         (s.name <> '.') AND
         (s.name <> '..')
         THEN BEGIN
              gotoxy(1, wherey);
              clreol;
              write('Deleting: ', DirName + s.name);
              Assign(f, DirName + s.name);
              erase(f);
              IF IOResult <> 0 THEN
                 BEGIN
                 SetFAttr(f, Archive);
                 erase(f);
                 IF IOResult <> 0 THEN
                   BEGIN
                   gotoxy(1, wherey);
                   clreol;
                   writeln('Error: unable to delete ', DirName + s.name);
                   END;
                 END;
              END
         ELSE IF (s.Attr = Directory) AND
                 (s.name <> '.') AND
                 (s.name <> '..')
                 THEN DeleteAllFilesInDir(DirName + s.name + '\');
      FindNext(s);
      END;

IF (length(DirName) > 1) AND
   NOT ((length(DirName) = 3) AND (DirName[3] = '\')) THEN
   BEGIN
   gotoxy(1, wherey);
   clreol;
   write('Removing: ', copy(DirName, 1, length(DirName) - 1));

   rmdir(copy(DirName, 1, length(DirName) - 1));

   IF IOResult <> 0 THEN
      BEGIN
      gotoxy(1, wherey);
      clreol;
      writeln('Error: unable to remove ', copy(DirName, 1, length(DirName)
- 1));
      END;
   END;
END;

{*************************************************************************
**}

BEGIN
Init;

DeleteAllFilesInDir(XRDPath);

gotoxy(1, wherey);
clreol;
writeln('Done.');
writeln;
END.

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