谁有删除当前目录下所有子目录及其文件的函数

[coolydy]

请问，谁有删除当前目录下所有子目录及其文件的函数，最好是递归的

[coolydy]

我现在急用，各位大虾帮忙，谢谢

[lihonggen0]

采用递归算法删除带有多级子目录的目录

　



Option Explicit

Private Sub Command1_Click()
Dim strPathName As String
strPathName = ""
strPathName = InputBox("请输入需要删除的文件夹名称∶", "删除文件夹")
If strPathName = "" Then Exit Sub

On Error GoTo ErrorHandle
SetAttr strPathName, vbNormal '此行主要是为了检查文件夹名称的有效性
RecurseTree strPathName
Label1.Caption = "文件夹" & strPathName & "已经删除！"
Exit Sub
ErrorHandle:
MsgBox "无效的文件夹名称:" & strPathName
End Sub

Sub RecurseTree(CurrPath As String)
Dim sFileName As String
Dim newPath As String
Dim sPath As String
Static oldPath As String

sPath = CurrPath & "\"

sFileName = Dir(sPath, 31) '31的含义∶31=vbNormal+vbReadOnly+vbHidden+vbSystem+vbVolume+vbDirectory
Do While sFileName <> ""
If sFileName <> "." And sFileName <> ".." Then
If GetAttr(sPath & sFileName) And vbDirectory Then '如果是目录和文件夹
newPath = sPath & sFileName
RecurseTree newPath
sFileName = Dir(sPath, 31)
Else
SetAttr sPath & sFileName, vbNormal
Kill (sPath & sFileName)
Label1.Caption = sPath & sFileName '显示删除过程
sFileName = Dir
End If
Else
sFileName = Dir
End If
DoEvents
Loop
SetAttr CurrPath, vbNormal
RmDir CurrPath
Label1.Caption = CurrPath
End Sub




　

[dbcontrols]

Private Declare Function CreateDirectoryEx Lib "kernel32" Alias "CreateDirectoryExA" (ByVal lpTemplateDirectory As String, ByVal lpNewDirectory As String, lpSecurityAttributes As Any) As Long
Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [e-mail]
'Create a new directory
CreateDirectoryEx "C:\Windows", "C:\KPD-Team", ByVal 0&
'remove the directory
RemoveDirectory "C:\KPD-Team"
End Sub

[coolydy]

谢谢，我先试一试

[lihonggen0]

如何用程序来Delete Copy Move Rename File/Directory

作者: 王国荣　

Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
End Type
'wFunc 的设定值
'FO_COPY Copies the files specified by pFrom to the location specified by pTo.
'FO_DELETE Deletes the files specified by pFrom (pTo is ignored).
'FO_MOVE Moves the files specified by pFrom to the location specified by pTo.
'FO_RENAME Renames the files specified by pFrom.

'fFlag的设定
'FOF_ALLOWUNDO Preserves undo information, if possible.
'FOF_FILESONLY Performs the operation only on files if a wildcard filename
' (*.*) is specified.
'FOF_MULTIDESTFILES Indicates that the pTo member specifies multiple destination
' files (one for each source file) rather than one directory where
' all source files are to be deposited.
'FOF_NOCONFIRMATION Responds with "yes to all" for any dialog box that is displayed.
'FOF_NOCONFIRMMKDIR Does not confirm the creation of a new directory if
' the operation requires one to be created.
'FOF_RENAMEONCOLLISION Gives the file being operated on a new name (such as
' "Copy #1 of...") in a move, copy, or rename operation
' if a file of the target name already exists.
'FOF_SILENT Does not display a progress dialog box.
'FOF_SIMPLEPROGRESS Displays a progress dialog box, but does not show the
' filenames.
'FOF_WANTMAPPINGHANDLE Fills in the hNameMappings member. The handle must be
' freed by using the SHFreeNameMappings function.

Const FO_MOVE = &H1
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FOF_NOCONFIRMATION = &H10
Const FOF_NOCONFIRMMKDIR = &H200
Const FOF_ALLOWUNDO = &H40
Const FOF_SILENT = &H4


Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

'删除 test目录及其底下的子目录到资源回收桶
Private Sub Command1_Click()
Dim SHFileOp As SHFILEOPSTRUCT

SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = "c:\test" + Chr(0)
'不出现档案删除的动态AVI，且不Confirm
SHFileOp.fFlags = FOF_SILENT + FOF_ALLOWUNDO + FOF_NOCONFIRMATION
'若没有 FOF_ALLOWUNDO 则不会到资源回收桶
Call SHFileOperation(SHFileOp)
End Sub

'同时删除多档到资源回收桶
Private Sub Command2_Click()
Dim SHFileOp As SHFILEOPSTRUCT
Dim Files As String
'Files = "c:\test.txt" + Chr(0)
Files = "c:\test1.txt" + Chr(0) + "c:\test2.txt" + Chr(0) + _
"c:\test3.txt" + Chr(0)
SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = Files
'删至资源回收桶，且不Confirm
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
End Sub

'将 c:\temp 整个目录复制到 c:\temp2
Private Sub Command3_Click()
Dim SHFileOp As SHFILEOPSTRUCT

SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = "c:\temp\*.*"
SHFileOp.pTo = "c:\temp2\*.*"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
Call SHFileOperation(SHFileOp)
End Sub

'将 c:\test4.txt 快速移到 c:\temp 目录
Private Sub Command4_Click()
Dim SHFileOp As SHFILEOPSTRUCT

SHFileOp.wFunc = FO_MOVE
SHFileOp.pFrom = "c:\test4.txt" + Chr(0)
SHFileOp.pTo = "c:\temp"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
End Sub