大家好，高分求教文件操作源码

Question

    如何用程序来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 
   
　
  
 

Answer 1

    采用递归算法删除带有多级子目录的目录
 
　Option ExplicitPrivate Sub Command1_Click()
Dim strPathName As String
strPathName = ""
strPathName = InputBox("请输入需要删除的文件夹名称∶", "删除文件夹")
If strPathName = "" Then Exit SubOn Error GoTo ErrorHandle
SetAttr strPathName, vbNormal '此行主要是为了检查文件夹名称的有效性
RecurseTree strPathName
Label1.Caption = "文件夹" & strPathName & "已经删除！"
Exit Sub
ErrorHandle:
MsgBox "无效的文件夹名称:" & strPathName
End SubSub RecurseTree(CurrPath As String)
Dim sFileName As String
Dim newPath As String
Dim sPath As String
Static oldPath As StringsPath = 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
 
   
　
  
 

Answer 2

复制或移动整个文件夹As shown in Utilizing Windows Recycle Bin and Utilizing Windows SHFileOperation API, Advanced, Windows offers 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, for simplicity, 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!! 
  
 
 
 BAS Module Code 
  
Place the following API declare code into the general declarations area of a bas module. If this is a one-form project, the declares below could be placed into the general declaration section of the form instead, with all Public references changed to Private. --------------------------------------------------------------------------------
 
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Public 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 = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public 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 Long
End Type
   
Public Const ERROR_SUCCESS As Long = 0
Public Const CSIDL_DESKTOP As Long = &H0   
Public Const BIF_RETURNONLYFSDIRS As Long = &H1
Public Const BIF_STATUSTEXT As Long = &H4
Public Const BIF_RETURNFSANCESTORS As Long = &H8
'--end block--'
 
 
 Form Code 
  
Start a new project, and to the form add: 
four command buttons (Command1(0), Command1(1), Command2 and Command3) 
two text boxes (Text1 and Text2) 
an array of option buttons (Option1(1) and Option1(2), assuring that the indexes are as indicated 
an array of check boxes (Check1(0) - Check1(5)). 
Set the Locked property (VB5/VB6 only) for both text boxes to True, and set the control captions as indicated in the illustration. Finish the form off by adding labels. The frames used in the example are optional.Add the following to the form:
 --------------------------------------------------------------------------------
 
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()   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 Sub

Answer 3

接上面Private 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 Sub
Private 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 Sub
Private Sub Command3_Click()   Unload Me
   
End Sub
Private Sub Option1_Click(Index As Integer)  'set the file action flag
   FO_FUNC = CLng(Index)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 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 Function
Private 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
'--end block--'
 
 
 Comments 
Run the project and select both a source folder (the folder to copy or move) and a destination for it. The destination can be another folder on the same drive, on a different drive, or the drive root. Select a move or copy action, and any of the options you would like to test. Selecting the item "Rename the file if it already exists" will perform the action and create a new folder with the prefix "Copy of" should a folder of the same name already exists. 
The code in the Command2_Click sub checks to see whether the "Whoa!! Prompt me before doing it!!" check button has been selected. If it has (recommended), a messagebox pops up providing a last-chance to abort the procedure.Finally, when a folder is about to be copied overtop an existing folder, and if the "Don't prompt for confirmation" checkbox is not checked, then the overwrite dialog will appear as shown.

Answer 4

SHFileOperation 是个功能强大哦函数，只不过不利于我们学习其中的操作过程，只有一步一步的学习了，文件拷贝很容易用Fso实现，主要是目录我先构思创建深层目录的方法首先设定Text1.text="aa\bb\cccc\dddd"
在"e:\"下建立目录，代码如下：
Private Sub Command1_Click()
Dim fs As New FileSystemObject
Dim fd As Folder
Dim f As File
Dim k As Integer
Dim tt, kk As String
Dim str As Variantstr = Split(Text1.Text, "\")
If Len(str(UBound(str))) > 3 Then '判断文件/目录
    If Mid(str(UBound(str)), Len(str(UBound(str))) - 3, 1) = "." Then
    Debug.Print "yes"
        k = 0
        tt = ""
        Do While k < UBound(str) '少一个等号，就是少一个数
        tt = tt + str(k) + "\"
        MkDir "E:\" + tt
        Debug.Print tt
        k = k + 1
        Loop
        GoTo lab:
    End If
End If
    k = 0
    tt = ""
    Do While k <= UBound(str)
        tt = tt + str(k) + "\"
        MkDir "E:\" + tt
        Debug.Print tt
        k = k + 1
        Loop
lab:
End Sub

Answer 5

SHFileOperation 是个功能强大的函数哦，只不过不利于我们学习其中的操作过程，只有一步一步的学习了，文件拷贝很容易用Fso实现，主要是目录我先构思创建深层目录的方法首先设定Text1.text="aa\bb\cccc\dddd"
在"e:\"下建立目录，代码如下：
Private Sub Command1_Click()
Dim fs As New FileSystemObject
Dim fd As Folder
Dim f As File
Dim k As Integer
Dim tt, kk As String
Dim str As Variantstr = Split(Text1.Text, "\")
If Len(str(UBound(str))) > 3 Then '判断文件/目录
    If Mid(str(UBound(str)), Len(str(UBound(str))) - 3, 1) = "." Then
    Debug.Print "yes"
        k = 0
        tt = ""
        Do While k < UBound(str) '少一个等号，就是少一个数
        tt = tt + str(k) + "\"
        MkDir "E:\" + tt
        Debug.Print tt
        k = k + 1
        Loop
        GoTo lab:
    End If
End If
    k = 0
    tt = ""
    Do While k <= UBound(str)
        tt = tt + str(k) + "\"
        MkDir "E:\" + tt
        Debug.Print tt
        k = k + 1
        Loop
lab:
End Sub

Answer 6

这是我构思的方法，原理很简单，不过可以我自己的东西哦！：），接下来的问题可就不好办了，遍历目录树及其底下的文件可真头疼，你也许问我有简单方法不用，为什么找复杂的方法？其实我们的目的就是学习，HFileOperation函数的操作不可控，比如说：让什么养的文件和目录不能删除、拷贝，很有意义哦，特别是你编一些应用软件时。