callby address,AddressOf pointer,Delegate function for vb6/twinbasic

[xiaoyao]

like this:I don't know if this principle is true?
https://nolongerset.com/twinbasic-up...ember-30-2024/

Delegate function SumCall(FunAddress as long,a as long,b as long) as long
sumcall= @FunAddress (a,b)

end function

function sum(a as long,b as long) as lnog
sum=a+b
end function

function sum2(a as long,b as long) as long
sum=a+b*2
end function

dim r as long
r=SumCall( addressof(sum),a,b)

[fafalone]

https://github.com/twinbasic/lang-de...ent-2381254373

Private Delegate Function Delegate1 (ByVal A As Long, ByVal B As Long) As Long
    
    Private Sub Command1_Click()
        Dim myDelegate As Delegate1 = AddressOf Addition
        MsgBox "Answer: " & myDelegate(5, 6)
    End Sub
    
    Public Function Addition(ByVal A As Long, ByVal B As Long) As Long
        Return A + B
    End Function

[Schmidt]

*.bas Module-Code For VB6 (when an RC6-ref is used):

Sub Main()
  Debug.Print New_c.stdCall(retLong, AddressOf Sum, 5, 6)
End Sub

Function Sum(ByVal a As Long, ByVal b As Long) As Long
  Sum = a + b
End Function

Olaf

[wqweto]

Here is a sample QuickSort implementation with custom comparator which is passed as a delegate

[Description("")]
[FormDesignerId("3C17E68E-5D96-4924-9D57-D5ADE1FBCADA")]
[PredeclaredId]
Class Form1

    Private Sub Form_Load()
        Dim A()         As Long
        Dim lIdx        As Long
        
        ReDim A(0 To 100) As Long
        For lIdx = 0 To UBound(A)
            A(lIdx) = Rnd() * 1000
        Next
        Dim pfn As SortComparator = AddressOf CompGreater
        QuickSort A, pfn
        For lIdx = 1 To UBound(A)
            Debug.Print A(lIdx) ;
            If pfn(A(lIdx), A(lIdx - 1)) Then
                Debug.Print "Not sorted at position " & lIdx
            End If
        Next
    End Sub
    
    '== Delegates sample: QuickSort using custom comparators ===========================================
    
    Private Delegate Function SortComparator (ByVal A As Long, ByVal B As Long) As Boolean

    Private m_pfnComp As SortComparator

    Public Sub QuickSort(A() As Long, Optional pfnComp As SortComparator = CType(Of SortComparator)(vbNullPtr))
        If pfnComp = CType(Of SortComparator)(vbNullPtr) Then
            m_pfnComp = AddressOf CompLess
        Else
            m_pfnComp = pfnComp
        End If
        pvQuickSortImpl A, LBound(A), UBound(A)
    End Sub

    Public Function CompLess(ByVal A As Long, ByVal B As Long) As Boolean
        Return A < B
    End Function
    
    Public Function CompGreater(ByVal A As Long, ByVal B As Long) As Boolean
        Return A > B
    End Function
    
    Private Sub pvQuickSortImpl(A() As Long, ByVal lo As Long, ByVal hi As Long)
        Dim lt      As Long
        Dim gt      As Long
        
        Do While lo < hi
            pvQuickSortPartition A, lo, hi, lt, gt
            pvQuickSortImpl A, lo, lt - 1
            lo = gt + 1
        Loop
    End Sub
    
    Private Sub pvQuickSortPartition(A() As Long, ByVal lo As Long, ByVal hi As Long, lt As Long, gt As Long)
        Dim pivot   As Long
        Dim eq      As Long
        Dim temp    As Long
        
        pivot = A(lo + (hi - lo) \ 2)
        lt = lo
        eq = lo
        gt = hi
        Do While eq <= gt
            If m_pfnComp(A(eq), pivot) Then
                ' Swap A(eq), A(lt)
                temp = A(eq): A(eq) = A(lt): A(lt) = temp
                lt = lt + 1
                eq = eq + 1
            ElseIf m_pfnComp(pivot, A(eq)) Then
                ' Swap A(eq), A(gt)
                temp = A(eq): A(eq) = A(gt): A(gt) = temp
                gt = gt - 1
            Else
                eq = eq + 1
            End If
        Loop
    End Sub
    
End Class

cheers,
</wqw>

[SearchingDataOnly]

IMO, Olaf's approach seems simpler and clearer, which implements delegate without changing the programming habits of VB6ers.

I'd like to know what are the disadvantages of Olaf's approach, or rather, what are the advantages of twinBasic's approach compared to Olaf's approach.

Also, it would be nice if there is a way to implement generics without changing the programming habits of VB6ers.

Edit:
I've just tested that VB6's AddressOf can only be used for functions in modules, which may be a minor limitation of the Olaf method.

[xiaoyao]

IMO, Olaf's approach seems simpler and clearer, which implements delegate without changing the programming habits of VB6ers.

I'd like to know what are the disadvantages of Olaf's approach, or rather, what are the advantages of twinBasic's approach compared to Olaf's approach.

Also, it would be nice if there is a way to implement generics without changing the programming habits of VB6ers.

Edit:
I've just tested that VB6's AddressOf can only be used for functions in modules, which may be a minor limitation of the Olaf method.

twinbasic like vb.net+vba+vb6

More grammar is added, so it will be more and more difficult to learn.
In fact, it should be replaced by adding an assembly instruction.
asm any call:function address pointer,,arg1 as long,arg2 as long)

[SearchingDataOnly]

More grammar is added, so it will be more and more difficult to learn.

Agree.

The goals I've set for my scripting language are:
Compared to VB6, the functionality is increased by 95%, but the difficulty is only increased by 5%. That is, any grammar that increases the difficulty of learning will be vetoed.

[WaynePhillipsEA]

You're missing the key point here.

Delegates primarily offer type safety. At design time, they create a contract between the caller and callee, ensuring through the type system that no mistakes slip through. This works similarly to how an interface defines communication between two parties.

In VB6, passing around Long or LongPtr lacks this safety. The compiler can't catch issues like changing parameter types, switching between ByVal and ByRef, or altering return types. Since you're just passing pointers, it's easy to introduce bugs, especially when refactoring, as you lose all compiler checks.

With delegates in twinBASIC, the compiler immediately flags any mismatch between the expected and actual delegate definitions. For example, if you miswrite a callback, the compiler will alert you instantly. This makes refactoring much safer and prevents hard-to-debug crashes.

There are also other advantages. The IDE provides IntelliSense for delegate calls, and calling a delegate compiles down to a simple call instruction, making it more efficient than using generic wrapper functions that require runtime type checks/manipulation. The performance impact will be more evident once LLVM compilation is fully available.

As for the argument about syntax complexity, it's a non-issue here. The delegate syntax is simple—just one line. For example:

Private Delegate Function SortComparator(ByVal A As Long, ByVal B As Long) As Boolean

That's it. You can then use SortComparator instead of LongPtr for function pointers.

[SearchingDataOnly]

Great knowledge points, thank you, WaynePhillipsEA.

I'm just thinking about how we can achieve the benefits you mentioned above without adding the Delegate keyword.

[VanGoghGaming]

The Delegate keyword is better than a cryptic symbol like you have in C++ and C#.

Also I think in .Net delegates are implemented as objects rather than function pointers but I may be talking nonsense since I'm not a .Net person...

[SearchingDataOnly]

The Delegate keyword is better than a cryptic symbol like you have in C++ and C#.

Yes, if there is no better solution, then we can only use the Delegate keyword.

[xiaoyao]

You're missing the key point here.

Delegates primarily offer type safety. At design time, they create a contract between the caller and callee, ensuring through the type system that no mistakes slip through. This works similarly to how an interface defines communication between two parties.

In VB6, passing around Long or LongPtr lacks this safety. The compiler can't catch issues like changing parameter types, switching between ByVal and ByRef, or altering return types. Since you're just passing pointers, it's easy to introduce bugs, especially when refactoring, as you lose all compiler checks.

