|
Public Function Deltree(ByVal Path As String) As Boolean
'//Deltree: permanently remove the specified directory structure
'//
'//Copyright (c)1996-1999 Michiel de Bruijn. See http://x42.net/Code/license.html for restrictions on using this code.
'//Released for public distribution, provided these comments are left intact
'//
'//WARNING: This code deletes files. It is, in fact, *very* good at it. It *may* delete files you would really want to keep.
'//The author is not responsible for any unanticipated or unwelcome behavior, no matter what your lawyer tells you...
Dim fil As String, attr As Long
Const TARGET_ATTR = vbNormal Or vbHidden Or vbSystem Or vbDirectory
On Error Resume Next
If Right(Path, 1) <> "\" Then Path = Path & "\"
fil = Dir(Path & "*.*", TARGET_ATTR)
While Len(fil)
'//Determine what kind of directory entry is
attr = GetAttr(Path & fil)
If (attr And vbDirectory) <> 0 Then
'//Found a new directory -- recurse into it, *unless* this
'//is the current or parent directory
If fil <> "." And fil <> ".." Then
If Deltree(Path & fil & "\") Then
'//Success, re-start our directory search
fil = Dir(Path & "*.*", TARGET_ATTR)
GoTo Continue2
Else
'//Failure, can't continue, since we would keep re-trying to
'//delete this particular directory...
Deltree = False
Exit Function
End If
End If
GoTo Continue
End If
If attr <> vbNormal And attr <> vbArchive Then
'//This is either a read-only, hidden or system file
'//Let's fix that... (you can run, but you can't hide!)
SetAttr Path & fil, vbNormal
End If
'//Should be OK to delete now...
Kill Path & fil
Continue:
fil = Dir
Continue2:
Wend
'//Once we're done, we should be able to remove the directory, unless it's
'//the root or one or more files were in use at the time we tried to delete them
Err = 0
RmDir Path
'//Indicate success (or failure) to the caller
Deltree = (Err = 0)
End Function
|
