Hi,
below is the code I wrote (VB6) to delete a folder with it contents.
It is basically recursive function which uses FindFirstFile,
FindNextFile, FindClose and RemoveDirectory APIs.
The problem with the code is that it wouldn't delete
folders containing other folders (the innermost ones get deleted ok
though).
Although I made sure I close handles obtained with
FindFirstFile it still looks like somethig in my code
holds handles or something as I get error:
32 - The process cannot access the file because it is being used
by another process. The upper folders could not be deleted
until VB is closed.
Does anyone have an idea what's wrong?
Thanks,
Lex
Private Const MAX_PATH = 260
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const INVALID_HANDLE_VALUE = -1
Private Const DBG_FILENAME As String = "Test.bas"
Private Const ERROR_NO_MORE_FILES = 18&
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Declare Function FormatMessage Lib "Kernel32" Alias
"FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As
Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function FindFirstFile Lib "Kernel32" Alias
"FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As
Long
Private Declare Function FindNextFile Lib "Kernel32" Alias
"FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As
Long
Private Declare Function FindClose Lib "Kernel32" (ByVal hFindFile As
Long) As Long
Public Declare Function RemoveDirectoryAPI Lib "Kernel32" Alias
"RemoveDirectoryA" _
(ByVal lpPathName As String) As Long
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Sub RemoveDirectory(ByVal i_sPath As String)
On Error GoTo ErrorHandler
Dim nAttr As Integer
Dim fData As WIN32_FIND_DATA
Dim i_sPathS As String
Dim sCurFile As String
Dim bExitLoop As Boolean
Dim hFind As Long
Dim lError As Long
Dim sErrorDetails As String
Dim bOpen As Boolean
If Not Dir(i_sPath, vbNormal Or vbDirectory Or vbHidden Or
vbReadOnly Or vbSystem) = "" Then
nAttr = GetAttr(i_sPath)
If (nAttr And vbReadOnly) Then SetAttr i_sPath, nAttr And Not
vbReadOnly
If (nAttr And vbDirectory) = vbDirectory Then
i_sPathS = i_sPathS & IIf(Right(i_sPath, 1) = "\", "",
"\")
hFind = FindFirstFile(i_sPathS & "*.*", fData)
If hFind = INVALID_HANDLE_VALUE Then
lError = Err.LastDllError
sErrorDetails = String(512, 0)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, 0, lError,
0, _
sErrorDetails, Len(sErrorDetails),
0
Err.Raise lError, DBG_FILENAME, sErrorDetails
Else
bOpen = True
End If
Do
sCurFile = Left$(fData.cFileName,
InStr(fData.cFileName, vbNullChar) - 1)
If sCurFile <> "." And sCurFile <> ".." Then
If (fData.dwFileAttributes And vbDirectory) =
vbDirectory Then
RemoveDirectory i_sPathS & sCurFile
Else
If (fData.dwFileAttributes And vbReadOnly)
Then
SetAttr i_sPathS & sCurFile,
fData.dwFileAttributes And Not vbReadOnly
End If
Kill i_sPathS & sCurFile
End If
End If
If FindNextFile(hFind, fData) = 0 Then
lError = Err.LastDllError
hFind = FindClose(hFind)
bOpen = False
If lError <> ERROR_NO_MORE_FILES Then
sErrorDetails = String(512, 0)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, 0,
lError, 0, _
sErrorDetails, Len(sErrorDetails),
0
Err.Raise lError, DBG_FILENAME, sErrorDetails
End If
bExitLoop = True
End If
Loop Until bExitLoop
If RemoveDirectoryAPI(i_sPath) = 0 Then
lError = Err.LastDllError
sErrorDetails = String(512, 0)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, 0, lError,
0, _
sErrorDetails, Len(sErrorDetails), 0
Err.Raise lError, DBG_FILENAME, sErrorDetails
End If
Else
Kill i_sPath
End If
End If
Exit Sub
ErrorHandler:
If bOpen Then FindClose hFind
End Sub
