关于SHFileOperation这个API的问题
[VB]
'-------------模块------------------------------
Option Explicit
Private Const FO_MOVE = &H1 '移动
Private Const FO_COPY = &H2 '复制
Private Const FO_DELETE = &H3 '删除
Private Const FO_RENAME = &H4 '改名
Private Const FOF_NOCONFIRMATION = &H10 '没有提示
Private Const FOF_SILENT = &H4 '不显示进度框
Private Const FOF_NOERRORUI = &H400 '如果有错误，不显示用户界面
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd As Long '句柄
wFunc As Long '操作命令
pFrom As String '源文件夹
pTo As String '目标文件夹
fFlags As Integer '标志
fAnyOperationsAborted As Long '如果用户退出，该成员为True，否则为False
hNameMappings As Long '不详
lpszProgressTitle As String '进度框标题，当取 FOF_SIMPLEPROGRESS 时，此参数才被使用
End Type
Private Function FileDeal(ByVal FormPath As String, ByVal ToPath As String, ByVal sOrder As String) As Boolean
On Error GoTo Err
Dim sPath As SHFILEOPSTRUCT
SetAttr FormPath, vbNormal '此行主要是为了检查目录的有效性
With sPath
.hwnd = 0
.wFunc = sOrder
.pFrom = FormPath
.pTo = ToPath
.fFlags = FOF_NOCONFIRMATION Or FOF_SILENT Or FOF_NOERRORUI
End With
FileDeal = Not CBool(SHFileOperation(sPath))
Err:
Exit Function
End Function
[/vb]
目前我使用这个方式删除含有大量文件的目录会导致程序假死（未响应），只能选择用递归方式一个文件一个文件的删除，但是感觉速度有点慢，不知道各位前辈有什么好的办法没。
[解决办法]
'Example Name:How to Copy or Move an Entire Directory using the API '------------------------------------------'' BAS Moduel Code''------------------------------------------Option ExplicitPublic Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type Public Const FO_MOVE As Long = &H1Public Const FO_COPY As Long = &H2Public Const FO_DELETE As Long = &H3Public Const FO_RENAME As Long = &H4Public Const FOF_SILENT As Long = &H4Public Const FOF_RENAMEONCOLLISION As Long = &H8Public Const FOF_NOCONFIRMATION As Long = &H10Public Const FOF_SIMPLEPROGRESS As Long = &H100Public Const FOF_ALLOWUNDO As Long = &H40Public Declare Function GetTempPath Lib "kernel32" _ Alias "GetTempPathA" _ (ByVal nSize As Long, ByVal lpBuffer As String) As LongPublic Declare Function SHFileOperation Lib "shell32" _ Alias "SHFileOperationA" _ (lpFileOp As SHFILEOPSTRUCT) As Long 'we'll use Brad's Browse For Folders Dialog code to 'enable the user to pick the source and destination folders. Public Declare Function SHGetPathFromIDList Lib "shell32" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Public Declare Function SHGetSpecialFolderLocation Lib "shell32" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ pidl As Long) As Long Public Declare Function SHBrowseForFolder Lib "shell32" _ Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Public Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As LongEnd Type Public Const ERROR_SUCCESS As Long = 0Public Const CSIDL_DESKTOP As Long = &H0 Public Const BIF_RETURNONLYFSDIRS As Long = &H1Public Const BIF_STATUSTEXT As Long = &H4Public Const BIF_RETURNFSANCESTORS As Long = &H8'--end block--''------------------------------------------'' Form Code''------------------------------------------Option Explicit'FO_FUNC - the File Operation to perform,'determined by the type of SHFileOperation'action chosen (move/copy)Dim FO_FUNC As Long 'for ease of reading, constants are substituted'for SHFileOperation numbers in codeConst FileMove As Integer = 1Const FileCopy As Integer = 2 'Check button index constantsConst optSilent As Integer = 0Const optNoFilenames As Integer = 1Const optNoConfirmDialog As Integer = 2Const optRenameIfExists As Integer = 3Const optPromptMeFirst As Integer = 4'strings to hold the pathsDim source As StringDim destination As String Private Sub Form_Load() Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 Option1(FileCopy).Value = True Command1(0).Caption = "Select Source" Command1(1).Caption = "Select Target" Command2.Caption = "Perform Action" Command3.Caption = "End" End SubPrivate Sub Command1_Click(Index As Integer) Dim tmp As String Select Case Index Case 0: tmp = GetBrowseFolder("Select the SOURCE to move or copy:") If tmp > "" Then source = tmp Text1.Text = source End If Case 1: tmp = GetBrowseFolder("Select the folder DESTINATION:") If tmp > "" Then destination = tmp Text2.Text = destination End If End SelectEnd SubPrivate Sub Command2_Click() Dim msg As String Dim action As Boolean 'First, assume the user WILL want to perform the 'action, in case they don't want prompting action = True 'check if they've asked to be prompted about the action... If Check1(optPromptMeFirst).Value = 1 Then msg = "You have chosen to move or copy the folder and contents of :" & vbCrLf msg = msg & source & vbCrLf & vbCrLf msg = msg & "to the destination:" & vbCrLf msg = msg & destination & vbCrLf & vbCrLf msg = msg & "Are you sure that you want to proceed with this action?" 'since they want to be prompted, set the action 'based on their response to a messagebox. ' 'Two buttons are presented - Yes and No. ' 'If No is selected, the the return value from the 'messagebox is vbNo. When that is compared with 'vbYes in the expression, the result is FALSE, therefore 'the action variable will be set to false. ' 'If Yes is selected, the the return value from the 'messagebox is vbYes, which equals vbYes, therefore 'the expression will return TRUE to the action variable action = MsgBox(msg, vbExclamation Or vbYesNo, "Warning") = vbYes End If If action = True Then PerformShellAction source, destination End If End SubPrivate Sub Command3_Click() Unload Me End SubPrivate Sub Option1_Click(Index As Integer) 'set the file action flag FO_FUNC = CLng(Index)End SubPublic Function PerformShellAction(sSource As String, _ sDestination As String) As Long Dim FOF_FLAGS As Long Dim SHFileOp As SHFILEOPSTRUCT 'terminate the folder string with a pair of nulls sSource = sSource & Chr$(0) & Chr$(0) 'determine the user's options selected FOF_FLAGS = BuildBrowseFlags() 'set up the options With SHFileOp .wFunc = FO_FUNC .pFrom = sSource .pTo = sDestination .fFlags = FOF_FLAGS End With 'and perform the chosen copy or move operation PerformShellAction = SHFileOperation(SHFileOp)End FunctionPrivate Function BuildBrowseFlags() As Long 'Iterate through the options, and build 'the flag variable according to the user selection. Dim flag As Long 'these can be multiple If Check1(optSilent).Value Then flag = flag Or FOF_SILENT If Check1(optNoFilenames).Value Then flag = flag Or FOF_SIMPLEPROGRESS If Check1(optNoConfirmDialog).Value Then flag = flag Or FOF_NOCONFIRMATION If Check1(optRenameIfExists).Value Then flag = flag Or FOF_RENAMEONCOLLISION BuildBrowseFlags = flagEnd FunctionPrivate Function GetBrowseFolder(msg) As String Dim pidl As Long Dim pos As Integer Dim path As String Dim bi As BROWSEINFO 'Fill the BROWSEINFO structure with the needed data, 'show the browse dialog, and if the returned value 'indicates success (1), retrieve the user's 'selection contained in pidl With bi .hOwner = Me.hWnd .pidlRoot = CSIDL_DESKTOP .lpszTitle = msg .ulFlags = BIF_RETURNONLYFSDIRS End With pidl = SHBrowseForFolder(bi) path = Space$(512) If SHGetPathFromIDList(ByVal pidl, ByVal path) = 1 Then pos = InStr(path, Chr$(0)) GetBrowseFolder = Left(path, pos - 1) End IfEnd Function