VB6 - Declaring and calling C DLL with pointers

Question

I have an old C DLL I use to call from Ruby, but now I need to call it from VB6 and I can\'t figure out the correct way to do so.

Here is the header for the function

Answer 1

You can use a CDECL calling thunk like this

Option Explicit

'--- for VirtualProtect'
Private Const PAGE_EXECUTE_READWRITE    As Long = &H40

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) 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
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const STR_MYDLL         As String = "my.dll"

Private Type UcsParamThunk
    pfn                     As Long
    Call_(0 To 7)           As Long
End Type

Private m_hModule           As Long
Private m_uCallThunk        As UcsParamThunk

Private Sub Form_Load()
    Dim baSrc()         As Byte
    Dim baDst()         As Byte

    On Error GoTo EH
    ReDim baSrc(0 To 10000) As Byte
    ReDim baDst(0 To 20000) As Byte
    pvCallFunc "Decrunch", VarPtr(baSrc(0)), VarPtr(baDst(0)), UBound(baSrc) + 1
    Exit Sub
EH:
    MsgBox Error$, vbCritical
End Sub

Private Function pvCallFunc(sFunc As String, ParamArray A()) As Long
    Dim pfn             As Long
    Dim lIdx            As Long
    Dim aParams()       As Long

    If m_hModule = 0 Then
        m_hModule = LoadLibrary(STR_MYDLL)
        If m_hModule = 0 Then
            Err.Raise vbObjectError, , STR_MYDLL & " not found"
        End If
        pvInitCallCdeclThunk m_uCallThunk
    End If
    pfn = GetProcAddress(m_hModule, sFunc)
    If pfn = 0 Then
        Err.Raise vbObjectError, , "Export not found: " & sFunc
    End If
    ReDim aParams(0 To UBound(A) + 1) As Long
    For lIdx = 0 To UBound(A)
        aParams(lIdx) = CLng(A(lIdx))
    Next
    pvCallFunc = CallWindowProc(m_uCallThunk.pfn, pfn, UBound(aParams), VarPtr(aParams(0)), 0)
End Function

Private Sub pvInitCallCdeclThunk(Thunk As UcsParamThunk)
'void _stdcall thunk(int pfn, int count, int args, int dummy)
'        push    ebp
'        mov     ebp, esp
'        mov     ecx, count
'        jecxz   _skip_params
'        mov     edx, args
'_params_loop:
'        push    dword ptr [edx + ecx * 4 - 4]
'        loop    _params_loop
'_skip_params:
'        call pfn
'        mov     esp,ebp
'        pop     ebp
'        ret     10h
'        nop
'        nop
    With Thunk
        .Call_(0) = &H8BEC8B55
        .Call_(1) = &H9E30C4D
        .Call_(2) = &HFF10558B
        .Call_(3) = &HE2FC8A74
        .Call_(4) = &H855FFFA
        .Call_(5) = &HC25DE58B
        .Call_(6) = &H90900010
        .pfn = VarPtr(.Call_(0))
        Call VirtualProtect(Thunk, Len(Thunk), PAGE_EXECUTE_READWRITE, 0)
    End With
End Sub