With delegates in twinBASIC, the compiler immediately flags any mismatch between the expected and actual delegate definitions. For example, if you miswrite a callback, the compiler will alert you instantly. This makes refactoring much safer and prevents hard-to-debug crashes.

There are also other advantages. The IDE provides IntelliSense for delegate calls, and calling a delegate compiles down to a simple call instruction, making it more efficient than using generic wrapper functions that require runtime type checks/manipulation. The performance impact will be more evident once LLVM compilation is fully available.

As for the argument about syntax complexity, it's a non-issue here. The delegate syntax is simple—just one line. For example:

Private Delegate Function SortComparator(ByVal A As Long, ByVal B As Long) As Boolean

That's it. You can then use SortComparator instead of LongPtr for function pointers.

url How does vb 6 place the DLL of the assembly call CDECL and return the value


https://www.vbforums.com/showthread....=1#post5500922
https://www.vbforums.com/showthread....=1#post5501057

wqweto, you could just save the ret_addr elsewhere like into unused last arg.
For example: .

Public Function CallCdecl2( _
                ByVal pfn As Long, _
                ByVal lArg1 As Long, _
                ByVal lArg2 As Long, _
                Optional ByVal lRetSpace As Long) As Long
End Function
Public Function CallCdecl4( _
                ByVal pfn As Long, _
                ByVal lArg1 As Long, _
                ByVal lArg2 As Long, _
                ByVal lArg3 As Long, _
                ByVal lArg4 As Long, _
                Optional ByVal lRetSpace As Long) As Long
End Function

Sub FixCdecl(VbFunction As Long, CdeclApi As Long, Args As Long) 'GOOD
    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

Delegates can be used in many places.
For example, Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal addr As Long, ByVal NewVal As Long)
Public Declare Function ArrPtr Lib "msvbvm60" Alias ??"#390" (vArray As Variant) As Long
1. Unpublished function addresses can also be used.
2 For example, the VB6 class object CLASS1 has a public method public sub Test1() and a private method Private Function Sum(a,b)
3. Even like activex.exe, COM++ can construct a virtual COM object or a virtual WINDOWS API across processes, across two computers, and between LINUX/windows.
4. For example, under LINUX, construct a virtual CMD.exe command line calling method.
5. Package .NET classes and functions into VB6 functions for use
6. Used for Hook api. Before vb6, many things relied on ASM CHUNK. The code was super complex and difficult to maintain. For example, the picture object supported PNG, transparent attributes, etc. Timer callback in the class, subclass processing of control and form events.

If you make a Delegates_com, you don't need to write any code, and the address translation of the function in the VB6 CLASS1 class is automatically implemented for the settimer api callback.
Private Delegates_com Sub TimerExProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
** code
end sub
VB6 API callback, the first step is to change the original function address to a new function for monitoring data. After obtaining the data, you need to call the original function. In assembly, it may only require one sentence, but in VB6 it requires a lot of code. :
For example, restore the address of the original function, manually call the API or address again, and then hook again to modify the address. If other threads trigger the address multiple times during this process, the HOOK data will be missing and incomplete.
In fact, just call it once in assembly any Call Pointertr1,arg1,arg2

7. Used to dynamically load DLL into other processes and remotely call DLL functions in third-party EXE processes (remote call)
8. Dynamic memory loading DLL can release the binary content of the PE into variables, then obtain the address of each DLL EXPORTS API, and then delegate it to a normal function to call, completing the role of dynamically declaring the API.

Taking orders is actually an interface, but it is simpler than the interface of COM objects and is just a function structure.
But it can be used for assembly calls CALL address_Ptr, Arg1, Arg2, and can also be used for callbacks and events, such as events generated in .NET multi-threads, but after delegation, let it execute the function in the main thread and update the UI.
The main feature is that the compiler can directly convert into the shortest assembly instructions, and can also check for code errors, improve security and memory leaks, etc., which is really good.

[xiaoyao]

The Delegate keyword is better than a cryptic symbol like you have in C++ and C#.

Also I think in .Net delegates are implemented as objects rather than function pointers but I may be talking nonsense since I'm not a .Net person...

CDECLFunctionDelegator.bas from :PowerVB

Attribute VB_Name = "modCDECLFunctionDelegator"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'   Files:
'     None
'   Minimal VBoost conditionals:
'     None
'   Conditional Compilation Values:
'     CDECLFUNCTIONDELEGATOR_NOSTACK = 1 'eliminates support for NewCDECLDelegator
'     CDECLFUNCTIONDELEGATOR_NOHEAP = 1  'eliminates support for InitCDECLDelegator
'
' This file is discussed in Chapter 11.
'***************************************************************
Option Explicit

'Test for InitCDECLDelegator support
#Const STACKALLOCSUPPORT = CDECLFUNCTIONDELEGATOR_NOSTACK = 0

'Test for NewCDECLDelegator support
#Const HEAPALLOCSUPPORT = CDECLFUNCTIONDELEGATOR_NOHEAP = 0

'Test for InitCDECLThunk support
#Const THUNKSUPPORT = CDECLFUNCTIONDELEGATOR_NOTHUNK = 0

Private Const cCDECLDelegateSize As Long = 22

#If THUNKSUPPORT Then
Private Const cCDECLThunkSize As Long = 19
Private Type CDECLThunkBytes
    Bytes(cCDECLThunkSize - 1) As Long
End Type

Public Type CDECLThunk
    pfn As Long
    Code As CDECLThunkBytes
End Type
Private m_CDECLThunkASM As CDECLThunkBytes       'Thunk bits to make stdcall look like cdecl call
#End If 'THUNKSUPPORT

#If STACKALLOCSUPPORT Or HEAPALLOCSUPPORT Then
Private m_CDECLDelegateASM As CDECLDelegateBytes 'Buffer for ASM code (vtable call to cdecl call)

Private Type CDECLDelegateBytes
    Bytes(cCDECLDelegateSize - 1) As Long
End Type

Private Type DelegatorVTables
    VTable(7) As Long  'QIOK vtable in 0 to 3, QIFail vtable in 4 to 7
End Type

#If STACKALLOCSUPPORT Then
'Structure for a stack allocated Delegator
Private m_VTables As DelegatorVTables
Private m_pVTableOKQI As Long       'Pointer to vtable, no allocation version
Private m_pVTableFailQI As Long     'Pointer to vtable, no allocation version
Public Type CDECLFunctionDelegator
    pVTable As Long   'This has to stay at offset 0
    pfn As Long       'This has to stay at offset 4
    StackSize As Long 'This has to stay at offset 8
End Type
#End If 'STACKALLOCSUPPORT

#If HEAPALLOCSUPPORT Then
'Structure for a heap allocated Delegator
Private m_VTablesHeapAlloc As DelegatorVTables
Private m_pVTableHeapAllocOKQI As Long   'Pointer to vtable, heap version
Private m_pVTableHeapAllocFailQI As Long 'Pointer to vtable, heap version
Private Type CDECLFunctionDelegatorHeapAlloc
    pVTable As Long   'This has to stay at offset 0
    pfn As Long       'This has to stay at offset 4
    StackSize As Long 'This has to stay at offset 8
    cRefs As Long
End Type
#End If 'HEAPALLOCSUPPORT

#If STACKALLOCSUPPORT Then
'Functions to initialize a Delegator object on an existing CDECLFunctionDelegator
Public Function InitCDECLDelegator(Delegator As CDECLFunctionDelegator, Optional ByVal pfn As Long, Optional ByVal StackSize As Long) As IUnknown
    If m_pVTableOKQI = 0 Then InitVTables
    With Delegator
        .pVTable = m_pVTableOKQI
        .pfn = pfn
        .StackSize = StackSize
    End With
    CopyMemory InitCDECLDelegator, VarPtr(Delegator), 4
