我試圖追加一個文本文件到另一個使用VBA7在excel 2010 32位,在Windows 7 64位原型的目的。一旦這個工作,我將使用相同的方法來將來自多個文件的wav數據附加在一起,並修改標題信息以正確地附加wav數據的大小。vba dll從kernel32調用writefile創建巨大的文件
我遇到的問題是當我撥打WriteFile
(同步)時,需要很長時間才能完成,原因是它正在向文本文件寫入4個演出,它應該只寫入20個字節(大小爲one.txt
)。出了什麼問題或者我該如何調試?
我在這臺機器上使用的工具有限,因爲它是由大型組織管理的。我只能訪問VBA編程環境。 Powershell和普通的命令行實用程序都可用。
我已經做了以下研究: 閱讀所有DLL調用MSDN文章,設置斷點,以驗證值正確,閱讀32bit vs 64bit compatibility in office 2010,閱讀和理解(大部分)上傳遞的信息在VB中的DLL程序的MSDN文章,發現this有關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:
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
這是正確的答案。我沒有跟蹤這個原因是因爲'SetFilePointer'返回了一個很長的期望值,但是表示實際文件指針位置的64位longlong的高階32位應該等於'vbNull'或'1 」。 –
這是修復這個bug之前調試語句的輸出。外側,而循環:READFILE:LRET,lpBytesRead:1,20 cmdCombine:SetFilePointer:dwPos:7 74 = 'T' 68 = 'H' 69 = 'i' 的 73 = 'S' 20 =」' 69 = 'i' 的 73 = 'S' 20 = ' ' 74 =' T' 65 = 'E' 78 = 'X' 74 = 'T' 20 =」 ' 6F =' ' 6E ='n' 65 ='e' 2E ='。' 74 = 'T' 78 = 'X' 74 = 'T' 0 =」' cmdCombine:WriteFile的:BRET,lpBytesRead,lpBytesWritten:真20 20 READFILE:LRET,lpBytesRead:1,0 –