call API functions by their pointers

[rm_03]

With some ASM we can call functions by their pointers or
even call them in new threads so our app keeps responding.
It's actually the first time I've written the ASM code myself,
so please don't bash me for any crashes.
I used an upload at pscode for orientation, but I can't find it atm.

First we need a module. Let's name it modFncPtr.
Its functions are:
* GetFncAddress - like GetProcAddress, just more comfortable
* WaitForThread - wait for the end of a thread in a DoEvents loop
* CallPointerAsync - run a function in a new thread
* CallPointer - just run a function

Option Explicit
 
Private Declare Function GetExitCodeThread Lib "kernel32" ( _
            ByVal hThread As Long, _
            lpExitCode As Long) As Long
 
Private Declare Function CreateThread Lib "kernel32" ( _
            lpThreadAttributes As Long, _
            ByVal dwStackSize As Long, _
            ByVal lpStartAddress As Long, _
            lpParameter As Any, _
            ByVal dwCreationFlags As Long, _
            lpThreadId As Long) As Long
 
Private Declare Function CallWindowProcA Lib "user32" ( _
            ByVal adr As Long, _
            ByVal p1 As Long, _
            ByVal p2 As Long, _
            ByVal p3 As Long, _
            ByVal p4 As Long) As Long
 
Private Declare Function LoadLibraryA Lib "kernel32" ( _
            ByVal szLib As String) As Long
 
Private Declare Function GetProcAddress Lib "kernel32" ( _
            ByVal hModule As Long, _
            ByVal szFnc As String) As Long
 
Private Declare Function GetModuleHandleA Lib "kernel32" ( _
            ByVal szModule As String) As Long
 
Private Declare Sub RtlFillMemory Lib "kernel32" ( _
            pDst As Any, _
            ByVal dlen As Long, _
            ByVal Fill As Byte)
 
Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
            pDst As Any, _
            pSrc As Any, _
            ByVal dlen As Long)
 
Private Const STILL_ACTIVE  As Long = 259&
Private Const MAXCODE       As Long = &HEC00&
 
Public Type ASYNCCALL
    hThread                 As Long
    ret                     As Long
    asm(MAXCODE - 1)        As Byte
End Type
 
Private lngAsyncRet         As Long
 
' like GetProcAddress, but with a more comfortable first parameter
Public Function GetFncAddress(ByVal library As String, ByVal sFunction As String) As Long
    Dim hModule As Long
    Dim pFunc   As Long
 
    ' check if module already loaded
    hModule = GetModuleHandleA(library)
    If hModule = 0 Then
        ' module not loaded, try to load it
        hModule = LoadLibraryA(library)
        If hModule = 0 Then
            Err.Raise 999, , "library missing!"
            Exit Function
        End If
    End If
 
    ' get entry point of function
    pFunc = GetProcAddress(hModule, sFunction)
    If pFunc = 0 Then
        Err.Raise 998, , "not a exported function!"
        Exit Function
    End If
 
    GetFncAddress = pFunc
End Function
 
' wait for end of thread
Public Sub WaitForThread(hThread As Long)
    Dim dwExitCode  As Long
 
    Do
        GetExitCodeThread hThread, dwExitCode
        If dwExitCode <> STILL_ACTIVE Then Exit Do
        DoEvents
    Loop
End Sub
 
' run a function in a new thread
Public Sub CallPointerAsync(ByVal fnc As Long, udtAsync As ASYNCCALL, ParamArray params())
    Dim pASM            As Long
    Dim TID             As Long
    Dim hThread         As Long
    Dim i               As Integer
 
    pASM = VarPtr(udtAsync.asm(0))
 
    ' fill code array with INT 3s (Debugger)
    RtlFillMemory ByVal pASM, MAXCODE, &HCC
 
    AddByte pASM, &H58                  ' POP EAX
    AddByte pASM, &H59                  ' POP ECX
    AddByte pASM, &H50                  ' PUSH EAX
 
    For i = UBound(params) To 0 Step -1
        AddPush pASM, CLng(params(i))   ' PUSH dword
    Next
 
    AddCall pASM, fnc                   ' CALL rel. addr
 
    AddByte pASM, &HBA                  ' MOV EDX, |||||
    AddLong pASM, VarPtr(udtAsync.ret)  '          dword
 
    AddByte pASM, &H89                  ' MOV ||||| ||| |||||, EAX
    AddByte pASM, &H2                   '     dword ptr [EDX]
 
    AddByte pASM, &HC3                  ' RET
 
    hThread = CreateThread(ByVal 0&, 0, VarPtr(udtAsync.asm(0)), _
                           ByVal 0&, 0, TID)
 
    udtAsync.hThread = hThread
