问VB6 -使用指针声明和调用C

EN

Private Declare DecrunchGetLength Alias "Decrunch" Lib "somedll.DLL" (ByRef src As Byte, ByVal nullptr As Long, ByVal SrcLength As Long) As Long 

Private Declare Decrunch Alias "Decrunch" Lib "somedll.DLL" (ByRef src As Byte, ByRef dest As Byte, ByVal SrcLength As Long) As Long 

Dim destLen As Long
 Dim src(0 To 9) As Byte 
Dim dest() As Byte 

' get bytes into src somehow 

' get dest length 
destLen = DecrunchGetLen( src(0), 0, 10) 

ReDim dest(0 To destLen - 1) 
destLen = Decrunch( src(0), dest(0), 10) 

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