This is the Class1, which have sub alfa and a parameter an array of type long.
It is impossible to have an array of type long in variant and pass it by reference. Except we can use invoke from iDispatch interface.Code:Sub alfa(b() As Long) Debug.Print "ok" b(0) = 100 End Sub
just add a reference to OLEEXP
Code:Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Sub main() Dim k(20) As Long Dim z, c As New Class1, arg() As Variant, Clid As Long, dispid As Long Dim Disp As oleexp.IDispatch, ret As Long, riid As oleexp.UUID, lngArgErr As Long Dim varDISPID() As Long, VarRet As Long, params As oleexp.DISPPARAMS, Excep As oleexp.EXCEPINFO ReDim varDISPID(0 To 0) Set Disp = c ret = Disp.GetIDsOfNames(riid, "alfa", 1&, Clid, varDISPID(0)) If ret <> 0 Then Exit Sub dispid = varDISPID(0) z = k() ' we can't do this: c.alfa z ReDim arg(0) VarByRef VarPtr(arg(0)), z With params .cArgs = 1 .rgPointerToVariantArray = VarPtr(arg(0)) End With ret = Disp.Invoke(dispid, riid, 0, 1, params, VarRet, Excep, lngArgErr) VarByRefCleanRef VarPtr(arg(0)) Debug.Print z(0) = 100 End Sub Sub VarByRef(ByVal a As Long, ByRef b As Variant) Dim t(0 To 3) As Long CopyMemory t(0), ByVal VarPtr(b), 16 t(0) = t(0) Or &H4000 t(2) = VarPtr(b) + 8 CopyMemory ByVal a, t(0), 16 End Sub Sub VarByRefCleanRef(ByRef a As Long) Dim t(0 To 3) As Long CopyMemory t(0), ByVal VarPtr(a), 2 t(0) = t(0) And &HFFFFBFFF CopyMemory ByVal a, t(0), 2 End Sub
I have to say that OLEEXP has two faults on IDISPATCH:
One is from GetIDsOfNames, the rgsznames have to be Long. Using it as String is easy for one String, but we can't pass more strings and take with one call all the DISPID (and that happen if we use named parameters, so the first string is the name of function and the following strings are the name of parameters).
The second one is the return value from invoke, the VarRet. The right one has VARIANT type. The OLEEXP has this value as long type. I have check it and using as variant we can get UDT (from ActiveX dll).




Reply With Quote