You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

如何实现不修改文件及文件夹属性的逐位精确复制?

在VB.NET中精确复制文件夹内容并保留属性的方法

传统的IO.File.Copy或My.Computer.FileSystem.CopyFile确实会丢失部分文件元数据(比如创建时间、自定义属性、NTFS权限等),要实现字节级精确复制+完整保留所有属性,可以用以下两种方案:

方案1:调用Windows原生API CopyFileEx

Windows的CopyFileEx API支持完整复制文件内容及所有元数据,是最可靠的方式。你可以在VB.NET中通过P/Invoke调用它:

首先声明API及相关枚举:

Imports System.Runtime.InteropServices

Public Class FileCopyHelper
    Public Enum CopyProgressAction As Integer
        PROGRESS_CONTINUE = 0
        PROGRESS_CANCEL = 1
        PROGRESS_STOP = 2
        PROGRESS_QUIET = 3
    End Enum

    Public Delegate Function CopyProgressRoutine(
        ByVal TotalFileSize As Long,
        ByVal TotalBytesTransferred As Long,
        ByVal StreamSize As Long,
        ByVal StreamBytesTransferred As Long,
        ByVal dwStreamNumber As Integer,
        ByVal dwCallbackReason As Integer,
        ByVal hSourceFile As IntPtr,
        ByVal hDestinationFile As IntPtr,
        ByVal lpData As IntPtr
    ) As CopyProgressAction

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
    Public Shared Function CopyFileEx(
        ByVal lpExistingFileName As String,
        ByVal lpNewFileName As String,
        ByVal lpProgressRoutine As CopyProgressRoutine,
        ByVal lpData As IntPtr,
        ByRef pbCancel As Boolean,
        ByVal dwCopyFlags As UInteger
    ) As Boolean
    End Function

    ' 复制标志:保留所有属性、元数据
    Public Const COPY_FILE_COPY_SECURITY_ATTRIBUTES As UInteger = &H40
    Public Const COPY_FILE_FAIL_IF_EXISTS As UInteger = &H10
End Class

然后封装递归复制文件夹的方法:

Public Sub CopyDirectoryWithMetadata(sourceDir As String, destDir As String)
    ' 创建目标文件夹并同步属性
    If Not Directory.Exists(destDir) Then
        Directory.CreateDirectory(destDir)
        Dim sourceDirInfo As New DirectoryInfo(sourceDir)
        Dim destDirInfo As New DirectoryInfo(destDir)
        destDirInfo.Attributes = sourceDirInfo.Attributes
        destDirInfo.CreationTime = sourceDirInfo.CreationTime
        destDirInfo.LastWriteTime = sourceDirInfo.LastWriteTime
        destDirInfo.LastAccessTime = sourceDirInfo.LastAccessTime
        destDirInfo.SetAccessControl(sourceDirInfo.GetAccessControl())
    End If

    ' 复制文件
    For Each file In Directory.GetFiles(sourceDir)
        Dim destFile = Path.Combine(destDir, Path.GetFileName(file))
        Dim cancel As Boolean = False
        Dim success = FileCopyHelper.CopyFileEx(
            file,
            destFile,
            Nothing, ' 无需进度回调则传Nothing
            IntPtr.Zero,
            cancel,
            FileCopyHelper.COPY_FILE_COPY_SECURITY_ATTRIBUTES Or FileCopyHelper.COPY_FILE_FAIL_IF_EXISTS
        )
        If Not success Then
            Throw New System.ComponentModel.Win32Exception(Marshal.GetLastWin32Error())
        End If
    Next

    ' 递归复制子文件夹
    For Each subDir In Directory.GetDirectories(sourceDir)
        Dim destSubDir = Path.Combine(destDir, Path.GetFileName(subDir))
        CopyDirectoryWithMetadata(subDir, destSubDir)
    Next
End Sub

方案2:手动字节级复制+同步元数据

如果不想依赖Win32 API,可以手动实现字节复制,再同步所有文件属性:

Public Sub CopyFileWithExactMetadata(sourcePath As String, destPath As String)
    ' 字节级复制文件内容
    Using sourceStream As New FileStream(sourcePath, FileMode.Open, FileAccess.Read, FileShare.Read)
        Using destStream As New FileStream(destPath, FileMode.Create, FileAccess.Write, FileShare.None)
            sourceStream.CopyTo(destStream)
        End Using
    End Using

    ' 同步文件属性与元数据
    Dim sourceFileInfo As New FileInfo(sourcePath)
    Dim destFileInfo As New FileInfo(destPath)
    destFileInfo.Attributes = sourceFileInfo.Attributes
    destFileInfo.CreationTime = sourceFileInfo.CreationTime
    destFileInfo.LastWriteTime = sourceFileInfo.LastWriteTime
    destFileInfo.LastAccessTime = sourceFileInfo.LastAccessTime
    destFileInfo.SetAccessControl(sourceFileInfo.GetAccessControl())
    
    ' 同步NTFS自定义属性(可选)
    For Each prop In sourceFileInfo.GetCustomAttributes(True)
        destFileInfo.SetCustomAttribute(prop.Name, prop.Value)
    Next
End Sub

' 递归复制文件夹的方法
Public Sub CopyDirectoryManually(sourceDir As String, destDir As String)
    If Not Directory.Exists(destDir) Then
        Directory.CreateDirectory(destDir)
        Dim sourceDirInfo As New DirectoryInfo(sourceDir)
        Dim destDirInfo As New DirectoryInfo(destDir)
        destDirInfo.Attributes = sourceDirInfo.Attributes
        destDirInfo.CreationTime = sourceDirInfo.CreationTime
        destDirInfo.LastWriteTime = sourceDirInfo.LastWriteTime
        destDirInfo.LastAccessTime = sourceDirInfo.LastAccessTime
        destDirInfo.SetAccessControl(sourceDirInfo.GetAccessControl())
    End If

    For Each file In Directory.GetFiles(sourceDir)
        CopyFileWithExactMetadata(file, Path.Combine(destDir, Path.GetFileName(file)))
    Next

    For Each subDir In Directory.GetDirectories(sourceDir)
        CopyDirectoryManually(subDir, Path.Combine(destDir, Path.GetFileName(subDir)))
    Next
End Sub

注意事项

  • 两种方案都需要足够的权限才能复制文件/文件夹的安全属性和元数据,否则会抛出权限异常。
  • 方案1的CopyFileEx支持断点续传(添加COPY_FILE_RESTARTABLE标志),处理大文件时性能更优。
  • 自定义文件属性的复制仅适用于NTFS文件系统,FAT32不支持该特性。

内容的提问来源于stack exchange,提问作者bernox

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.31 02:06:25