End Sub
 
' run function by its pointer
Public Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
    Dim btASM(MAXCODE - 1)  As Byte
    Dim pASM                As Long
    Dim i                   As Integer
 
    pASM = VarPtr(btASM(0))
 
    ' fill code array with INT 3s (Debugger)
    RtlFillMemory ByVal pASM, MAXCODE, &HCC
 
    ' remove CallWindowProc parameters from stack
    AddByte pASM, &H58                  ' POP EAX
    AddByte pASM, &H59                  ' POP ECX
    AddByte pASM, &H59                  ' POP ECX
    AddByte pASM, &H59                  ' POP ECX
    AddByte pASM, &H59                  ' POP ECX
    AddByte pASM, &H50                  ' PUSH EAX
 
    For i = UBound(params) To 0 Step -1
        AddPush pASM, CLng(params(i))   ' PUSH dword
    Next
 
    AddCall pASM, fnc                   ' CALL rel addr
    AddByte pASM, &HC3                  ' RET
 
    CallPointer = CallWindowProcA(VarPtr(btASM(0)), _
                                  0, 0, 0, 0)
End Function
 
Private Sub AddPush(pASM As Long, lng As Long)
    AddByte pASM, &H68
    AddLong pASM, lng
End Sub
 
Private Sub AddCall(pASM As Long, addr As Long)
    AddByte pASM, &HE8
    AddLong pASM, addr - pASM - 4
End Sub
 
Private Sub AddLong(pASM As Long, lng As Long)
    RtlMoveMemory ByVal pASM, lng, 4
    pASM = pASM + 4
End Sub
 
Private Sub AddByte(pASM As Long, bt As Byte)
    RtlMoveMemory ByVal pASM, bt, 1
    pASM = pASM + 1
End Sub

Example on how to call user32.MessageBoxA in the same thread:

Dim fnc         As Long
    Dim ret         As Long
 
    Dim strTitle    As String
    Dim strMsg      As String
 
    ' Get the entry point of user32.MessageBoxA
    fnc = GetFncAddress("user32", "MessageBoxA")
 
    ' convert message to Ansi
    strTitle = StrConv("Title", vbFromUnicode)
    strMsg = StrConv("Messages", vbFromUnicode)
 
    ' call function pointer
    ret = CallPointer(fnc, hWnd, StrPtr(strMsg), StrPtr(strTitle), vbInformation)
 
    MsgBox "Return: " & ret

That was easy, wasn't it?

One more for an asynchronous call:

Dim MsgBoxThread As ASYNCCALL
    Dim fnc         As Long
 
    Dim strTitle    As String
    Dim strMsg      As String
 
    ' get entry point of user32.MessageBoxA
    fnc = GetFncAddress("user32", "MessageBoxA")
 
    'convert message to Ansi
    strTitle = StrConv("Title", vbFromUnicode)
    strMsg = StrConv("Message", vbFromUnicode)
 
    ' call function in a new thread
    ' the udt MsgBoxThread will contain the thread handle, the return value
    ' and the asm code(!)
    ' make sure MsgBoxThread doesn't run out of scope before
    ' the thread is finished! Else your app will crash!
    CallPointerAsync fnc, MsgBoxThread, hWnd, StrPtr(strMsg), StrPtr(strTitle), vbInformation
 
    With MsgBoxThread
        ' wait for the thread to finish
        WaitForThread .hThread
        ' when the thread is finished .ret contains the return value
        MsgBox "Return: " & .ret
    End With

[dreamvb]

Nise handy code. this should have with my small Windows Scripting Lanuage. as now I can also call API. nise job Excellent *****