Question

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

我遇到的问题是当我调用WriteFile（同步）时，需要很长时间才能完成，原因是它正在为文本文件写4个演出，它应该只是写20个字节（大小为one.txt）。出了什么问题或我该如何调试？

我在这台机器上可以使用有限的工具，因为它是由大型组织管理的。我只能访问编程环境的VBA。可以使用Powershell和普通的命令shell实用程序。

我做了以下研究：阅读所有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传递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

Answer 1

您正在将vbNull传递给SetFilePointer。

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

显然你想通过ByVal 0&。当您想要传递空指针时，它是传递给byref参数的内容。

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

1 个答案: