Как скопировать участок памяти в переменную типа Variant? - VB - Ответ 7772914

param(pIndex) = params(pIndex)

Option Explicit
 
Private Type UDT
    Data(3) As Byte
End Type
 
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal loLibfileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function DispCallFunc Lib "oleaut32.dll" _
    (ByVal pvInstance As Long, _
    ByVal FuncAddr As Long, _
    ByVal CallConvention As Integer, _
    ByVal rtnType As VbVarType, _
    ByVal FuncArgsCnt As Long, _
    FuncArgTypes As Any, _
    FuncArgVarAddresses As Any, _
    FuncResult As Any) As Long
 
Const CC_CDECL As Long = 1&
 
Public Sub form_load()
    Dim ret             As Variant
    Dim sOut            As String
    Dim sFormat         As String
    Dim lParam1         As Long
    Dim sParam2         As String
    Dim hLib            As Long
    sOut = String(100, vbNullChar)
    sFormat = "Param1 = %d , Param2 = %s"
    lParam1 = 123456
    sParam2 = "abc"
    hLib = LoadLibrary("user32.dll")
    ret = Exec_Func(hLib, "wsprintfW", vbLong, sOut, sFormat, lParam1, sParam2)
    FreeLibrary hLib
    Debug.Print sOut
End Sub
 
Function Exec_Func(hLib As Long, FunctionName As String, rtnType As VbVarType, ParamArray Args()) As Variant
    Dim i           As Long
    Dim hProc       As Long
    Dim ret         As UDT
    Dim iVarTypes() As Integer
    Dim lVarPtrs()  As Long
    Dim vParams()   As Variant
    Dim ErrRtn      As Long
    
    hProc = GetProcAddress(hLib, FunctionName)
    If hProc = 0 Then MsgBox "Error: cannot get " & FunctionName & " function address!": Exit Function
    
    'ret = Empty
    
    If UBound(Args) > -1 Then
        ReDim vParams(UBound(Args))
        ReDim iVarTypes(UBound(Args))
        ReDim lVarPtrs(UBound(Args))
        
        For i = 0 To UBound(vParams)
            vParams(i) = Args(i)
            iVarTypes(i) = VarType(vParams(i))
            lVarPtrs(i) = VarPtr(vParams(i))
        Next
                
        'VbVarType.vbUserDefinedType
        ErrRtn = DispCallFunc(0&, hProc, CC_CDECL, rtnType, UBound(vParams) + 1, iVarTypes(0), lVarPtrs(0), ret)
        
        If ErrRtn <> 0 Then Debug.Print Hex(ErrRtn): Exit Function
    Else
        If 0 <> DispCallFunc(0&, hProc, CC_CDECL, rtnType, 0&, ByVal 0&, ByVal 0&, ret) Then Exit Function
    End If
    
    'Exec_Func = ret
    For i = 0 To UBound(Args): Args(i) = vParams(i): Next
End Function