| Description:Using the SHFileOperation API, you can easily move or copy entire directories, including all subdirectories. Windows 95 and NT4 offer the option of sending files to the recycle bin using the SHFileOperation API. However, this same API can also be used to copy individual files, or, as detailed below, to copy or move an entire folder and its contents, including subfolders, to a new destination. It must be noted up front that the following code does not provide for any checking of the validity of the source or destinations selection, nor does it distinguish between a folder and a drive. Therefore, use caution, or you could accidentally copy drive C:\ into a folder!! Start a new project, and create a form like the illustration: add a four command buttons (cmdGetFolders(0), cmdGetFolders(1), cmdPerform and cmdEnd), two text boxes (txtSource and txtDestination), an array of option buttons (optSHFileAction(1) and optSHFileAction(2), and an array of check boxes (chkOptions(0) - chkOptions(5)). Set the Locked property (VB5) for both text boxes to True, and captions of the controls. Finish the form off by adding labels. Public Type SHFILEOPSTRUCT hWndAs Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAbortedAs Boolean hNameMaps As Long sProgressAs String End Type Public Const FO_MOVE = &H1 Public Const FO_COPY = &H2 Public Const FOF_SILENT = &H4 Public Const FOF_RENAMEONCOLLISION = &H8 Public Const FOF_NOCONFIRMATION = &H10 Public Const FOF_SIMPLEPROGRESS = &H100 Public Const FOF_ALLOWUNDO = &H40 Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _ (lpFileOp As SHFILEOPSTRUCT) As Long Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nSize As Long, ByVal lpBuffer As String) As Long 'we'll use Brad's Browse For Folders Dialog code to enable the user to pick the source and destination folders. Type SHITEMID cb As Long abID As Byte End Type Type ITEMIDLIST mkid As SHITEMID End Type Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ pidl As ITEMIDLIST) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Public Type BROWSEINFO hOwnerAs Long pidlRoot As Long pszDisplayNameAs String lpszTitleAs String ulFlags As Long lpfn As Long lParamAs Long iImageAs Long End Type Public Const NOERROR = 0 Public Const CSIDL_DESKTOP = &H0 Public Const BIF_RETURNONLYFSDIRS = &H1 Public Const BIF_STATUSTEXT = &H4 Public Const BIF_RETURNFSANCESTORS = &H8 '*************************************************************** Add the following code to the general declarations section of Form1. 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 code Const FileMove As Integer = 1 Const FileCopy As Integer = 2 'Check button index constants Const optSilent As Integer = 0 Const optNoFilenames As Integer = 1 Const optNoConfirmDialog As Integer = 2 Const optRenameIfExists As Integer = 3 Const optPromptMeFirst As Integer = 4 'strings to hold the paths Dim source As String Dim destination As String Private Sub Form_Load() optSHFileAction(FileCopy).Value = True End Sub Private Sub cmdEnd_Click() Unload Me Set Form1 = Nothing End End Sub Public 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 Function Private Sub cmdGetFolders_Click(Index As Integer) Dim tmp As String Select Case Index Case 0 tmp = GetBrowseFolder("Select the SOURCE folder to move or copy:") If tmp > "" Then source = tmp txtSource = source End If Case 1 tmp = GetBrowseFolder("Select the folders DESTINATION for the action:") If tmp > "" Then destination = tmp txtDestination = destination End If End Select End Sub Private Sub cmdPerform_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 chkOptions(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 prompeted, 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 Sub Private Sub optSHFileAction_Click(Index As Integer) 'set the file action flag FO_FUNC = CLng(Index) End Sub Private Function BuildBrowseFlags() As Long 'Iterate throught the options, and build the flag variable according to the user selection. Dim flag As Long 'First, start off empty flag = 0& 'these can be multiple If chkOptions(optSilent).Value Then flag = flag Or FOF_SILENT If chkOptions(optNoFilenames).Value Then flag = flag Or FOF_SIMPLEPROGRESS If chkOptions(optNoConfirmDialog).Value Then flag = flag Or FOF_NOCONFIRMATION If chkOptions(optRenameIfExists).Value Then flag = flag Or FOF_RENAMEONCOLLISION BuildBrowseFlags = flag End Function Private Function GetBrowseFolder(msg) As String Dim r As Long Dim pidl As Long Dim pos As Integer Dim path As String Dim bi As BROWSEINFO Dim IDL As ITEMIDLIST '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& bi.hOwner = Me.hWnd bi.pidlRoot = CSIDL_DESKTOP bi.lpszTitle = msg bi.ulFlags = BIF_RETURNONLYFSDIRS pidl& = SHBrowseForFolder(bi) path$ = Space$(512) r& = SHGetPathFromIDList(ByVal pidl&, ByVal path$) If r& = 1 Then pos = InStr(path$, Chr$(0)) GetBrowseFolder = Left(path$, pos - 1) End If End Function |
Copy or Move an Entire Directory using the API |
Express News India | Freelance ecommerce web development India