6
\$\begingroup\$

This code has one public method. ProcMonDebugOutput(). It will sent a string of text to Process Monitor that process monitor will display.

I'm basically ported this file.

I don't have a 64 bit version of office to test this on, but I think I used all the LongPtr right.

My two big concerns are: * Are the Win32 API calls "correct". I know they're passing the right data, but should I fiddle with them to make more sense? * Is my error handling appropiate?

Option Explicit

' Win32 API Constants
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = &O3&
Private Const FILE_WRITE_ACCESS As Long = &H2
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const METHOD_BUFFERED As Long = 0
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0


' Process Monitor Constants
Private Const FILE_DEVICE_PROCMON_LOG As Long = &H9535
Private Const PROCMON_DEBUGGER_HANDLER As String = "\\.\Global\ProcmonDebugLogger"
Private Const IOCTL_EXTERNAL_LOG_DEBUGOUT As Long = -1791655420

Dim hProcMon As LongPtr

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" _
    (ByVal lpFileName As LongPtr, _
     Optional ByVal dwDesiredAccess As Long = GENERIC_WRITE, _
     Optional ByVal dwShareMode As Long = FILE_SHARE_WRITE, _
     Optional lpSecurityAttributes As LongPtr = 0, _
     Optional ByVal dwCreationDisposition As Long = OPEN_EXISTING, _
     Optional ByVal dwFlagsAndAttributes As Long = FILE_ATTRIBUTE_NORMAL, _
     Optional ByVal hTemplateFile As LongPtr = 0) As LongPtr

Private Declare Function DeviceIoControl Lib "kernel32" _
    (ByVal hDevice As LongPtr, _
     ByVal dwIoControlCode As Long, _
     ByVal lpInBuffer As LongPtr, _
     ByVal nInBufferSize As Long, _
     Optional lpOutBuffer As LongPtr, _
     Optional ByVal nOutBufferSize As Long, _
     Optional lpBytesReturned As Long, _
     Optional ByVal lpOverlapped As LongPtr) As Long

Private Declare Function GetLastError Lib "kernel32" () As LongPtr
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As LongPtr)
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
     ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
     Arguments As Long) As Long


Public Function ProcMonDebugOutput(message As String) As LongPtr
    ProcMonDebugOutput = False
    Dim outLen As Long
    outLen = 0

    If hProcMon = 0 Then
        hProcMon = CreateFile(StrPtr(PROCMON_DEBUGGER_HANDLER))
    End If
    If hProcMon = -1 Then
        Dim Buffer As String
        'Create a string buffer
        Buffer = Space(200)
        FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, Err.LastDllError, LANG_NEUTRAL, Buffer, 200, ByVal 0&
        Err.Raise Buffer
    End If

    ProcMonDebugOutput = DeviceIoControl _
        (hProcMon, IOCTL_EXTERNAL_LOG_DEBUGOUT, _
        StrPtr(message), Len(message) * 2)
End Function

UPDATE

Based on the feedback I've changed one API Signature and my public method:

Private Declare Function DeviceIoControl Lib "kernel32" _
    (ByVal hDevice As LongPtr, _
     ByVal dwIoControlCode As Long, _
     ByVal lpInBuffer As LongPtr, _
     ByVal nInBufferSize As Long, _
     Optional lpOutBuffer As LongPtr, _
     Optional ByVal nOutBufferSize As Long, _
     Optional lpBytesReturned As Long, _
     Optional ByVal lpOverlapped As LongPtr) As Boolean


Public Function ProcMonDebugOutput(message As String) As Boolean
    If hProcMon = 0 Or hProcMon = 0 Then
        hProcMon = CreateFile(StrPtr(PROCMON_DEBUGGER_HANDLER))
    End If
    If hProcMon = -1 Then
        Err.Raise Err.LastDllError
    End If

    ProcMonDebugOutput = DeviceIoControl _
        (hProcMon, IOCTL_EXTERNAL_LOG_DEBUGOUT, _
        StrPtr(message), Len(message) * 2)
