vba 来自 kernel32 的 dll 调用 writefile 创建了一个巨大的文件
vba dll call writefile from kernel32 creates huge file
我正在尝试使用 excel 2010 32 位中的 VBA7 和 windows 7 64 位中的 VBA7 将一个文本文件附加到另一个文本文件以进行原型设计。一旦成功，我将使用相同的方法将来自多个文件的 wav 数据附加在一起，并修改 header 信息以使其与附加的 wav 数据的大小相符。
我遇到的问题是当我调用 WriteFile（同步）时，它需要很长时间才能完成，原因是它正在向文本文件写入 4 gigs，它应该只写 20 个字节（one.txt 的大小）。出了什么问题或如何调试它？
我在这台机器上可用的工具有限，因为它是由一个大型组织管理的。我只能访问 VBA 的编程环境。 Powershell 和普通命令 shell 实用程序可用。
我做了以下研究：
阅读所有 dll 调用的 msdn 文章，设置断点以验证值是否正确，阅读关于 varptr 和调用 dll 函数的 32bit vs 64bit compatibility in office 2010, read and understand (mostly) an msdn article on passing information to dll procedures in VB, found this 精彩页面 VB，并从 msdn C++ 示例中获取代码，其中学到很多。
Private Sub cmdCopy_Click()
#If Win64 Then
MsgBox ("Win 64")
#Else
MsgBox ("Not win 64 bit") ' Developing on 32-bit excel 2010, windows 7 64 bit
#End If
'Dim dummyPtr As SECURITY_ATTRIBUTES ' not used, just changed Createfile declare last parameter type to Any to
' allow ByVal 0& to be used
'dummyPtr = Null
Dim hFile As LongPtr
hFile = CreateFile("C:\test\one.txt", GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
'hFile = CreateFile("C:\test\one.txt", GENERIC_READ, 0, vbNullString, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If hFile = INVALID_HANDLE_VALUE Then
MsgBox ("Could not open one.txt")
End If
Dim hAppend As LongPtr
hAppend = CreateFile("C:\test\two.txt", FILE_WRITE_DATA, FILE_SHARE_READ, ByVal 0&, _
OPEN_ALWAYS, _
FILE_ATTRIBUTE_NORMAL, _
vbNull) ' no template file
If hAppend = INVALID_HANDLE_VALUE Then
MsgBox ("Could not open two.txt")
End If
Dim cBuff(4096) As Byte
Dim dwBytesRead As Long
Dim dwBytesWritten As Long
Dim dwPos As Long
Dim bRet As Boolean
Dim lRet As Long
' not actually a long ptr
Dim lpBytesRead As Long
'lpBytesRead = VarPtr(dwBytesRead) ' extraeneous because byref in function declare causes VB to pass a pointer to lpBytesRead
' While (ReadFile(hFile, cBuff, Len(cBuff(LBound(cBuff))), ' a way to not hard-code the buffer length in the function call
lRet = ReadFile(hFile, ByVal VarPtr(cBuff(0)), 4096, _
lpBytesRead, ByVal 0&)
Debug.Print ("Outside while loop: Readfile: lret, lpBytesRead: " + CStr(lRet) + ", " + CStr(lpBytesRead))
While (lRet And lpBytesRead > 0)
dwPos = SetFilePointer(hAppend, 0, vbNull, FILE_END)
Debug.Print ("cmdCombine: SetFilePointer: dwPos: " + CStr(dwPos))
Dim i As Long
'Print the contents of the buffer from ReadFile
For i = 0 To lpBytesRead
Debug.Print Hex(cBuff(i)); "='" & Chr(cBuff(i)) & "'"
Next
'bRet = LockFile(hAppend, dwPos, 0, dwBytesRead, 0) 'commented for debugging
Dim lpBuffPointer As Long
lpBuffPointer = VarPtr(cBuff(0))
Dim lpBytesWritten As Long
lpBytesWritten = VarPtr(dwBytesWritten)
Dim lpTest As LongPtr
bRet = WriteFile(hAppend, ByVal VarPtr(cBuff(0)), 20, ByVal lpBytesWritten, ByVal 0&)
'bRet = WriteFile(hAppend, ByVal VarPtr(cBuff(0)), lpBytesRead, ByVal lpBytesWritten, ByVal 0&)
'bRet = WriteFile(hAppend, lpBuffPointer, lpBytesRead, lpBytesWritten, ByVal 0&) ' another option for calling
Debug.Print ("cmdCombine: Writefile: bRet, lpBytesRead, lpBytesWritten: " + _
CStr(bRet) + " " + CStr(lpBytesRead) + " " + CStr(dwBytesWritten))
'bRet = UnlockFile(hAppend, dwPos, 0, dwBytesRead, 0)
lRet = ReadFile(hFile, ByVal VarPtr(cBuff(0)), 4096, _
lpBytesRead, ByVal 0&)
Debug.Print ("Readfile: lret, lpBytesRead: " + CStr(lRet) + ", " + CStr(lpBytesRead))
Wend
' TODO: set EOF to the current file pointer location?
'SetEndOfFile (hAppend)
CloseHandle (hFile)
CloseHandle (hAppend)
End Sub
在模块中，我从 Win32API_PtrSafe.txt 中获取声明，修改为允许我为 UDT 传递 Null：
Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
'Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
'Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
'Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
Declare PtrSafe Function SetFilePointer Lib "kernel32" (ByVal hFile As LongPtr, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Declare PtrSafe Function LockFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long) As Long
Declare PtrSafe Function UnlockFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long
您正在将 vbNull 传递给 SetFilePointer。
vbNull 是一个等于 1 的枚举常量。 VarType()可以return是可能的结果之一。它不是 C++ 的 nullptr 或 VB 的 Nothing。将此值作为 lpDistanceToMoveHigh 传递给函数 use 64-bit addressing 并将 1 作为高 dword.
显然你想通过 ByVal 0&。当你想传递空指针时，它就是你传递给byref参数的东西。
我正在尝试使用 excel 2010 32 位中的 VBA7 和 windows 7 64 位中的 VBA7 将一个文本文件附加到另一个文本文件以进行原型设计。一旦成功，我将使用相同的方法将来自多个文件的 wav 数据附加在一起，并修改 header 信息以使其与附加的 wav 数据的大小相符。
我遇到的问题是当我调用 WriteFile（同步）时，它需要很长时间才能完成，原因是它正在向文本文件写入 4 gigs，它应该只写 20 个字节（one.txt 的大小）。出了什么问题或如何调试它？
我在这台机器上可用的工具有限，因为它是由一个大型组织管理的。我只能访问 VBA 的编程环境。 Powershell 和普通命令 shell 实用程序可用。
我做了以下研究： 阅读所有 dll 调用的 msdn 文章，设置断点以验证值是否正确，阅读关于 varptr 和调用 dll 函数的 32bit vs 64bit compatibility in office 2010, read and understand (mostly) an msdn article on passing information to dll procedures in VB, found this 精彩页面 VB，并从 msdn C++ 示例中获取代码，其中学到很多。
Private Sub cmdCopy_Click()
#If Win64 Then
MsgBox ("Win 64")
#Else
MsgBox ("Not win 64 bit") ' Developing on 32-bit excel 2010, windows 7 64 bit
#End If
'Dim dummyPtr As SECURITY_ATTRIBUTES ' not used, just changed Createfile declare last parameter type to Any to
' allow ByVal 0& to be used
'dummyPtr = Null
Dim hFile As LongPtr
hFile = CreateFile("C:\test\one.txt", GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
'hFile = CreateFile("C:\test\one.txt", GENERIC_READ, 0, vbNullString, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If hFile = INVALID_HANDLE_VALUE Then
MsgBox ("Could not open one.txt")
End If
Dim hAppend As LongPtr
hAppend = CreateFile("C:\test\two.txt", FILE_WRITE_DATA, FILE_SHARE_READ, ByVal 0&, _
OPEN_ALWAYS, _
FILE_ATTRIBUTE_NORMAL, _
vbNull) ' no template file
If hAppend = INVALID_HANDLE_VALUE Then
MsgBox ("Could not open two.txt")
End If
Dim cBuff(4096) As Byte
Dim dwBytesRead As Long
Dim dwBytesWritten As Long
Dim dwPos As Long
Dim bRet As Boolean
Dim lRet As Long
' not actually a long ptr
Dim lpBytesRead As Long
'lpBytesRead = VarPtr(dwBytesRead) ' extraeneous because byref in function declare causes VB to pass a pointer to lpBytesRead
' While (ReadFile(hFile, cBuff, Len(cBuff(LBound(cBuff))), ' a way to not hard-code the buffer length in the function call
lRet = ReadFile(hFile, ByVal VarPtr(cBuff(0)), 4096, _
lpBytesRead, ByVal 0&)
Debug.Print ("Outside while loop: Readfile: lret, lpBytesRead: " + CStr(lRet) + ", " + CStr(lpBytesRead))
While (lRet And lpBytesRead > 0)
dwPos = SetFilePointer(hAppend, 0, vbNull, FILE_END)
Debug.Print ("cmdCombine: SetFilePointer: dwPos: " + CStr(dwPos))
Dim i As Long
'Print the contents of the buffer from ReadFile
For i = 0 To lpBytesRead
Debug.Print Hex(cBuff(i)); "='" & Chr(cBuff(i)) & "'"
Next
'bRet = LockFile(hAppend, dwPos, 0, dwBytesRead, 0) 'commented for debugging
Dim lpBuffPointer As Long
lpBuffPointer = VarPtr(cBuff(0))
Dim lpBytesWritten As Long
lpBytesWritten = VarPtr(dwBytesWritten)
Dim lpTest As LongPtr
bRet = WriteFile(hAppend, ByVal VarPtr(cBuff(0)), 20, ByVal lpBytesWritten, ByVal 0&)
'bRet = WriteFile(hAppend, ByVal VarPtr(cBuff(0)), lpBytesRead, ByVal lpBytesWritten, ByVal 0&)
'bRet = WriteFile(hAppend, lpBuffPointer, lpBytesRead, lpBytesWritten, ByVal 0&) ' another option for calling
Debug.Print ("cmdCombine: Writefile: bRet, lpBytesRead, lpBytesWritten: " + _
CStr(bRet) + " " + CStr(lpBytesRead) + " " + CStr(dwBytesWritten))
'bRet = UnlockFile(hAppend, dwPos, 0, dwBytesRead, 0)
lRet = ReadFile(hFile, ByVal VarPtr(cBuff(0)), 4096, _
lpBytesRead, ByVal 0&)
Debug.Print ("Readfile: lret, lpBytesRead: " + CStr(lRet) + ", " + CStr(lpBytesRead))
Wend
' TODO: set EOF to the current file pointer location?
'SetEndOfFile (hAppend)
CloseHandle (hFile)
CloseHandle (hAppend)
End Sub
在模块中，我从 Win32API_PtrSafe.txt 中获取声明，修改为允许我为 UDT 传递 Null：
Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
'Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
'Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
'Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
Declare PtrSafe Function SetFilePointer Lib "kernel32" (ByVal hFile As LongPtr, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Declare PtrSafe Function LockFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long) As Long
Declare PtrSafe Function UnlockFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long
您正在将 vbNull 传递给 SetFilePointer。
vbNull 是一个等于 1 的枚举常量。 VarType()可以return是可能的结果之一。它不是 C++ 的 nullptr 或 VB 的 Nothing。将此值作为 lpDistanceToMoveHigh 传递给函数 use 64-bit addressing 并将 1 作为高 dword.
显然你想通过 ByVal 0&。当你想传递空指针时，它就是你传递给byref参数的东西。