简体   繁体   中英

vba dll call writefile from kernel32 creates huge file

I'm trying to append one text file to another using VBA7 in excel 2010 32 bit, on windows 7 64 bit for prototyping purposes. Once this works, I'm going to be using the same method to append wav data from many files together and modifying the header information to be correct for the size of the appended wav data.

The problem that I'm having is when I call WriteFile (synchronously), it takes a long time to complete, and the reason is that it is writing 4 gigs to the text file, it should only be writing 20 bytes (the size of one.txt ). What is going wrong or how can I debug it?

I have limited tools available to me on this machine, because it is a managed by a large organization. I only have access to VBA for programming environment. Powershell and normal command shell utilities are available.

I have done the following research: Read the msdn articles for all dll calls, set breakpoints to verify values are correct, read about 32bit vs 64bit compatibility in office 2010 , read and understand (mostly) an msdn article on passing information to dll procedures in VB, found this great page about varptr and calling dll functions in VB, and got the code from an msdn C++ example, among much learning.

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

In the module I have the declares taken from Win32API_PtrSafe.txt, modified to allow me to pass a Null for the UDTs:

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

You are passing vbNull to SetFilePointer .

vbNull is an enumeration constant that equals 1 . It is one of the possible results that VarType() can return. It is not C++'s nullptr or VB's Nothing . Passing this value as lpDistanceToMoveHigh instructs the function to use 64-bit addressing and take the 1 as the high dword .

Apparently you wanted to pass ByVal 0& . It is what you pass to byref parameters when you want to pass null pointer.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM