Results 1 to 29 of 29

Thread: [VB6] - Calling functions by pointer.

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    [VB6] - Calling functions by pointer.

    ACTUAL VERSION IN 9 POST
    Exploring the function VBA6 figured out a way to call functions the pointer.
    It's simple. Declare a function prototype (void function), where the first argument will be further transferred to the function address. Next, do a patch, so he tossed to us at the address specified in the first parameter. Thus it is possible to call functions in the standard modules, class modules, forms, API-functions (eg obtained through LoadLibrary and GetProcAddress).* One note, run the project through Ctrl + F5. And working in the IDE and compiled form.
    For "patching" the prototype I made a separate module:
    Code:
    Option Explicit
    
    Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long
    Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Private Declare Sub EbGetExecutingProj Lib "vba6" (hProject As Long)
    Private Declare Function TipGetFunctionId Lib "vba6" (ByVal hProj As Long, ByVal bstrName As Long, ByRef bstrId As Long) As Long
    Private Declare Function TipGetLpfnOfFunctionId Lib "vba6" (ByVal hProject As Long, ByVal bstrId As Long, ByRef lpAddress As Long) As Long
    Private Declare Sub SysFreeString Lib "oleaut32" (ByVal lpbstr As Long)
    
    Private Const PAGE_EXECUTE_READWRITE = &H40
    
    ' Вспомогательные функции
    Public Sub PatchFunc(FuncName As String, ByVal Addr As Long)
        Dim lpAddr As Long, hProj As Long, sId As Long, InIDE As Boolean
    
        Debug.Assert MakeTrue(InIDE)
    
        ' Получаем адрес функции
        If InIDE Then
            EbGetExecutingProj hProj
            TipGetFunctionId hProj, StrPtr(FuncName), sId
            TipGetLpfnOfFunctionId hProj, sId, lpAddr
            SysFreeString sId
        Else
            lpAddr = GetAddr(Addr)
            VirtualProtect lpAddr, 8, PAGE_EXECUTE_READWRITE, 0
        End If
    
        ' Записываем вставку
        ' Запускать только по Ctrl+F5!!
        ' pop eax
        ' pop ecx
        ' push eax
        ' jmp ecx
    
        GetMem4 &HFF505958, ByVal lpAddr
        GetMem4 &HE1, ByVal lpAddr + 4
    End Sub
    
    Private Function GetAddr(ByVal Addr As Long) As Long
        GetAddr = Addr
    End Function
    Public Function MakeTrue(ByRef bvar As Boolean) As Boolean
        bvar = True: MakeTrue = True
    End Function
    Example call normal functions in a standard module:
    Code:
    ' Пример вызова обычных функции по указателю
    Public Sub Main()
    
        ' Пропатчиваем функции, перед первым вызовом
        PatchFunc "Proto1", AddressOf Proto1
        PatchFunc "Proto2", AddressOf Proto2
    
        MsgBox Proto1(AddressOf Func1, 1, "Вызов")
        MsgBox Proto1(AddressOf Func2, 2, "По указателю")
        MsgBox Proto1(AddressOf Func3, 3, ";)")
    
        Call Proto2(AddressOf Sub1)
        Call Proto2(AddressOf Sub2)
    End Sub
    
    ' Прототип функций
    Private Function Proto1(ByVal Addr As Long, ByVal x As Long, y As String) As String
    End Function
    Private Sub Proto2(ByVal Addr As Long)
    End Sub
    ' Функции
    Private Function Func1(ByVal x As Long, y As String) As String
        Func1 = "Func1_" & y
    End Function
    Private Function Func2(ByVal x As Long, y As String) As String
        Func2 = "Func2_" & y
    End Function
    Private Function Func3(ByVal x As Long, y As String) As String
        Func3 = "Func3_" & y
    End Function
    Private Sub Sub1()
        MsgBox "Sub1"
    End Sub
    Private Sub Sub2()
        MsgBox "Sub2"
    End Sub
    Example API calls at getting through GetProcAddress:
    Code:
    Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    
    
    ' Пример вызова WinApi функций по указателю
    Public Sub Main()
        Dim hUser As Long, hGDI As Long
        Dim DC As Long
    
        hUser = LoadLibrary("user32")
        hGDI = LoadLibrary("gdi32")
    
        PatchFunc "GetDC", AddressOf GetDC
        PatchFunc "ReleaseDC", AddressOf ReleaseDC
        PatchFunc "Ellipse", AddressOf Ellipse
    
        DC = GetDC(GetProcAddress(hUser, "GetDC"), 0)
        Ellipse GetProcAddress(hGDI, "Ellipse"), DC, 0, 0, 500, 500
        ReleaseDC GetProcAddress(hUser, "ReleaseDC"), 0, DC
    End Sub
    
    ' Прототип функций
    Private Function GetDC(ByVal Addr As Long, ByVal hWnd As Long) As Long
    End Function
    Private Function ReleaseDC(ByVal Addr As Long, ByVal hWnd As Long, ByVal hdc As Long) As Long
    End Function
    Private Function Ellipse(ByVal Addr As Long, ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    End Function
    Example call class methods on the pointer:
    .bas module:
    Code:
    Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long
    
    ' Пример вызова методов объекта по указателю
    Public Sub Main()
        Dim IUnk    As Long
        Dim lpProp  As Long
        Dim lpView  As Long
        Dim Obj1    As clsTest
        Dim Obj2    As clsTest
        Dim ret     As Long
    
        Set Obj1 = New clsTest
        Set Obj2 = New clsTest
        
        GetMem4 ByVal ObjPtr(Obj1), IUnk
        GetMem4 ByVal IUnk + &H1C, lpProp
        GetMem4 ByVal IUnk + &H20, lpView
        
        PatchFunc "clsTest_PropLet", AddressOf clsTest_PropLet
        PatchFunc "clsTest_View", AddressOf clsTest_View
        
        clsTest_PropLet lpProp, Obj1, 1234
        clsTest_PropLet lpProp, Obj2, 9876
        
        clsTest_View lpView, Obj1, ret
        Debug.Print ret
        clsTest_View lpView, Obj2, ret
        Debug.Print ret
    End Sub
    
    ' Прототип функций
    Private Function clsTest_PropLet(ByVal Addr As Long, ByVal Obj As clsTest, ByVal Value As Long) As Long
    End Function
    Private Function clsTest_View(ByVal Addr As Long, ByVal Obj As clsTest, ret As Long) As Long
    End Function
    Class module:
    Code:
    Option Explicit
    
    Dim mValue As Long
    
    Public Property Let Prop(ByVal Value As Long)
        mValue = Value
    End Property
    Public Function View() As Long
        View = MsgBox(mValue, vbYesNoCancel)
    End Function
    Good luck!

    CallPointer.zip

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [VB6] - Calling functions by pointer.

    Another way, rather simple and less limitations, would be the use of the API DispCallFunc.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Calling functions by pointer.

    DispCallFunc much slower. DispCallFunc can be used for other calling conventions (CC_CDECL etc.). DispCallFunc also preferable to use to call methods on a COM object. For example:
    Code:
    Private Function IAccessibleGet_accState(obj As IUnknown, VarID As Variant) As Variant
        Dim types() As Integer, param() As Long
        ReDim types(1): ReDim param(1)
        types(0) = vbVariant: types(1) = vbLong
        param(0) = VarPtr(VarID): param(1) = VarPtr(IAccessibleGet_accState): IAccessibleGet_accState = param(1)
        Call DispCallFunc(obj, 56, CC_STDCALL, vbLong, 2, types(0), param(0), 0)
    End Function

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [VB6] - Calling functions by pointer.

    True, but DispCallFunc can be wrapped in a generic function and that function can be called for both GetProcAddress pointers and COM objects, with variable parameters, and without having to create prototypes or patching VTables. Just another way to skin a cat.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5

  6. #6
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,207

    Re: [VB6] - Calling functions by pointer.

    On another note...

    All these methods (as the above trick) which depend on vba6.dll -
    are not usable within your Applications "in the wild"...

    They will work only on machines where the VB6-IDE is installed
    (and are therefore useful for IDE-plugins and stuff) - but not much
    else, since - IIRC - vba6.dll is not listed in redist.txt...

    Edit: Overlooked the InIde-check, so all fine for the above code...

    Olaf
    Last edited by Schmidt; Feb 13th, 2015 at 09:52 PM.

  7. #7
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [VB6] - Calling functions by pointer.

    Olaf, haven't reviewed his other threads, but in this thread vba6.dll appears to be only called if project is in the IDE.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,207

    Re: [VB6] - Calling functions by pointer.

    Quote Originally Posted by LaVolpe View Post
    Olaf, haven't reviewed his other threads, but in this thread vba6.dll appears to be only called if project is in the IDE.
    Oops - right you are - sorry @ Кривоус.

    Olaf

  9. #9

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Calling functions by pointer.

    I've modified this module (now it is yet smaller):
    Code:
    Option Explicit
    
    Private Declare Function GetMem4 Lib "msvbvm60" ( _
                             ByRef src As Any, _
                             ByRef dst As Any) As Long
    Private Declare Function VirtualProtect Lib "kernel32" ( _
                             ByVal lpAddress As Long, _
                             ByVal dwSize As Long, _
                             ByVal flNewProtect As Long, _
                             ByRef lpflOldProtect As Long) As Long
     
    Private Const PAGE_EXECUTE_READWRITE = &H40
    
    ' // Helpers functions
    Public Sub PatchFunc(ByVal Addr As Long)
        Dim InIDE As Boolean
     
        Debug.Assert MakeTrue(InIDE)
     
        If InIDE Then
            GetMem4 ByVal Addr + &H16, Addr
        Else
            VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
        End If
    
        GetMem4 &HFF505958, ByVal Addr
        GetMem4 &HE1, ByVal Addr + 4
    End Sub
     
    Public Function MakeTrue(ByRef bvar As Boolean) As Boolean
        bvar = True: MakeTrue = True
    End Function
    Also i've added the new example that show the analog of the c++ function - qsort, where the comparing parameter is the user function:
    Code:
    Option Explicit
    
    Private Type Vector2D
        posX As Single
        posY As Single
    End Type
    
    Private Declare Sub memcpy Lib "kernel32" _
                        Alias "RtlMoveMemory" ( _
                        ByRef Destination As Any, _
                        ByRef Source As Any, _
                        ByVal Length As Long)
                        
    ' // Buffer for exchanging
    Dim buffer()    As Byte
    Dim isInit      As Boolean
    
    ' // Calling of the standard functions using the pointers
    Public Sub Main()
        Dim lngArray()  As Long
        Dim index       As Long
        
        ' // We're testing the function that sorts the long-array
        ReDim lngArray(99)
        
        For index = 0 To UBound(lngArray)
            lngArray(index) = Rnd * 100
        Next
        
        ' // Magic of the function pointers
        QuickSort VarPtr(lngArray(0)), UBound(lngArray) + 1, Len(lngArray(0)), AddressOf ComparatorLong
        
        ' // Now we're testing the function that sorts the string-array
        Dim strArray()  As String
        
        ReDim strArray(5)
        
        strArray(0) = "Calling"
        strArray(1) = "of the standard functions"
        strArray(2) = "using the pointers"
        strArray(3) = "on VB6"
        strArray(4) = "by The trick"
        strArray(5) = "2015"
        
        ' // We're calling same function using the magic of pointers
        QuickSort VarPtr(strArray(0)), UBound(strArray) + 1, 4, AddressOf ComparatorString
        
        ' // Now we're testing the function that sorts the UDT-array (2D-vectors)
        ' // For example we'll sorting the array by vector length
        Dim vecArray() As Vector2D
        
        ReDim vecArray(99)
        
        For index = 0 To UBound(vecArray)
            vecArray(index).posX = Rnd * 10
            vecArray(index).posY = Rnd * 10
        Next
        
        ' // We're calling same function for the sorting of the UDT-array
        QuickSort VarPtr(vecArray(0)), UBound(vecArray) + 1, LenB(vecArray(0)), AddressOf ComparatorVector2D
        
        ' // Test length
        For index = 0 To UBound(vecArray)
            Debug.Print Sqr(vecArray(index).posX ^ 2 + vecArray(index).posY ^ 2)
        Next
        
    End Sub
    
    ' // This callback function which sorts two long values
    Public Function ComparatorLong( _
                    ByRef lItem1 As Long, _
                    ByRef lItem2 As Long) As Long
        ComparatorLong = Sgn(lItem1 - lItem2)
    End Function
    
    ' // This callback function which sorts two string values
    Public Function ComparatorString( _
                    ByRef lItem1 As String, _
                    ByRef lItem2 As String) As Long
        ComparatorString = StrComp(lItem1, lItem2, vbTextCompare)
    End Function
    
    ' // This callback function which sorts two 2D-vectors values by length
    Public Function ComparatorVector2D( _
                    ByRef lItem1 As Vector2D, _
                    ByRef lItem2 As Vector2D) As Long
        ' // Optimize sqr
        ComparatorVector2D = Sgn((lItem1.posX * lItem1.posX + lItem1.posY * lItem1.posY) - _
                                 (lItem2.posX * lItem2.posX + lItem2.posY * lItem2.posY))
    End Function
    
    ' // Quick-sort using the callback function for a comparing
    ' // This function uses callback function (lpfnComparator)
    Public Sub QuickSort( _
               ByVal lpFirstPtr As Long, _
               ByVal lNumOfItems As Long, _
               ByVal lSizeElement As Long, _
               ByVal lpfnComparator As Long)
               
        Dim lpI     As Long
        Dim lpJ     As Long
        Dim lpM     As Long
        Dim lpLast  As Long
        
        If Not isInit Then
            ' // Initialize patching and buffer for exchanging
            ReDim buffer(lSizeElement - 1)
            PatchFunc AddressOf MainComparator
            isInit = True
            
        End If
        
        lpLast = lpFirstPtr + (lNumOfItems - 1) * lSizeElement
        lpI = lpFirstPtr
        lpJ = lpLast
        lpM = lpFirstPtr + ((lNumOfItems - 1) \ 2) * lSizeElement
    
        Do Until lpI > lpJ
            
            ' // Call function that being passed into the lpfnComparator parameter
            Do While MainComparator(lpfnComparator, lpI, lpM) = -1
                lpI = lpI + lSizeElement
            Loop
            
            ' // Call function that being passed into the lpfnComparator parameter
            Do While MainComparator(lpfnComparator, lpJ, lpM) = 1
                lpJ = lpJ - lSizeElement
            Loop
            
            ' // Exchanging
            If (lpI <= lpJ) Then
                
                If lpI = lpM Then
                    lpM = lpJ
                ElseIf lpJ = lpM Then
                    lpM = lpI
                End If
                
                If lSizeElement > UBound(buffer) + 1 Then
                    ReDim buffer(lSizeElement - 1)
                End If
                
                memcpy buffer(0), ByVal lpI, lSizeElement
                memcpy ByVal lpI, ByVal lpJ, lSizeElement
                memcpy ByVal lpJ, buffer(0), lSizeElement
      
                lpI = lpI + lSizeElement
                lpJ = lpJ - lSizeElement
                
            End If
            
        Loop
    
        If lpFirstPtr < lpJ Then
            QuickSort lpFirstPtr, (lpJ - lpFirstPtr) \ lSizeElement + 1, lSizeElement, lpfnComparator
        End If
        
        If lpI < lpLast Then
            QuickSort lpI, (lpLast - lpI) \ lSizeElement + 1, lSizeElement, lpfnComparator
        End If
        
    End Sub
    
    ' // Prototype for comparator function
    ' // If lpItem1 > lpItem2 then function return 1
    ' // If lpItem1 = lpItem2 then function return 0
    ' // If lpItem1 < lpItem2 then function return -1
    Public Function MainComparator( _
                    ByVal lpAddressOfFunction As Long, _
                    ByVal lpItem1 As Long, _
                    ByVal lpItem2 As Long) As Long
    End Function
    Download.

  10. #10
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,094

    Re: [VB6] - Calling functions by pointer.

    Insetad of keeping track with isInit can you call PatchFunc in MainComparator like this
    Code:
    Public Function MainComparator( _
                    ByVal lpAddressOfFunction As Long, _
                    ByVal lpItem1 As Long, _
                    ByVal lpItem2 As Long) As Long
        PatchFunc AddressOf MainComparator
        MainComparator = MainComparator(lpAddressOfFunction, lpItem1, lpItem2)
    End Function
    ... for some wicked self-modifying code :-))

    cheers,
    </wqw>

  11. #11
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [VB6] - Calling functions by pointer.

    If we have a function in an object, then is it possible to call that function and use the objects variables to hold total or other values from more than one call to function, to this object?

  12. #12

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Calling functions by pointer.

    Quote Originally Posted by georgekar View Post
    If we have a function in an object, then is it possible to call that function and use the objects variables to hold total or other values from more than one call to function, to this object?
    Do you saw the TrickCallPointerClass example? This example shows how can you call the methods of the objects by the pointer. You should pass the object as the second parameter, and the return value (if need) is passed in the last parameters as the pointer (ByRef).

  13. #13

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Calling functions by pointer.

    Quote Originally Posted by wqweto View Post
    Insetad of keeping track with isInit can you call PatchFunc in MainComparator like this
    Code:
    Public Function MainComparator( _
                    ByVal lpAddressOfFunction As Long, _
                    ByVal lpItem1 As Long, _
                    ByVal lpItem2 As Long) As Long
        PatchFunc AddressOf MainComparator
        MainComparator = MainComparator(lpAddressOfFunction, lpItem1, lpItem2)
    End Function
    ... for some wicked self-modifying code :-))

    cheers,
    </wqw>
    Nice advice. It needs to test it on the compiled file.

  14. #14
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,094

    Re: [VB6] - Calling functions by pointer.

    It seems there is a limitation of `AddressOf` operator -- you cannot use it inside a function to get current function address, i.e. `AddressOf MainComparator` cannot be compiled inside `MainComparator` function.

    So you have to use a helper function like this
    Code:
    Public Function MainComparator( _
                    ByVal lpAddressOfFunction As Long, _
                    ByVal lpItem1 As Long, _
                    ByVal lpItem2 As Long) As Long
        PatchFunc pvMainComparatorAddr
        MainComparator = MainComparator(lpAddressOfFunction, lpItem1, lpItem2)
    End Function
    
    Private Function pvMainComparatorAddr() As Long
        Call memcpy(pvMainComparatorAddr, AddressOf MainComparator, 4)
    End Function
    The self-modifying part seems to work both in IDE and compiled.

    Btw, I would call `MainComparator` something like `DelegateCompare` or similar. Every VB6 developer has a personal implementation of a similar delegator. I'm personally using the exactly same ASM thunk on a lightweight object with number of functions like Call1, Call2, Call3, etc each accepting 1, 2, 3, etc. number of (long) parameters. Popping return address from stack hides the delegator from call-stack too.

    This is my delegator initialization function
    Code:
    Private Function pvInitDelegator(This As DelegatorData) As IDelegator
    '00401030 59                   pop         ecx
    '00401031 58                   pop         eax
    '00401032 58                   pop         eax
    '00401033 51                   push        ecx
    '00401034 FF E0                jmp         eax
    '00401036 90                   nop
    '00401037 90                   nop
        Dim dwDummy         As Long
        Dim lIdx            As Long
    
        If m_aDelegatorVtbl(0) = 0 Then
            m_uDelegatorThunk.Code.Thunk(0) = &H51585859
            m_uDelegatorThunk.Code.Thunk(1) = &H9090E0FF
            Call VirtualProtect(m_uDelegatorThunk.Code.Thunk(0), 8, PAGE_EXECUTE_READWRITE, dwDummy)
            m_aDelegatorVtbl(0) = pvAddr(AddressOf pvDelegatorQI)
            m_aDelegatorVtbl(1) = pvAddr(AddressOf pvDelegatorAR)
            m_aDelegatorVtbl(2) = pvAddr(AddressOf pvDelegatorAR)
            For lIdx = 3 To UBound(m_aDelegatorVtbl)
                m_aDelegatorVtbl(lIdx) = VarPtr(m_uDelegatorThunk.Code.Thunk(0))
            Next
        End If
        This.pVTable = VarPtr(m_aDelegatorVtbl(0))
        Call CopyMemory(pvInitDelegator, VarPtr(This), 4)
    End Function
    This allows me to use comctl subclassing with a single redirection function like this
    Code:
    Private Function pvRedirectComCtlProc( _
                ByVal hWnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long, _
                ByVal uIdSubclass As Long, _
                ByVal ThisPtr As Long) As Long
        #If NO_DELEGATOR Then
            m_uComCtlThunk.Code.Thunk(1) = ThisPtr
            m_uComCtlThunk.Code.Thunk(4) = uIdSubclass
            pvRedirectComCtlProc = CallWindowProc(m_uComCtlThunk.pfn, hWnd, wMsg, wParam, lParam)
        #Else
            pvRedirectComCtlProc = m_pDelegator.Call5(uIdSubclass, ThisPtr, hWnd, wMsg, wParam, lParam)
        #End If
    End Function
    Your code looks much better and will allow me to get rid of the custom typelib and simplify the whole delegation story a lot. Kudos!

    cheers,
    </wqw>

  15. #15
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [VB6] - Calling functions by pointer.

    Quote Originally Posted by wqweto View Post
    It seems there is a limitation of `AddressOf` operator -- you cannot use it inside a function to get current function address, i.e. `AddressOf MainComparator` cannot be compiled inside `MainComparator` function.
    Quote Originally Posted by Bonnie West View Post
    Yep, that's a known bug. The suggested workaround in the KB article PRB: Recursive Use of AddressOf Operator Fails is qualifying the procedure's name with the module's name. It'll work even if the procedure is Private and thus not shown in the IntelliSense list.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  16. #16
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    dose it support cdecl dll api?

  17. #17
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    i'm sorry,it can't support cdecl dll api

  18. #18
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    may be the same
    Code:
    MakeFunction GetProcAddress(hUser, "ReleaseDC"),addressof MyReleaseDC
     Function MyReleaseDC( ByVal hWnd As Long, ByVal hdc As Long) As Long
    msgbox "test"
    End Function
    
    Public Sub MakeFunction(DllFunAddr As Long, BackFunAddr As Long)
      Dim code() As Byte, JmpBackAddr As Long
      Dim OldProtect As Long
      Dim ByteLen As Long
      ByteLen = 5
      ReDim code(ByteLen)
      Vblegend.VirtualProtect ByVal DllFunAddr, ByteLen, 64, OldProtect  '更改函数地址所在页面属性
      
      JmpBackAddr = DllFunAddr - BackFunAddr - 5
      code(0) = &HE9
      Vblegend.CopyMemory code(1), JmpBackAddr, 4
      Vblegend.WriteProcessMemory -1, ByVal BackFunAddr, code(0), ByteLen, 0
    End Sub
    
    
    
    Public Sub PatchFunc(ByVal Addr As Long)
        Dim InIDE As Boolean
     
        Debug.Assert MakeTrue(InIDE)
     
        If InIDE Then
            GetMem4 ByVal Addr + &H16, Addr
        Else
            VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
        End If
    
        GetMem4 &HFF505958, ByVal Addr
        GetMem4 &HE1, ByVal Addr + 4
    End Sub
     
    Public Function MakeTrue(ByRef bvar As Boolean) As Boolean
        bvar = True:

  19. #19

  20. #20
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VB6] - Calling functions by pointer.

    VBE x86 can use this module
    but VBE x64 i do not know how to change it
    Code:
    'Func Addr: 26D01E5C
    '26D01E5C: A1 581ED026  mov eax,26D01E58
    '26D01E61: 0B C0        or eax, eax
    '26D01E63: 74 13        je 26D01E78
    '26D01E65: B8 C7C7386A  mov eax, VBE7.EbMode
    '26D01E6A: FF D0        call eax
    '26D01E6C: 83 f8 02     cmp, 02
    '26D01E6F: 74 07        je 26D01E78
    '26D01E71: B8 A22F9621  mov eax, 21962FA2
    
    21962FA2 - 58                    - pop eax
    21962FA3 - 59                    - pop ecx
    21962FA4 - 50                    - push eax
    21962FA5 - FF E1                 - jmp ecx
    21962FA7 - 00 58 59              - add [eax+59],bl
    21962FAA - 4D                    - dec ebp
    21962FAB - 6A FF                 - push -01 { 255 }
    21962FAD - E1 00                 - loope 21962FAF
    21962FAF - 00 24 05 00000300     - add [eax+00030000],ah  'seems only this line change to 00 00 00 after PatchFunc
    21962FB6 - 58                    - pop eax
    21962FB7 - 59                    - pop ecx
    21962FB8 - 50                    - push eax
    21962FB9 - FF E1                 - jmp ecx
    21962FBB - 00 00                 - add [eax],al
    21962FBD - 00 4D 6A              - add [ebp+6A],cl
    21962FC0 - FF E1                 - jmp ecx
    21962FC2 - 00 00                 - add [eax],al
    21962FC4 - 24 05                 - and al,05 { 5 }
    21962FC6 - 00 00                 - add [eax],al
    21962FC8 - 04 00                 - add al,00 { 0 }
    21962FCA - 58                    - pop eax
    21962FCB - 59                    - pop ecx
    21962FCC - 50                    - push eax
    21962FCD - FF E1                 - jmp ecx
    21962FCF - 00 58 59              - add [eax+59],bl
    21962FD2 - 4D                    - dec ebp
    21962FD3 - 6A FF                 - push -01 { 255 }
    21962FD5 - E1 00                 - loope 21962FD7
    21962FD7 - 00 24 05 00000500     - add [eax+00050000],ah
    21962FDE - BA 54CB3B19           - mov edx,193BCB54 { (21962F64) }
    21962FE3 - B9 03E24D6A           - mov ecx,VBE7.ProcCallEngine { (139) }
    21962FE8 - FF E1                 - jmp ecx
    and x64
    Code:
    Func Addr: 1E408398654
    1E408398654 - 48 89 4C 24 08        - mov [rsp+08],rcx
    1E408398659 - 48 89 54 24 10        - mov [rsp+10],rdx
    1E40839865E - 4C 89 44 24 18        - mov [rsp+18],r8
    1E408398663 - 4C 89 4C 24 20        - mov [rsp+20],r9
    1E408398668 - 48 B8 50863908E4010000 - mov rax,000001E408398650 { (1) }
    1E408398672 - 48 0B C0              - or rax,rax
    1E408398675 - 74 32                 - je 1E4083986A9
    1E408398677 - 48 B8 70D09733FB7F0000 - mov rax,VBE7.EbMode { (-1958193856) }
    1E408398681 - FF D0                 - call rax
    1E408398683 - 48 83 F8 02           - cmp rax,02 { 2 }
    1E408398687 - 74 20                 - je 1E4083986A9
    1E408398689 - 48 B8 8CBA560CE4010000 - mov rax,000001E40C56BA8C { (1846495590) }
    
    1E40C56BA8C - 66 49 0F6E EC         - movq xmm5,r12
    1E40C56BA91 - 48 B8 9863C733FB7F0000 - mov rax,VBE7.g_PPExSP { (7FFB33C71868) }
    1E40C56BA9B - 48 8B 00              - mov rax,[rax]
    1E40C56BA9E - 4C 8B 20              - mov r12,[rax]
    1E40C56BAA1 - 49 81 EC 10000000     - sub r12,00000010 { 16 }
    1E40C56BAA8 - 49 8B C4              - mov rax,r12
    1E40C56BAAB - 49 89 8C 24 00000000  - mov [r12+00000000],rcx
    1E40C56BAB3 - 49 89 94 24 08000000  - mov [r12+00000008],rdx
    1E40C56BABB - 48 BA 38BA560CE4010000 - mov rdx,000001E40C56BA38 { (0) }
    1E40C56BAC5 - 48 B8 1A17C033FB7F0000 - mov rax,VBE7.ProcCallEngine { (72) }
    1E40C56BACF - FF E0                 - jmp rax
    1E40C56BAD1 - AB                    - stosd 
    1E40C56BAD2 - BE 58BE0000           - mov esi,0000BE58 { 48728 }
    1E40C56BAD7 - 00 62 92              - add [rdx-6E],ah
    1E40C56BADA - A0 33FB7F0000BB275C   - mov al,[5C27BB00007FFB33] { ("reate") }
    1E40C56BAE3 - 68 7D000000           - push 0000007D { 125 }
    1E40C56BAE8 - 24 07                 - and al,07 { 7 }

  21. #21

  22. #22
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    How to change code to support cdecl api?

    Public Sub PatchFunc(FuncName As String, ByVal CdeclAddr As Long)

    hao to call Sqlite3.dll with cdecl?-VBForums
    https://www.vbforums.com/showthread....dll-with-cdecl

  23. #23

  24. #24
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    call cdecl api by vb6:

    how to simplified code without toBytes(*) like this?
    Code:
     
    GetMem4 &HFF505958, ByVal lpAddr
    GetMem4 &HE1, ByVal lpAddr + 4
    Because modifying the assembly code during the function process in the IDE may cause VB6.EXE to crash, this method was used, but the stability is unknown.

    CopyMemory2 VbFunction, ByVal VbFunction + &H16, 4


    Code:
    sub main()
    Dim CdeclApi As Long
    CdeclApi = GetProcAddress(LoadLibrary("cdecl.dll"), "ADD")
    
    FixCdecl AddressOf VB_Sum, CdeclApi, 2
    
    Dim A As Long, B As Long, c As Long
    A = 11
    B = 22
    c = VB_Sum(A, B)
    end sub
    
    Function VB_Sum(ByVal A As Long, ByVal B As Long, Optional NullArg As Long) As Long
    
    MsgBox 1
    MsgBox 2
    MsgBox 3
    MsgBox 4
    MsgBox 5
    MsgBox 6
    MsgBox 7
    MsgBox 8
    End Function
    Code:
    Public Const PAGE_EXECUTE_READWRITE As Long = &H40
    Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function WriteProcessMemory2 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
    Declare Function VirtualProtect2 Lib "kernel32" Alias "VirtualProtect" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long  '设置内存可读写
    
    Sub FixCdecl(VbFunction As Long, CdeclApi As Long, Args As Long) 'GOOD
    'cdecl绑定vb函数模块 qq 2776478814
    
    'VbFunction,vb模块中的函数地址,用来绑定cdecl函数
    'CdeclApi,cdecl的函数地址
    'Args=cdecl函数需要几个参数
    '
        Dim Asm(4) As String, Stub() As Byte, THUNK_SIZE As Long
        '  0: 58                   pop         eax
        '  1: 89 84 24 XX XX XX XX mov         dword ptr [esp+Xh],eax
        Asm(0) = "58 89 84 24 " & LongToHex(Args * 4) '&H24848958
        Asm(1) = "B8 " & LongToHex(CdeclApi)       'B8 90807000    MOV EAX,708090
        Asm(2) = "FF D0"                           'FFD0           CALL EAX
        Asm(3) = "83 C4 " & Hex(Args * 4) '83 C4 XX       add esp, XX     'cleanup args
        Asm(4) = "C3"
        
        Stub() = toBytes(Join(Asm, " "))
        THUNK_SIZE = UBound(Stub) + 1
        
        Dim bInIDE          As Boolean
        Debug.Assert pvSetTrue(bInIDE)
      
        If bInIDE Then
            CopyMemory2 VbFunction, ByVal VbFunction + &H16, 4
        Else
            VirtualProtect2 VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0    '更改函数地址所在页面属性
        End If
        WriteProcessMemory2 -1, VbFunction, VarPtr(Stub(0)), THUNK_SIZE, 0
    End Sub
    
    Function toBytes(x As String) As Byte()
        Dim tmp() As String
        Dim fx() As Byte
        Dim i As Long
        tmp = Split(x, " ")
        ReDim fx(UBound(tmp))
        For i = 0 To UBound(tmp)
            fx(i) = CInt("&h" & tmp(i))
        Next
        toBytes = fx()
    End Function
    
     Function LongToHex(x As Long) As String
        Dim B(1 To 4) As Byte
        CopyMemory2 B(1), x, 4
        LongToHex = Hex(B(1)) & " " & Hex(B(2)) & " " & Hex(B(3)) & " " & Hex(B(4))
    End Function
     Function pvSetTrue(bValue As Boolean) As Boolean
        bValue = True
        pvSetTrue = True
    End Function
    Last edited by xiaoyao; Apr 18th, 2023 at 03:01 AM.

  25. #25

  26. #26
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    Quote Originally Posted by The trick View Post
    It feels like I'm talking to some kind of artificial intelligence.
    use cdecl add-in It's a great method, I want to try another one. Because my CDECL.DLL is in memory, there is no such file on the hard drive. So it is not possible to directly declare API adding CDECL keywords

  27. #27

  28. #28
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    Maybe you can add the keyword CDECL to the function in the VB module, and then jump an API address JMP in the data area of CDECL.DLL in the memory to the process function in VB. This is also a method
    However, I still prefer not to use the CDECL add-on ADD-IN to handle it.
    The only issue currently encountered is that it is not possible to write assembly code to this VB6 function unless' fully compiled execution 'is executed (After compiling into EXE, it runs completely normally)
    If the code in the module is modified or only 2 blank lines are added, it will cause the assembly to fail writing VB functions.
    Click the second button,
    Execute 'FixCdecl AddressOf VB_Sum, CdeclApi, 2' for the second time before the assembly can write or bind successfully.

    Is it possible that the process address in memory may change at any time without complete compilation in the IDE?

    Code:
            EbGetExecutingProj hProj
            TipGetFunctionId hProj, StrPtr(FuncName), sId
            TipGetLpfnOfFunctionId hProj, sId, lpAddr
            SysFreeString sId
            
            
            'CopyMemory2 lpAddr, ByVal lpAddr + &H16, 4
            VirtualProtect2 VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0
    how to get real address of VB_Sum ,by TipGetLpfnOfFunctionId ( lpAddr )?
    maybe write asmcode err?

  29. #29
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Calling functions by pointer.

    Çàïèñûâàåì âñòàâêó
    ' Çàïóñêàòü òîëüêî ïî Ctrl+F5!!

    I didn't understand what the text was. Do I also need to press CTRL+F5 to run normally?
    My CDECL also encountered this issue when calling by function address. I ran it directly with F5, but the assembly I wrote did not seem to take effect.

    It only takes effect when the button is clicked to run for the second time (press f5)

    ctrl+f5 No problem at all, no need to press the button twice
    Last edited by xiaoyao; Apr 18th, 2023 at 08:19 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width