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

时间:2015-01-22 18:09:15

标签: vba file file-io

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

以下是假设:

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

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

由于文件可能位于网络文件服务器上,因此我对使用FlushFileBuffers对性能的影响持怀疑态度。我也不确定它能做我想做的事。

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

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

这些解决方案在某种程度上都有效,但它们似乎都不太理想。

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

更新

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

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

1 个答案:

答案 0 :(得分: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