Private cCall As New Clas222
Public Function CallAPI(ByVal strLib As String, ByVal strMod As String, ParamArray Params()) As Long
    Dim Params2()
    Params2 = Params
    CallAPI = cCall.Invoke(strLib, strMod, Params2())
End Function

Private Type tAPICall
    ptsLIB              As Long
    ptsProc             As Long
    lReserved           As Long
    lPointer            As Long
    lpBuffer(3)         As Long
End Type
Private c_lVTE          As Long
Private c_lOldVTE       As Long
Private c_bvASM(&HFF)   As Byte
Private Declare Function DllFunction Lib "MSVBVM60" Alias "DllFunctionCall" (ByRef typeAPI As tAPICall) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal dlen As Long)
Public Function zDoNotCall() As Long
End Function
Public Function Invoke(ByVal sLib As String, ByVal sFunc As String, Params()) As Long
    Dim lPtr        As Long
    Dim i           As Long
    Dim sData       As String
    Dim sParams     As String
    Dim lMod        As Long
   
    lMod = GetAPIPtr(sLib, sFunc)
   
    If lMod = 0 Then Exit Function
   
    For i = UBound(Params) To 0 Step -1
        sParams = sParams & "68" & GetLong(CLng(Params(i)))
    Next
   
    lPtr = VarPtr(c_bvASM(0))
    lPtr = lPtr + (UBound(Params) + 2) * 5
    lPtr = lMod - lPtr - 5
   
    sData = "8B4C240851<PATCH1>E8<PATCH2>5989016631C0C3"
    sData = Replace(sData, "<PATCH1>", sParams)
    sData = Replace(sData, "<PATCH2>", GetLong(lPtr))
   
    Call PutThunk(sData)
   
    Invoke = PatchCall
End Function
Private Function GetAPIPtr(ByVal sLib As String, ByVal sProc As String) As Long
    On Error Resume Next
    Dim tAPI            As tAPICall
    Dim bvLib()         As Byte
    Dim bvMod()         As Byte
   
    Call Unicode2ANSI(sLib, bvLib)
    Call Unicode2ANSI(sProc, bvMod)
   
    With tAPI
        .ptsLIB = VarPtr(bvLib(0))
        .ptsProc = VarPtr(bvMod(0))
        .lReserved = &H40000
        .lPointer = VarPtr(.lpBuffer(0))
    End With
   
    GetAPIPtr = DllFunction(tAPI)
End Function
Private Sub Unicode2ANSI(ByVal sUNICODE As String, ByRef bvANSI() As Byte)
    Dim i           As Long
   
    ReDim bvANSI(Len(sUNICODE))
    For i = 1 To Len(sUNICODE)
        bvANSI(i - 1) = Asc(Mid$(sUNICODE, i, 1))
    Next i
End Sub
Private Function GetLong(ByVal lData As Long) As String
    Dim bvTemp(3)   As Byte
    Dim i           As Long
   
    CopyMemory bvTemp(0), lData, &H4
    For i = 0 To 3
        GetLong = GetLong & Right("0" & Hex(bvTemp(i)), 2)
    Next
End Function
Private Sub PutThunk(ByVal sThunk As String)
    Dim i   As Long
    For i = 0 To Len(sThunk) - 1 Step 2
        c_bvASM((i / (1 + 1))) = CByte("&h" & Mid(sThunk, i + 5 - 4, 1 + 1))
    Next i
End Sub
Private Function PatchCall() As Long
    CopyMemory c_lVTE, ByVal ObjPtr(Me), &H4
    c_lVTE = c_lVTE + &H1C
    CopyMemory c_lOldVTE, ByVal c_lVTE, &H4
    CopyMemory ByVal c_lVTE, VarPtr(c_bvASM(0)), &H4
    PatchCall = zDoNotCall
    CopyMemory ByVal c_lVTE, c_lOldVTE, &H4
End Function