End Function
\$\endgroup\$
  • \$\begingroup\$ @RubberDuck It does work. It works on 32 bit excel, which is the vast majority of office installs out there. I'm pointing out a potential place where it might not work. I don't have a way of testing in that environment. It's pretty much the equivalent of me writing some C++ on linux and saying "I didn't test this on windows, but I made attempts to only use those parts of the posix library the win32 subsystem implements." \$\endgroup\$ – Justin Dearing Jul 22 '15 at 22:31
  • 1
    \$\begingroup\$ That's fine and I'll retract my close vote, but you should know that I don't think this will work on a 64 bit install. I believe you'll need a preprocessor directive and use a LongLongPtr for that environment. \$\endgroup\$ – RubberDuck Jul 22 '15 at 22:37
  • \$\begingroup\$ @RubberDuck The MSDN disagrees. There is no LongLongPtr, LongPtr is the magic platform dependent variable. I have in the past ported VBA 32 bit code to work on both. msdn.microsoft.com/en-us/library/office/… \$\endgroup\$ – Justin Dearing Jul 22 '15 at 23:15
  • \$\begingroup\$ You're right. I was thinking of LongLong. \$\endgroup\$ – RubberDuck Jul 22 '15 at 23:38
7
\$\begingroup\$

That's some pretty intense Win32 API stuff you got here, it's nice to see pointers and API calls in a VBA question, it's quite a change from the typical "speed up my Excel macro" question -- kudos!

One thing worries me though:

Dim Buffer As String
'Create a string buffer
Buffer = Space(200)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, Err.LastDllError, LANG_NEUTRAL, Buffer, 200, ByVal 0&
Err.Raise Buffer

The first argument of Err.Raise should be an error number. If FormatMessage fills up buffer with a string that starts with an error number, then that's the error you're raising, and the rest of the message goes to oblivion. If the string does not start with a number, by VBA's implicit coversion rules you're raising error 0, which is a non-error... and that can't be right.

This instruction is redundant at first sight:

ProcMonDebugOutput = False

...but then, the function doesn't return a Boolean, but a LongPtr - why the Boolean assignment then? False would be implicitly converted to 0, which is the same value that would be returned if you didn't make that confusing assignment. I'd just remove it.

Same kind of issue here:

Dim outLen As Long
outLen = 0

outLen is already initialized with a value of 0, the assignment is redundant... and unless I missed something, the variable is assigned, but isn't used at all. I'd remove these two lines too.

I'll admit I didn't know you could specify ByVal at the call site to force a parameter to be passed by value (I wonder if it breaks the parser... but that's my problem ;-) - I like it more than the parentheses-wrapping of the parameter to force ByVal for: it's more readable and less confusing - well done!

I can't seem to get a call-site ByVal to compile... will confirm in a few days when I'm on my laptop. Phone doesn't run VBA ;-)

\$\endgroup\$
  • \$\begingroup\$ Thanks, I need to trust the default parameter settings.. OutLen is not needed. It was needed before I gave my api signatures Defaults. Regarding the Error Handling. Should I just do Err.Raise Err.LastDllError then? Or Should I do Err.Raise Err.LastDllError, "ProcMonDebugOutput", Buffer? \$\endgroup\$ – Justin Dearing Jul 23 '15 at 2:08
  • \$\begingroup\$ I'm not 100% on LastDllError, but if that gives you a non-zero error code go for it! That said, are you sure &O3& is valid? It seems to confuse syntax highlighting here, and the VBA grammar I'm using for Rubberduck doesn't like it at all. \$\endgroup\$ – Mathieu Guindon Jul 23 '15 at 2:50
  • \$\begingroup\$ Confirmed &03&So that was valid, but unecessary VBA grammar. I freaked out when I learned there was no unsigned ints in VBA. I removed it. Rohitab's API Monitor showed the 3 passing through \$\endgroup\$ – Justin Dearing Jul 23 '15 at 4:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.