以编程方式复制文件夹以模仿用户复制/粘贴的方式并在复制过程中更新进度条？

如何解决以编程方式复制文件夹以模仿用户复制/粘贴的方式并在复制过程中更新进度条？

我想模拟一个文件夹复制，如果用户在 Windows 资源管理器中复制/粘贴它会发生什么（保留所有文件/目录属性，复制所有子文件夹和相同结构的文件等），并且可以在复制过程中更新进度条。

FileSystem.copy 是一个很棒的函数，可以模拟用户复制/粘贴，但我无法在使用该函数的复制过程中更新进度条。

我发现能够实现这一点的唯一方法是编写自定义函数，因此可以将 ProgressBar.Maximum 设置为文件夹的大小，并且 ProgressBar.Value 在每个人之后更新文件复制。

这个函数正在变成很多代码来实现一些看起来很简单的东西。我也不能忽视这样一种观念，因为这是定制的，我做错了我只是不知道要测试的东西。例如，如果我正在测试的文件夹没有空的子文件夹和隐藏文件夹，我永远不会针对这些内容进行调整。

所以我不得不怀疑我是否忽略了一些更简单的东西来实现同样的目标。

我的代码如下：

Private Sub copyFolderWithProgress(folderTocopy As String,newFolder As String,progBar As ProgressBar)

    'Validate folder to copy
    If Directory.Exists(folderTocopy) Then
        If folderTocopy.Substring(folderTocopy.Length - 1) <> "\" Then
            folderTocopy &= "\"
        End If
    Else
        MsgBox("Invalid directory given: " & folderTocopy)
        End
    End If

    'Validate new folder
    If Directory.Exists(newFolder) Then
        If newFolder.Substring(newFolder.Length - 1) <> "\" Then
            newFolder &= "\"
        End If
    Else
        MsgBox("Invalid directory given: " & newFolder)
        End
    End If

    'Create folderTocopy as a new subfolder of newFolder
    newFolder &= New DirectoryInfo(folderTocopy).Name & "\"
    Dim di As DirectoryInfo
    di = Directory.CreateDirectory(newFolder)
    di.Attributes = New DirectoryInfo(folderTocopy).Attributes

    'Create all subfolders
    For Each thisDir In Directory.GetDirectories(folderTocopy,"*",SearchOption.AllDirectories)

        Dim thisDirRelative = thisDir.Remove(0,Len(folderTocopy))

        di = Directory.CreateDirectory(newFolder & thisDirRelative)
        di.Attributes = New DirectoryInfo(thisDir).Attributes
    Next

    'Determine size of all files for progress bar
    Dim dirsize As Long
    For Each curFile In Directory.GetFiles(folderTocopy,SearchOption.AllDirectories)
        dirsize += FileLen(curFile)
    Next

    'Set progress bar 100% to size of all files
    progBar.Value = 0
    progBar.Maximum = dirsize

    'copy all files into correct folder and update progress bar
    For Each curFile In Directory.GetFiles(folderTocopy,SearchOption.AllDirectories)

        'Get name of file
        Dim curFileName = Path.GetFileName(curFile)

        'Determine if file is in a subfolder of filetopcopy
        Dim curFileDir = Path.GetDirectoryName(curFile) + "\"
        Dim curFileSubfolders = curFile.Substring(0,curFile.IndexOf(curFileName)).Replace(folderTocopy,"")

        'copy file
        If File.Exists(curFile) Then
            File.copy(curFile,newFolder & curFileSubfolders & curFileName)
        Else
            Console.Write("Issue copying a file that should exist in source folder: " & curFile)
        End If

        'Update Progress Bar
        progBar.Value += FileLen(curFile)
    Next
End Sub