End Function
Private Sub InitVTables()
Dim pAddRefRelease As Long
    With m_VTables
        .VTable(0) = FuncAddr(AddressOf QueryInterfaceOK)
        .VTable(4) = FuncAddr(AddressOf QueryInterfaceFail)
        pAddRefRelease = FuncAddr(AddressOf AddRefRelease)
        .VTable(1) = pAddRefRelease
        .VTable(5) = pAddRefRelease
        .VTable(2) = pAddRefRelease
        .VTable(6) = pAddRefRelease
        If m_CDECLDelegateASM.Bytes(0) = 0 Then InitCDECLDelegateASM
        .VTable(3) = VarPtr(m_CDECLDelegateASM.Bytes(0))
        .VTable(7) = .VTable(3)
        m_pVTableOKQI = VarPtr(.VTable(0))
        m_pVTableFailQI = VarPtr(.VTable(4))
    End With
End Sub
Private Function QueryInterfaceOK(This As CDECLFunctionDelegator, riid As Long, pvObj As Long) As Long
    pvObj = VarPtr(This)
    This.pVTable = m_pVTableFailQI
End Function
Private Function AddRefRelease(ByVal This As Long) As Long
    'Nothing to do, memory not refcounted
End Function
#End If 'STACKALLOCSUPPORT

#If HEAPALLOCSUPPORT Then
'Functions to create a refcounted version of the function pointer wrapper object
Public Function NewCDECLDelegator(ByVal pfn As Long, ByVal StackSize As Long) As IUnknown
Dim Struct As CDECLFunctionDelegatorHeapAlloc
Dim ThisPtr As Long
    If m_pVTableHeapAllocOKQI = 0 Then InitHeapAllocVTables
    With Struct
        ThisPtr = CoTaskMemAlloc(LenB(Struct))
        If ThisPtr = 0 Then Err.Raise 7
        .pVTable = m_pVTableHeapAllocOKQI
        .cRefs = 1
        .pfn = pfn
        .StackSize = StackSize
        CopyMemory ByVal ThisPtr, Struct, LenB(Struct)
        CopyMemory NewCDECLDelegator, ThisPtr, 4
    End With
End Function
Private Sub InitHeapAllocVTables()
    With m_VTablesHeapAlloc
        .VTable(0) = FuncAddr(AddressOf QueryInterfaceHeapAllocOK)
        .VTable(4) = FuncAddr(AddressOf QueryInterfaceFail)
        .VTable(1) = FuncAddr(AddressOf AddRefHeapAlloc)
        .VTable(5) = .VTable(1)
        .VTable(2) = FuncAddr(AddressOf ReleaseHeapAlloc)
        .VTable(6) = .VTable(2)
        If m_CDECLDelegateASM.Bytes(0) = 0 Then InitCDECLDelegateASM
        .VTable(3) = VarPtr(m_CDECLDelegateASM.Bytes(0))
        .VTable(7) = .VTable(3)
        m_pVTableHeapAllocOKQI = VarPtr(.VTable(0))
        m_pVTableHeapAllocFailQI = VarPtr(.VTable(4))
    End With
End Sub
Private Function QueryInterfaceHeapAllocOK(This As CDECLFunctionDelegatorHeapAlloc, riid As Long, pvObj As Long) As Long
    With This
        pvObj = VarPtr(.pVTable)
        .cRefs = .cRefs + 1
        .pVTable = m_pVTableHeapAllocFailQI
    End With
End Function
Private Function AddRefHeapAlloc(This As CDECLFunctionDelegatorHeapAlloc) As Long
    With This
        .cRefs = .cRefs + 1
        AddRefHeapAlloc = .cRefs
    End With
End Function
Private Function ReleaseHeapAlloc(This As CDECLFunctionDelegatorHeapAlloc) As Long
    With This
        .cRefs = .cRefs - 1
        ReleaseHeapAlloc = .cRefs
        If .cRefs = 0 Then
            'Don't try to step over FreeBuffer, we're freeing
            'This, and the debugger could die.
            CoTaskMemFree VarPtr(.pVTable)
        End If
    End With
