确保文件完成写入磁盘的可靠方法

Question

我经常依赖外部工具从 VBA 创建文件：7zip、扫描应用程序等。我需要一种可靠的方法来了解文件何时完成写入并可以安全地用于其他操作 （包括将其传递给其他外部程序；例如，电子邮件等）。

以下是假设：

• 我无法控制文件的写入
• 文件可能在也可能不在网络文件服务器上
• 在文件写入之前我不知道文件的内容

因为我无法控制文件的写入，所以我不能将CreateFile 与 FILE_FLAG_WRITE_THROUGH 一起使用。

因为文件可能在网络文件服务器上，我对使用FlushFileBuffers 的性能影响持怀疑态度。我也不确定它会做我想要的。

因为我不提前知道文件的内容，所以无法比较哈希来检查文件的完整性。

我使用了简单的技术，例如使用Dir() 来确保文件存在，但这似乎不可靠。我也尝试过暂停然后重试操作，直到它起作用或超过我设置的超时时间。我还尝试使用独占锁打开文件并捕获错误以测试文件是否仍在使用中。

这些解决方案都在一定程度上奏效，但似乎都不太理想。

这是一个导致经常头痛的一般问题。结果是难以重现和排除故障的竞争条件。有没有比我已经尝试过的更好的方法？

更新：

正如@JasonFaulkner 在 cmets 中指出的那样，如果不提前知道内容，就不可能100% 确定文件已成功写入。除此之外，我想要最有效和最可靠的方法来确定是否满足以下条件：

• 文件存在
• 没有程序访问该文件
• 缓存中没有数据等待写入物理磁盘

Answer 1

我提出了以下程序来检查文件是否准备就绪。我愿意接受任何我可能错过的改进或问题的建议。

目前，这是作为一个 Sub 实现的，如果文件未准备好并且重试尝试已用尽，则会引发错误。如果文件准备好了，那么 sub 就不会大张旗鼓地完成。

以下声明位于模块顶部：

