vba dll从kernel32调用writefile创建巨大的文件

Question

我试图追加一个文本文件到另一个使用VBA7在excel 2010 32位，在Windows 7 64位原型的目的。一旦这个工作，我将使用相同的方法来将来自多个文件的wav数据附加在一起，并修改标题信息以正确地附加wav数据的大小。

我遇到的问题是当我拨打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 

Answer 1

你传入vbNull到SetFilePointer。

vbNull是一个枚举常量，等于1。这是VarType()可能返回的结果之一。它不是C++的nullptr或VB的Nothing。将此值作为lpDistanceToMoveHigh传递给函数use 64-bit addressing，并将1作为高位dword。

显然你想通过ByVal 0&。当你想传递空指针时，你传递给byref参数。