End Function
#End If 'HEAPALLOCSUPPORT

Private Function QueryInterfaceFail(ByVal This As Long, riid As Long, pvObj As Long) As Long
    pvObj = 0
    QueryInterfaceFail = E_NOINTERFACE
End Function

Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function

Private Sub InitCDECLDelegateASM()
'Here's the assembly code to translate a stdcall vtable call into
'a cdecl non-vtable call.  This code requires the stack size to be known.
'The whole point of this is to make a cdecl call, then clean the stack after
'the call so that it looks like a stdcall.  In order to do this, we need to
'store our data on the stack and then call the cdecl function.  This requires
'that we duplicate the parameters for the call above our stack data and push
'our own base pointer as a reference.  After the function returns, we use the
'base pointer to relocate our own values and remove the correct number of bytes
'from the stack.

'#define _PAGESIZE_ 0x1000
'push ebp                       // Run some prolog code
'mov ebp, esp                   // this = [ebp + 8], return = [ebp + 4], old ebp = [ebp]
'push esi
'push edi
'push ebx
'mov eax, [ebp + 8]             // Get this pointer
'mov ecx, [eax + 8]             // Get byte count into ecx
'mov ebx, ecx                   // Save the stacksize in ebx
'
'mov edi, esp                   // Make sure we have the stack safely loaded
'
'probepages:
'cmp ecx, _PAGESIZE_            // See if we need more than one page of stack
'jb short lastpage              // Note that this is very unlikely, but we must be safe.
'
'sub ecx, _PAGESIZE_            // yes, move down a page
'sub edi, _PAGESIZE_            // adjust request and...
'
'test DWORD PTR [edi], ecx      // ...probe it
'
'jmp short probepages           // Keep going
'
'lastpage:
'sub edi, ecx                   // Do a final probe
'test DWORD PTR [edi], ecx
'
'mov ecx, ebx                   // Reload ecx in case probing changed it
'
'mov esi, ebp                   // Establish the source pointer for the stack copy
'Add esi, 12
'
'mov esp, edi                   // Move the stack down before we lose edi
'
'shr ecx, 2                     // Change the byte stack size in ecx to a DWORD count
'cld                            // Copy ascending
'rep movsd                      // Do the stack copy (the DWORD count is in ecx)
'
'call DWORD PTR [eax + 4]       // Make the cdecl function call (the this pointer is still in eax)
'
'mov ecx, ebp                   // Move the return value to the correct position on the stack
'add ecx, 8                     // Add to move past this and function return values
'add ecx, ebx                   // Add extra stack size
'mov esi, [ebp + 4]             // Get return address.  Use esi since eax/edx hold the return value.
'mov [ecx], esi                 // Assign return address to correct position on stack.
'
'mov esp, ebp                   // Move the stack and restore the saved registers
'sub esp, 12
'pop ebx
'pop edi
'pop esi
'pop ebp
'mov esp, ecx                   // Move the stack pointer down
'ret                            // return to the calling function

    With m_CDECLDelegateASM
        .Bytes(0) = &H56EC8B55
        .Bytes(1) = &H458B5357
        .Bytes(2) = &H8488B08
        .Bytes(3) = &HFC8BD98B
        .Bytes(4) = &H1000F981
        .Bytes(5) = &H10720000
        .Bytes(6) = &H1000E981
        .Bytes(7) = &HEF810000
        .Bytes(8) = &H1000
        .Bytes(9) = &HE8EB0F85
        .Bytes(10) = &HF85F92B
        .Bytes(11) = &HF58BCB8B
        .Bytes(12) = &H8B0CC683
        .Bytes(13) = &H2E9C1E7
        .Bytes(14) = &HFFA5F3FC
        .Bytes(15) = &HCD8B0450
        .Bytes(16) = &H308C183
        .Bytes(17) = &H4758BCB
        .Bytes(18) = &HE58B3189
        .Bytes(19) = &H5B0CEC83
        .Bytes(20) = &H8B5D5E5F
        .Bytes(21) = &HCCCCC3E1
    End With