'----- VerifyFileReady declarations ----------------------------------------------------
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function CreateFile Lib "kernel32" Alias _
                                    "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
                                                   ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
                                                   ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
                                                   ByVal hTemplateFile As Long) As Long
Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_ALL = &H10000000
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" _
                                     (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
                                 (ByVal hFile As Long) As Long
'perform 64-bit arithmetic (see: http://support.microsoft.com/kb/189862)
Private Type Curr64Bit
    Value As Currency
End Type

Private Type LongsAs64Bit
    LoValue As Long
    HiValue As Long
End Type
'=======================================================================================

这是 sub 本身，以及一个小的帮助函数，用于对可能超过 2GB 的文件执行文件大小比较：

'---------------------------------------------------------------------------------------
' Procedure : VerifyFileReady
' Author    : Mike
' Date      : 1/22/2015
' Purpose   : Confirm that a file is ready for use; commonly used before passing a
'               filename to an outside entity for processing (e.g., a PDF printer,
'               compression utility, email, etc.)
' Parameters:
'   FName           The name of the file
'   MinSizeInBytes  The minimum file size before confirming a file is ready;
'                       by default, the file must be non-empty
'   RetryAttempts   The number of times to retry if a file is not ready
'   DelayInMs       The amount of time to sleep between retries
'   FailureMsg      Set to the reason the file is not ready; passed By Reference so that
'                       the most recent msg will be raised if necessary
'
' Notes     - Acts as a gate: if the file is ready, the program continues on; otherwise
'               an error is thrown after the number of retry ettampts is exhausted
'           - To get the maximum program delay this function will cause, multiply the
'               RetryAttempts by the DelayInMs; by default the program will delay a
'               maximum of 5 seconds (10 attempts * 500 ms delay per retry attempt)
'           - By ready for use, we mean the file meets the following criteria:
'               o the file exists
'               o the file is not locked by another process
'               o the file buffers have been flushed
'               o the file meets the minimum size in bytes (by default, it's not empty)
'           - There's no way to *really* be sure that the file has been written to disk,
'               so this function cannot guarantee transactional integrity
'---------------------------------------------------------------------------------------
'
Sub VerifyFileReady(ByVal FName As String, _
                    Optional ByVal MinSizeInBytes As Long = 1, _
                    Optional ByVal RetryAttempts As Integer = 10, _
                    Optional ByVal DelayInMs As Integer = 500, _
                    Optional ByRef FailureMsg As String = vbNullString)
    Dim FileIsReady As Boolean
    FileIsReady = True

    On Error GoTo Err_VerifyFileReady

    'FlushFileBuffers requires GENERIC_WRITE access
    Dim DesiredAccess As Long
    DesiredAccess = GENERIC_READ Or GENERIC_WRITE

    'Open the file (CreateFile is a generic function that replaces the deprecated OpenFile)
    Dim hFile As Long    'File Handle
    Err.Clear    'explicitly flush the Err.LastDllError property
    hFile = CreateFile(FName, DesiredAccess, 0, 0, OPEN_EXISTING, 0, 0)

    Dim FileOpenFailed As Boolean
    Const INVALID_HANDLE_VALUE = -1
    FileOpenFailed = (hFile = INVALID_HANDLE_VALUE)
    If FileOpenFailed Then
        FileIsReady = False
        Select Case Err.LastDLLError
        Case 2: FailureMsg = "The system cannot find the file specified."    'ERROR_FILE_NOT_FOUND
        Case 3: FailureMsg = "The system cannot find the path specified."    'ERROR_PATH_NOT_FOUND
        Case 4: FailureMsg = "The system cannot open the file."    'ERROR_TOO_MANY_OPEN_FILES
        Case 5: FailureMsg = "Access is denied."    'ERROR_ACCESS_DENIED
        Case 15: FailureMsg = "The system cannot find the drive specified."    'ERROR_INVALID_DRIVE
        Case 20: FailureMsg = "The system cannot find the device specified."    'ERROR_BAD_UNIT
        Case 21: FailureMsg = "The device is not ready."    'ERROR_NOT_READY
        Case 32: FailureMsg = "The process cannot access the file because it is being used by another process."    'ERROR_SHARING_VIOLATION
        Case 33: FailureMsg = "The process cannot access the file because another process has locked a portion of the file."    'ERROR_LOCK_VIOLATION
        Case Else: FailureMsg = "CreateFile function failed with error number " & Err.LastDLLError & "."
        End Select
    End If

    If FileIsReady Then
        'be sure the file has been physically written to disk
        Dim FlushResults As Long
        FlushResults = FlushFileBuffers(hFile)

        Dim FlushFailed As Boolean
        FlushFailed = (FlushResults = 0)
        If FlushFailed Then
            FileIsReady = False
            Select Case Err.LastDLLError
            Case 5: FailureMsg = "FlushFileBuffers function failed: Access is denied."    'ERROR_ACCESS_DENIED
            Case Else: FailureMsg = "FlushFileBuffers function failed with error number " & Err.LastDLLError & "."
            End Select
        End If
    End If

    'check that the file meets the minimum size requirement
    '   (MinSizeInBytes parameter may not exceed 2GB, but actual
    '    file sizes beyond 2GB are allowed and will be treated correctly)
    If FileIsReady And MinSizeInBytes > 0 Then
        Dim FSize64 As Curr64Bit
        Dim FileSizeLow As Long, FileSizeHigh As Long
        FileSizeLow = GetFileSize(hFile, FileSizeHigh)
        Const GetFileSizeError As Long = &HFFFFFFFF

        If FileSizeLow = GetFileSizeError Then
            FileIsReady = False
            FailureMsg = "Error getting file size."
        ElseIf TwoLongsTo64(FileSizeLow, FileSizeHigh).Value < TwoLongsTo64(MinSizeInBytes, 0).Value Then
            FileIsReady = False
            FailureMsg = "File smaller than minimum size of " & MinSizeInBytes & " byte(s)."
        End If
    End If

    'close the handle or *we* will be the ones locking the file
    If hFile <> INVALID_HANDLE_VALUE Then CloseHandle hFile

    If Not FileIsReady Then
FileNotReady:
        If RetryAttempts > 0 Then
            'we can't just raise an error or the Resume would send us back to the Err.Raise statement;
            '   instead we make a recursive call and decrement the RetryAttempts to prevent a stack overflow
            Sleep DelayInMs
            On Error GoTo 0  'prevent infinite recursion
            VerifyFileReady FName, MinSizeInBytes, RetryAttempts - 1, DelayInMs, FailureMsg
            Exit Sub
        Else
            On Error GoTo 0
            Err.Raise vbObjectError + 44212312, "FileFunctions.VerifyFileReady", FailureMsg
        End If
    End If

    Exit Sub

Err_VerifyFileReady:
    FailureMsg = "Error " & Err.Number & ": " & Err.Description
    Resume FileNotReady
End Sub

'64-bit arithmetic in VBA: http://support.microsoft.com/kb/189862
Function TwoLongsTo64(LowVal As Long, HighVal As Long) As Curr64Bit
    Dim L As LongsAs64Bit
    L.HiValue = HighVal
    L.LoValue = LowVal
    LSet TwoLongsTo64 = L
End Function