我经常依赖外部工具从VBA创建文件:7zip,扫描应用程序等。我需要一种可靠的方法来了解文件写完的时间并可以安全地用于其他操作 (包括将其传递给其他外部程序;例如,电子邮件等)。
以下是假设:
因为我无法控制文件的写入,所以我不能将CreateFile与FILE_FLAG_WRITE_THROUGH一起使用。
由于文件可能位于网络文件服务器上,因此我对使用FlushFileBuffers对性能的影响持怀疑态度。我也不确定它能做我想做的事。
因为我提前不知道文件的内容,所以我无法比较哈希来检查文件的完整性。
我使用了简单的技术,例如使用Dir()
来确保文件存在,但这似乎不可靠。我也试过暂停然后重试一个操作,直到它工作或超过我设置的一些超时。我还尝试使用独占锁打开文件并捕获错误以测试文件是否仍在使用中。
这些解决方案在某种程度上都有效,但它们似乎都不太理想。
这是一个导致经常头痛的一般问题。结果是竞争条件难以重现和故障排除。有没有比我已经尝试过的更好的方法?
更新:
正如@JasonFaulkner在评论中指出的那样,如果不提前知道内容,就不可能 100%确定文件已成功写入。除此之外,我想要确定满足以下条件的最有效和最可靠的方法:
答案 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