vba dll从kernel32调用writefile会创build一个巨大的文件
我试图追加一个文本文件到另一个使用VBA7在Excel 2010 32位，在Windows 7 64位原型的目的。 一旦这个工作，我将使用相同的方法来从多个文件一起附加wav数据，并修改标题信息，以正确的附加wav数据的大小。
我遇到的问题是当我调用WriteFile （同步）时，需要很长时间才能完成，原因是它正在向文本文件写入4个小时，它应该只写20个字节（大小one.txt ）。 出了什么问题或者我该如何debugging？
我在这台机器上使用的工具有限，因为它是由大型组织pipe理的。 我只能访问VBA编程环境。 Powershell和普通的命令行工具都可用。
我已经做了以下研究：读取所有dll调用MSDN文章，设置断点来validation值是正确的，阅读有关Office 2010中的32位与64位兼容性 ，阅读和理解（主要）一个MSDN文章传递信息到DLL程序VB，发现这个关于varptr的伟大的页面，并在VB中调用dll函数，并从一个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()可能返回的结果之一。 这不是C ++的nullptr或VB的Nothing 。 将此值作为lpDistanceToMoveHigh传递lpDistanceToMoveHigh指示函数使用64位寻址 ，并将1作为高位dword 。
显然你想通过ByVal 0& 。 当您要传递空指针时，您传递给byref参数。