End Sub
#End If 'HEAPALLOCSUPPORT Or STACKALLOCSUPPORT

#If THUNKSUPPORT Then
Public Sub InitCDECLThunk(CDECLThunk As CDECLThunk, ByVal pfn As Long, ByVal StackSize As Long)
    If m_CDECLThunkASM.Bytes(0) = 0 Then InitCDECLThunkASM
    With CDECLThunk.Code
        CopyMemory .Bytes(0), m_CDECLThunkASM.Bytes(0), 4 * cCDECLThunkSize
        .Bytes(1) = StackSize
        .Bytes(16) = pfn
        'Inlined UnsignedAdd
        CDECLThunk.pfn = (VarPtr(.Bytes(0)) Xor &H80000000) + 3 Xor &H80000000
    End With
End Sub

Public Sub UpdateCDECLThunk(CDECLThunk As CDECLThunk, ByVal pfn As Long, ByVal StackSize As Long)
    With CDECLThunk.Code
        .Bytes(1) = StackSize
        .Bytes(16) = pfn
    End With
End Sub

Private Sub InitCDECLThunkASM()
'Here's the assembly code to make a caller expecting a cdecl function
'actually call a stdcall function.  The principle is simple: since the
'caller leaves the parameters on the stack, we'll just duplicate the
'parameters so that when the stdcall function cleans the stack, it is still
'left with the right number of parameters for the caller to clean.  This
'asm isn't quite complete in that the stacksize value and stdcall function
'pointer values need to be inserted into the correct locations.

'#define _PAGESIZE_ 0x1000
'nop                            // 3 nops so our insertion values end up dword aligned
'nop
'nop
'mov ecx, 16                    // 16 is a sample value (replace with real number)
'mov edx, ecx                   // Store current ecx value in edx in case ecx changes during the probing code
'add ecx, 8                     // Adjust for esi, edi push
'mov eax, esp                   // Grab the current stack pointer
'
'probepages:
'cmp ecx, _PAGESIZE_            // See if we've requested more than one page of stack
'jb short lastpage              // Note that this is very unlikely, but we must be safe.
'
'sub     ecx, _PAGESIZE_        // yes, move down a page
'sub     eax, _PAGESIZE_        // adjust request and...
'
'test    DWORD PTR [eax],ecx    // ...probe it
'
'jmp short probepages           // Keep going
'
'lastpage:
'sub eax, ecx                   // This is where we want the stack to be when we're done
'test DWORD PTR [eax], ecx      // Probe this position on the stack to make sure its loaded
'
'mov [eax], edi                 // Save off the current edi and esi registers
'mov [eax + 4], esi
'
'mov edi, eax                   // Get ready to do the copy.  Set the dest to the adjusted location.
'Add edi, 8
'mov esi, esp                   // Set the source to esp, which is the return address
'mov ecx, edx                   // Restore ecx value from edx
'shr ecx, 2                     // Change from a byte count to a DWORD count
'inc ecx                        // Add 1 DWORD for the return address
'cld                            // Set the ascending flag
'rep movsd                      // Do the stack copy.  The last dest is the starting source.
'
'mov edx, 1234h                 // Get the function pointer (replace when thunk runs)
'mov esp, eax                   // Move the stack up to the new location
'
'pop edi                        // Restore registers
'pop esi
'jmp edx                        // Jump to the stdcall function
    
    With m_CDECLThunkASM
        'pfn should be set to VarPtr(Item(0) + 3)
        .Bytes(0) = &HB9909090
        '.Bytes(1) = 0 'Insert stacksize here
        .Bytes(2) = &HC183D18B
        .Bytes(3) = &H81C48B08
        .Bytes(4) = &H1000F9
        .Bytes(5) = &H810F7200
        .Bytes(6) = &H1000E9
        .Bytes(7) = &H10002D00
        .Bytes(8) = &H8850000
        .Bytes(9) = &HC12BE9EB
        .Bytes(10) = &H38890885
        .Bytes(11) = &H8B047089
        .Bytes(12) = &H8C783F8
        .Bytes(13) = &HCA8BF48B
        .Bytes(14) = &H4102E9C1
        .Bytes(15) = &HBAA5F3FC
        '.Bytes(16) = 0 'Insert function pointer here
        .Bytes(17) = &H5E5FE08B
        .Bytes(18) = &HCCCCE2FF
    End With
