dcsimg
Results 1 to 15 of 15

Thread: [VB6] - Calling functions by pointer.

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,315

    [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
    18,118

    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
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,315

    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
    18,118

    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
    4,235

    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
    18,118

    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
    4,235

    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
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,315

    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
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,356

    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
    Fanatic Member
    Join Date
    May 2014
    Location
    Preveza Greece
    Posts
    948

    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
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,315

    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
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,315

    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
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,356

    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,057

    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)

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
  •  



Featured


Click Here to Expand Forum to Full Width