End Sub
#End If 'THUNKSUPPORT

[xiaoyao]

https://www.vbforums.com/showthread....sembler-Add-in

Hello everyone!
There are cases where you need to use the assembly code in your VB6 projects. Usually this is done using a previously-compiled code that is placed into the the memory.

wqweto, you could just save the ret_addr elsewhere like into unused last arg.

You just need to install the Add-in.

CDECL_Delegator2

CDeclTrampolin.vbp :

[InlineAssembler]
FileName=CDeclTrampolin.ia

does vb6 support asm file in project?

CDeclTrampolin.ia:

CallCdecl1?   BITS 32

NUM_OF_ARGS equ 1

pop eax	; get retaddr
pop ecx	; get pfn

mov [esp + NUM_OF_ARGS * 4], eax

call ecx

add esp, NUM_OF_ARGS * 4

ret


   CallCdecl2   BITS 32

NUM_OF_ARGS equ 2

pop eax	; get retaddr
pop ecx	; get pfn

mov [esp + NUM_OF_ARGS * 4], eax

call ecx

add esp, NUM_OF_ARGS * 4

ret

[PlausiblyDamp]

The Delegate keyword is better than a cryptic symbol like you have in C++ and C#.

Also I think in .Net delegates are implemented as objects rather than function pointers but I may be talking nonsense since I'm not a .Net person...

Delegates are objects in .Net, in fact a delegate isn't just a function pointer as it can point to multiple methods.

Also, just because something is an object from the language point of view this doesn't mean the generated code has to be bloated. Recent versions of .net have made some big improvements in how the JIT handles delegates.

[xiaoyao]

NOPs do not take any CPU cycles on execution nowadays but I use these to align following offsets in the thunk so to make "codegen" of the variable NUM_OF_ARGS easier like this

The extra Spacer parameter was the invention in this thread. Kudos!

cheers,
</wqw>

Call_ultow Pfn, &H80212123, StrPtr(sBuffer), 10

[Niya]

Also I think in .Net delegates are implemented as objects rather than function pointers but I may be talking nonsense since I'm not a .Net person...

Yes, they are objects, little different from any other .Net object. A .Net delegate is described as a "type safe function pointer" by Microsoft.

[Schmidt]

Yes, they are objects, ...

Yep, if you want typesafety - the same approach can be used in VB6 -
when you pass a Callback-Object (which implements a certain Callback-Interface) ...
as e.g. ICompare - to a generic a QuickSort-routine.

Olaf

[wqweto]

Btw, probably this train of thought was the reason VB6 never got delegates. Unfortunately even VBScript is more equiped to provide callbacks using default method on IDispatch using it's builtin GetRef function.

I wouldn't be surprised if TB got GetRef implementation at some point after v1 so that handling XMLHTTP's OnReadyStateChange event become trivial (compared to extra wrapper classes needed in VBx).

cheers,
</wqw>

[xiaoyao]

Com CallBack Delegate sample:

TimerEx.cls
more code (*****) please click link:

Public Sub Module_TimerProcDemo(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
     Debug.Print "hwnd=" & hwnd & ",idEvent=" & idEvent & ",Class_ObjPtr1=" & Class_ObjPtr1
     Delegate_Class_TimerProc Class_TimerProc_Address1, Class_ObjPtr1, hwnd, uMsg, idEvent, dwTime
End Sub

Public Sub Delegate_Class_TimerProc(ByVal Class_TimerProc_Address As Long, ByVal This_Class_ObjPtr As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
' ASMCALL Class_TimerProc_Address (This_Class_ObjPtr ,HWND,UMSG,IDEVENT,DWTIME)
End Sub