Adding refactoring of COM objects #6111
Replies: 6 comments 13 replies
-
I believe @Greedquest has already ported at least parts of the COM typelib-parsing stuff inside RD to VBA, so there might already be some code out there that's able to get you all the type and member metadata for a referenced COM library; from this metadata you should be able to generate strings that contain the wrapper code module contents, and with the VBIDE API these strings can turn into class modules, but it's probably simpler to generate them as text files, so you have better control over the hidden attributes. |
Beta Was this translation helpful? Give feedback.
-
As @retailcoder suggests, I have some VBA/tB code that lets you navigate the type library. Although it sounds like what you want to do is one-shot rather than runtime. Why not use a tool like OLEWoo to dump the tlb to a text file and then parse that to VBA code? E.g.
// Generated .IDL file (by OleWoo)
[
uuid(e07c841c-43f0-3b33-b105-9b8188a6f040),
version(2.5),
custom(de77ba64-517c-11d1-a2da-0000f8773ce9, 134283886),
custom(de77ba63-517c-11d1-a2da-0000f8773ce9, 2147483647),
custom(de77ba65-517c-11d1-a2da-0000f8773ce9, "Created by MIDL version 8.01.0622 at Tue Jan 19 03:14:07 2038
"),
custom(90883f05-3d28-11d2-8f17-00a0c9a6186d, "Rubberduck, Version=2.5.2.5816, Culture=neutral, PublicKeyToken=null"),
helpstring("Rubberduck AddIn")
]
library Rubberduck
{
// Forward declare all types defined in this typelib
dispinterface IDockableWindowHost
interface IDockableWindowHost
dispinterface IAssert
interface IAssert
dispinterface IFake
interface IFake
dispinterface IVerify
interface IVerify
dispinterface IFakesProvider
interface IFakesProvider
dispinterface IStub
interface IStub
[
uuid(69e0f698-43f0-3b33-b105-9b8188a6f040),
dual,
restricted,
oleautomation
]
interface IDockableWindowHost : IDispatch {
[id(0x00000001)]
HRESULT AddUserControl(
[in] _UserControl* control,
[in] long vbeHwnd
);
[id(0x00000002)]
HRESULT Release_2();
};
[
uuid(69e0f7db-43f0-3b33-b105-9b8188a6f040),
dual,
oleautomation
]
interface IAssert : IDispatch {
[id(0x00000001), helpstring("Verifies that the specified condition is true. The assertion fails if the condition is false.")]
HRESULT IsTrue(
[in] VARIANT_BOOL Condition,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000002), helpstring("Verifies that the specified condition is false. The assertion fails if the condition is true.")]
HRESULT IsFalse(
[in] VARIANT_BOOL Condition,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000003), helpstring("Indicates that the assertion cannot be verified.")]
HRESULT Inconclusive([in, optional, defaultvalue("")] BSTR Message);
[id(0x00000004), helpstring("Fails the assertion without checking any conditions.")]
HRESULT Fail([in, optional, defaultvalue("")] BSTR Message);
[id(0x00000005), helpstring("Passes the assertion without checking any conditions.")]
HRESULT Succeed();
[id(0x00000006), helpstring("Verifies that the specified object is Nothing. The assertion fails if it is not Nothing.")]
HRESULT IsNothing(
[in] VARIANT Value,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000007), helpstring("Verifies that the specified object is not Nothing. The assertion fails if it is Nothing.")]
HRESULT IsNotNothing(
[in] VARIANT Value,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000008), helpstring("Verifies that two specified objects are equal. The assertion fails if the objects are not equal.")]
HRESULT AreEqual(
[in] VARIANT Expected,
[in] VARIANT Actual,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000009), helpstring("Verifies that two specified objects are not equal. The assertion fails if the objects are equal.")]
HRESULT AreNotEqual(
[in] VARIANT Expected,
[in] VARIANT Actual,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000a), helpstring("Verifies that two specified object variables refer to the same object. The assertion fails if they refer to different objects.")]
HRESULT AreSame(
[in] VARIANT Expected,
[in] VARIANT Actual,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000b), helpstring("Verifies that two specified object variables refer to different objects. The assertion fails if they refer to the same object.")]
HRESULT AreNotSame(
[in] VARIANT Expected,
[in] VARIANT Actual,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000c), helpstring("Verifies that all of the items in 2 arrays are equal. The assertion fails if any items is different, if either the lower bounds or upper bounds are different, or if the ranks (number of dimensions) differ.")]
HRESULT SequenceEquals(
[in] VARIANT Expected,
[in] VARIANT Actual,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000d), helpstring("Verifies that at least one of the items in 2 arrays differs at any give index. The assertion fails if all of the items are the same, if the lower bounds and upper bounds are the same, and the ranks (number of dimensions) are the same.")]
HRESULT NotSequenceEquals(
[in] VARIANT Expected,
[in] VARIANT Actual,
[in, optional, defaultvalue("")] BSTR Message
);
};
[
uuid(69e0f7df-43f0-3b33-b105-9b8188a6f040),
dual,
oleautomation
]
interface IFake : IDispatch {
[id(0x00000001), propget]
HRESULT Verify([out, retval] IVerify** pRetVal);
[id(0x00000002), helpstring("Configures the fake such as an invocation assigns the specified value to the specified ByRef argument.")]
HRESULT AssignsByRef(
[in] BSTR Parameter,
[in] VARIANT Value
);
[id(0x00000003), helpstring("Configures the fake such as an invocation raises the specified run-time eror.")]
HRESULT RaisesError(
[in, optional, defaultvalue(0)] long Number,
[in, optional, defaultvalue("")] BSTR Description
);
[id(0x00000004), propget]
HRESULT PassThrough([out, retval] VARIANT_BOOL* pRetVal);
[id(0x00000004), propput]
HRESULT PassThrough([in] VARIANT_BOOL pRetVal);
[id(0x00000005), helpstring("Configures the fake such as the specified invocation returns the specified value.")]
HRESULT Returns(
[in] VARIANT Value,
[in, optional, defaultvalue(-1)] long Invocation
);
[id(0x00000006), helpstring("Configures the fake such as the specified invocation returns the specified value given a specific parameter value.")]
HRESULT ReturnsWhen(
[in] BSTR Parameter,
[in] VARIANT Argument,
[in] VARIANT Value,
[in, optional, defaultvalue(-1)] long Invocation
);
};
[
uuid(69e0f7e0-43f0-3b33-b105-9b8188a6f040),
dual,
oleautomation
]
interface IVerify : IDispatch {
[id(0x00000001), helpstring("Verifies that the faked procedure was called a minimum number of times.")]
HRESULT AtLeast(
[in] long Invocations,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000002), helpstring("Verifies that the faked procedure was called one or more times.")]
HRESULT AtLeastOnce([in, optional, defaultvalue("")] BSTR Message);
[id(0x00000003), helpstring("Verifies that the faked procedure was called a maximum number of times.")]
HRESULT AtMost(
[in] long Invocations,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000004), helpstring("Verifies that the faked procedure was not called or was only called once.")]
HRESULT AtMostOnce([in, optional, defaultvalue("")] BSTR Message);
[id(0x00000005), helpstring("Verifies that number of times the faked procedure was called falls within the supplied range.")]
HRESULT Between(
[in] long Minimum,
[in] long Maximum,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000006), helpstring("Verifies that the faked procedure was called a specific number of times.")]
HRESULT Exactly(
[in] long Invocations,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x00000007), helpstring("Verifies that the faked procedure is never called.")]
HRESULT Never([in, optional, defaultvalue("")] BSTR Message);
[id(0x00000008), helpstring("Verifies that the faked procedure is called exactly one time.")]
HRESULT Once([in, optional, defaultvalue("")] BSTR Message);
[id(0x00000009), helpstring("Verifies that a given parameter to the faked procedure matches a specific value.")]
HRESULT Parameter(
[in] BSTR Parameter,
[in] VARIANT Value,
[in, optional, defaultvalue(1)] long Invocation,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000a), helpstring("Verifies that the value of a given parameter to the faked procedure falls within a specified range.")]
HRESULT ParameterInRange(
[in] BSTR Parameter,
[in] double Minimum,
[in] double Maximum,
[in, optional, defaultvalue(1)] long Invocation,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000b), helpstring("Verifies that an optional parameter was passed to the faked procedure. The value is not evaluated.")]
HRESULT ParameterIsPassed(
[in] BSTR Parameter,
[in, optional, defaultvalue(1)] long Invocation,
[in, optional, defaultvalue("")] BSTR Message
);
[id(0x0000000c), helpstring("Verifies that the passed value of a given parameter is of a given type.")]
HRESULT ParameterIsType(
[in] BSTR Parameter,
[in] BSTR TypeName,
[in, optional, defaultvalue(1)] long Invocation,
[in, optional, defaultvalue("")] BSTR Message
);
};
[
uuid(69e0f7de-43f0-3b33-b105-9b8188a6f040),
dual,
oleautomation
]
interface IFakesProvider : IDispatch {
[id(0x00000001), propget]
HRESULT MsgBox([out, retval] IFake** pRetVal);
[id(0x00000002), propget]
HRESULT InputBox([out, retval] IFake** pRetVal);
[id(0x00000003), propget]
HRESULT Beep([out, retval] IStub** pRetVal);
[id(0x00000004), propget]
HRESULT Environ([out, retval] IFake** pRetVal);
[id(0x00000005), propget]
HRESULT Timer([out, retval] IFake** pRetVal);
[id(0x00000006), propget]
HRESULT DoEvents([out, retval] IFake** pRetVal);
[id(0x00000007), propget]
HRESULT Shell([out, retval] IFake** pRetVal);
[id(0x00000008), propget]
HRESULT SendKeys([out, retval] IStub** pRetVal);
[id(0x00000009), propget]
HRESULT Kill([out, retval] IStub** pRetVal);
[id(0x0000000a), propget]
HRESULT MkDir([out, retval] IStub** pRetVal);
[id(0x0000000b), propget]
HRESULT RmDir([out, retval] IStub** pRetVal);
[id(0x0000000c), propget]
HRESULT ChDir([out, retval] IStub** pRetVal);
[id(0x0000000d), propget]
HRESULT ChDrive([out, retval] IStub** pRetVal);
[id(0x0000000e), propget]
HRESULT CurDir([out, retval] IFake** pRetVal);
[id(0x0000000f), propget]
HRESULT Now([out, retval] IFake** pRetVal);
[id(0x00000010), propget]
HRESULT Time([out, retval] IFake** pRetVal);
[id(0x00000011), propget]
HRESULT Date([out, retval] IFake** pRetVal);
};
[
uuid(69e0f7e1-43f0-3b33-b105-9b8188a6f040),
dual,
oleautomation
]
interface IStub : IDispatch {
[id(0x00000001), propget]
HRESULT Verify([out, retval] IVerify** pRetVal);
[id(0x00000002), helpstring("Configures the stub such as an invocation assigns the specified value to the specified ByRef argument.")]
HRESULT AssignsByRef(
[in] BSTR Parameter,
[in] VARIANT Value
);
[id(0x00000003), helpstring("Configures the stub such as an invocation raises the specified run-time eror.")]
HRESULT RaisesError(
[in, optional, defaultvalue(0)] long Number,
[in, optional, defaultvalue("")] BSTR Description
);
[id(0x00000004), propget]
HRESULT PassThrough([out, retval] VARIANT_BOOL* pRetVal);
[id(0x00000004), propput]
HRESULT PassThrough([in] VARIANT_BOOL pRetVal);
};
[
uuid(69e0f697-43f0-3b33-b105-9b8188a6f040)
]
coclass _Extension {
interface _Object;
interface _IDTExtensibility2;
};
[
uuid(69e0f699-43f0-3b33-b105-9b8188a6f040)
]
coclass _DockableWindowHost {
interface _Object;
interface IDockableWindowHost;
};
[
uuid(69e0f7da-43f0-3b33-b105-9b8188a6f040)
]
coclass AssertClass {
interface _Object;
[default] interface IAssert;
};
[
uuid(69e0f7dd-43f0-3b33-b105-9b8188a6f040)
]
coclass FakesProvider {
interface _Object;
[default] interface IFakesProvider;
};
[
uuid(69e0f7dc-43f0-3b33-b105-9b8188a6f040)
]
coclass PermissiveAssertClass {
interface _Object;
[default] interface IAssert;
};
}; Or open it in the latest twinBasic IDE and you can see pseudocode: [ LibraryId ("E07C841C-43F0-3B33-B105-9B8188A6F040") ]
[ Version (2.5) ]
[ Description ("Rubberduck AddIn") ]
Library Rubberduck
' Original type library: C:\ProgramData\Rubberduck\Rubberduck.x32.tlb
' NOTE: Offsets and lengths calculated for current Win32 target.
[ InterfaceId ("69E0F698-43F0-3B33-B105-9B8188A6F040") ]
[ Restricted, DualInterface, DispInterface, COMExtensible ]
Interface IDockableWindowHost Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Sub AddUserControl(ByVal control As System_Windows_Forms._UserControl, ByVal vbeHwnd As Long)
[ DispId(2) ]
/* voffset &H0020*/ Sub Release_2()
End Interface
[ InterfaceId ("69E0F7DB-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, DispInterface, COMExtensible ]
Interface IAssert Extends stdole.IDispatch
[ DispId(1) ]
[ Description ("Verifies that the specified condition is true. The assertion fails if the condition is false.") ]
/* voffset &H001C*/ Sub IsTrue(ByVal Condition As Boolean, Optional ByVal Message As String = "")
[ DispId(2) ]
[ Description ("Verifies that the specified condition is false. The assertion fails if the condition is true.") ]
/* voffset &H0020*/ Sub IsFalse(ByVal Condition As Boolean, Optional ByVal Message As String = "")
[ DispId(3) ]
[ Description ("Indicates that the assertion cannot be verified.") ]
/* voffset &H0024*/ Sub Inconclusive(Optional ByVal Message As String = "")
[ DispId(4) ]
[ Description ("Fails the assertion without checking any conditions.") ]
/* voffset &H0028*/ Sub Fail(Optional ByVal Message As String = "")
[ DispId(5) ]
[ Description ("Passes the assertion without checking any conditions.") ]
/* voffset &H002C*/ Sub Succeed()
[ DispId(6) ]
[ Description ("Verifies that the specified object is Nothing. The assertion fails if it is not Nothing.") ]
/* voffset &H0030*/ Sub IsNothing(ByVal Value As Variant, Optional ByVal Message As String = "")
[ DispId(7) ]
[ Description ("Verifies that the specified object is not Nothing. The assertion fails if it is Nothing.") ]
/* voffset &H0034*/ Sub IsNotNothing(ByVal Value As Variant, Optional ByVal Message As String = "")
[ DispId(8) ]
[ Description ("Verifies that two specified objects are equal. The assertion fails if the objects are not equal.") ]
/* voffset &H0038*/ Sub AreEqual(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(9) ]
[ Description ("Verifies that two specified objects are not equal. The assertion fails if the objects are equal.") ]
/* voffset &H003C*/ Sub AreNotEqual(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(10) ]
[ Description ("Verifies that two specified object variables refer to the same object. The assertion fails if they refer to different objects.") ]
/* voffset &H0040*/ Sub AreSame(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(11) ]
[ Description ("Verifies that two specified object variables refer to different objects. The assertion fails if they refer to the same object.") ]
/* voffset &H0044*/ Sub AreNotSame(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(12) ]
[ Description ("Verifies that all of the items in 2 arrays are equal. The assertion fails if any items is different, if either the lower bounds or upper bounds are different, or if the ranks (number of dimensions) differ.") ]
/* voffset &H0048*/ Sub SequenceEquals(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(13) ]
[ Description ("Verifies that at least one of the items in 2 arrays differs at any give index. The assertion fails if all of the items are the same, if the lower bounds and upper bounds are the same, and the ranks (number of dimensions) are the same.") ]
/* voffset &H004C*/ Sub NotSequenceEquals(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
End Interface
[ InterfaceId ("69E0F7DF-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, DispInterface, COMExtensible ]
Interface IFake Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Property Get Verify() As Rubberduck.IVerify
[ DispId(2) ]
[ Description ("Configures the fake such as an invocation assigns the specified value to the specified ByRef argument.") ]
/* voffset &H0020*/ Sub AssignsByRef(ByVal Parameter As String, ByVal Value As Variant)
[ DispId(3) ]
[ Description ("Configures the fake such as an invocation raises the specified run-time eror.") ]
/* voffset &H0024*/ Sub RaisesError(Optional ByVal Number As Long = 0, Optional ByVal Description As String = "")
[ DispId(4) ]
/* voffset &H0028*/ Property Get PassThrough() As Boolean
[ DispId(4) ]
/* voffset &H002C*/ Property Let PassThrough(ByVal As Boolean)
[ DispId(5) ]
[ Description ("Configures the fake such as the specified invocation returns the specified value.") ]
/* voffset &H0030*/ Sub Returns(ByVal Value As Variant, Optional ByVal Invocation As Long = -1)
[ DispId(6) ]
[ Description ("Configures the fake such as the specified invocation returns the specified value given a specific parameter value.") ]
/* voffset &H0034*/ Sub ReturnsWhen(ByVal Parameter As String, ByVal Argument As Variant, ByVal Value As Variant, Optional ByVal Invocation As Long = -1)
End Interface
[ InterfaceId ("69E0F7E0-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, DispInterface, COMExtensible ]
Interface IVerify Extends stdole.IDispatch
[ DispId(1) ]
[ Description ("Verifies that the faked procedure was called a minimum number of times.") ]
/* voffset &H001C*/ Sub AtLeast(ByVal Invocations As Long, Optional ByVal Message As String = "")
[ DispId(2) ]
[ Description ("Verifies that the faked procedure was called one or more times.") ]
/* voffset &H0020*/ Sub AtLeastOnce(Optional ByVal Message As String = "")
[ DispId(3) ]
[ Description ("Verifies that the faked procedure was called a maximum number of times.") ]
/* voffset &H0024*/ Sub AtMost(ByVal Invocations As Long, Optional ByVal Message As String = "")
[ DispId(4) ]
[ Description ("Verifies that the faked procedure was not called or was only called once.") ]
/* voffset &H0028*/ Sub AtMostOnce(Optional ByVal Message As String = "")
[ DispId(5) ]
[ Description ("Verifies that number of times the faked procedure was called falls within the supplied range.") ]
/* voffset &H002C*/ Sub Between(ByVal Minimum As Long, ByVal Maximum As Long, Optional ByVal Message As String = "")
[ DispId(6) ]
[ Description ("Verifies that the faked procedure was called a specific number of times.") ]
/* voffset &H0030*/ Sub Exactly(ByVal Invocations As Long, Optional ByVal Message As String = "")
[ DispId(7) ]
[ Description ("Verifies that the faked procedure is never called.") ]
/* voffset &H0034*/ Sub Never(Optional ByVal Message As String = "")
[ DispId(8) ]
[ Description ("Verifies that the faked procedure is called exactly one time.") ]
/* voffset &H0038*/ Sub Once(Optional ByVal Message As String = "")
[ DispId(9) ]
[ Description ("Verifies that a given parameter to the faked procedure matches a specific value.") ]
/* voffset &H003C*/ Sub Parameter(ByVal Parameter As String, ByVal Value As Variant, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
[ DispId(10) ]
[ Description ("Verifies that the value of a given parameter to the faked procedure falls within a specified range.") ]
/* voffset &H0040*/ Sub ParameterInRange(ByVal Parameter As String, ByVal Minimum As Double, ByVal Maximum As Double, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
[ DispId(11) ]
[ Description ("Verifies that an optional parameter was passed to the faked procedure. The value is not evaluated.") ]
/* voffset &H0044*/ Sub ParameterIsPassed(ByVal Parameter As String, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
[ DispId(12) ]
[ Description ("Verifies that the passed value of a given parameter is of a given type.") ]
/* voffset &H0048*/ Sub ParameterIsType(ByVal Parameter As String, ByVal TypeName As String, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
End Interface
[ InterfaceId ("69E0F7DE-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, DispInterface, COMExtensible ]
Interface IFakesProvider Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Property Get MsgBox() As Rubberduck.IFake
[ DispId(2) ]
/* voffset &H0020*/ Property Get InputBox() As Rubberduck.IFake
[ DispId(3) ]
/* voffset &H0024*/ Property Get Beep() As Rubberduck.IStub
[ DispId(4) ]
/* voffset &H0028*/ Property Get Environ() As Rubberduck.IFake
[ DispId(5) ]
/* voffset &H002C*/ Property Get Timer() As Rubberduck.IFake
[ DispId(6) ]
/* voffset &H0030*/ Property Get DoEvents() As Rubberduck.IFake
[ DispId(7) ]
/* voffset &H0034*/ Property Get Shell() As Rubberduck.IFake
[ DispId(8) ]
/* voffset &H0038*/ Property Get SendKeys() As Rubberduck.IStub
[ DispId(9) ]
/* voffset &H003C*/ Property Get Kill() As Rubberduck.IStub
[ DispId(10) ]
/* voffset &H0040*/ Property Get MkDir() As Rubberduck.IStub
[ DispId(11) ]
/* voffset &H0044*/ Property Get RmDir() As Rubberduck.IStub
[ DispId(12) ]
/* voffset &H0048*/ Property Get ChDir() As Rubberduck.IStub
[ DispId(13) ]
/* voffset &H004C*/ Property Get ChDrive() As Rubberduck.IStub
[ DispId(14) ]
/* voffset &H0050*/ Property Get CurDir() As Rubberduck.IFake
[ DispId(15) ]
/* voffset &H0054*/ Property Get Now() As Rubberduck.IFake
[ DispId(16) ]
/* voffset &H0058*/ Property Get Time() As Rubberduck.IFake
[ DispId(17) ]
/* voffset &H005C*/ Property Get Date() As Rubberduck.IFake
End Interface
[ InterfaceId ("69E0F7E1-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, DispInterface, COMExtensible ]
Interface IStub Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Property Get Verify() As Rubberduck.IVerify
[ DispId(2) ]
[ Description ("Configures the stub such as an invocation assigns the specified value to the specified ByRef argument.") ]
/* voffset &H0020*/ Sub AssignsByRef(ByVal Parameter As String, ByVal Value As Variant)
[ DispId(3) ]
[ Description ("Configures the stub such as an invocation raises the specified run-time eror.") ]
/* voffset &H0024*/ Sub RaisesError(Optional ByVal Number As Long = 0, Optional ByVal Description As String = "")
[ DispId(4) ]
/* voffset &H0028*/ Property Get PassThrough() As Boolean
[ DispId(4) ]
/* voffset &H002C*/ Property Let PassThrough(ByVal As Boolean)
End Interface
[ CoClassId ("69E0F697-43F0-3B33-B105-9B8188A6F040") ]
[ Hidden, Restricted, COMCreatable]
CoClass _Extension
Interface mscorlib._Object
Interface AddInDesignerObjects._IDTExtensibility2
End CoClass
[ CoClassId ("69E0F699-43F0-3B33-B105-9B8188A6F040") ]
[ Hidden, Restricted, COMCreatable]
CoClass _DockableWindowHost
Interface mscorlib._Object
Interface Rubberduck.IDockableWindowHost
End CoClass
[ CoClassId ("69E0F7DA-43F0-3B33-B105-9B8188A6F040") ]
[ COMCreatable]
CoClass AssertClass
Interface mscorlib._Object
[ Default ] Interface Rubberduck.IAssert
End CoClass
[ CoClassId ("69E0F7DD-43F0-3B33-B105-9B8188A6F040") ]
[ COMCreatable]
CoClass FakesProvider
Interface mscorlib._Object
[ Default ] Interface Rubberduck.IFakesProvider
End CoClass
[ CoClassId ("69E0F7DC-43F0-3B33-B105-9B8188A6F040") ]
[ COMCreatable]
CoClass PermissiveAssertClass
Interface mscorlib._Object
[ Default ] Interface Rubberduck.IAssert
End CoClass
[ InterfaceId ("69E0F698-43F0-3B33-B105-9B8188A6F040") ]
[ Restricted, DualInterface, COMExtensible ]
Interface IDockableWindowHost Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Sub AddUserControl(ByVal control As System_Windows_Forms._UserControl, ByVal vbeHwnd As Long)
[ DispId(2) ]
/* voffset &H0020*/ Sub Release_2()
End Interface
[ InterfaceId ("69E0F7DB-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, COMExtensible ]
Interface IAssert Extends stdole.IDispatch
[ DispId(1) ]
[ Description ("Verifies that the specified condition is true. The assertion fails if the condition is false.") ]
/* voffset &H001C*/ Sub IsTrue(ByVal Condition As Boolean, Optional ByVal Message As String = "")
[ DispId(2) ]
[ Description ("Verifies that the specified condition is false. The assertion fails if the condition is true.") ]
/* voffset &H0020*/ Sub IsFalse(ByVal Condition As Boolean, Optional ByVal Message As String = "")
[ DispId(3) ]
[ Description ("Indicates that the assertion cannot be verified.") ]
/* voffset &H0024*/ Sub Inconclusive(Optional ByVal Message As String = "")
[ DispId(4) ]
[ Description ("Fails the assertion without checking any conditions.") ]
/* voffset &H0028*/ Sub Fail(Optional ByVal Message As String = "")
[ DispId(5) ]
[ Description ("Passes the assertion without checking any conditions.") ]
/* voffset &H002C*/ Sub Succeed()
[ DispId(6) ]
[ Description ("Verifies that the specified object is Nothing. The assertion fails if it is not Nothing.") ]
/* voffset &H0030*/ Sub IsNothing(ByVal Value As Variant, Optional ByVal Message As String = "")
[ DispId(7) ]
[ Description ("Verifies that the specified object is not Nothing. The assertion fails if it is Nothing.") ]
/* voffset &H0034*/ Sub IsNotNothing(ByVal Value As Variant, Optional ByVal Message As String = "")
[ DispId(8) ]
[ Description ("Verifies that two specified objects are equal. The assertion fails if the objects are not equal.") ]
/* voffset &H0038*/ Sub AreEqual(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(9) ]
[ Description ("Verifies that two specified objects are not equal. The assertion fails if the objects are equal.") ]
/* voffset &H003C*/ Sub AreNotEqual(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(10) ]
[ Description ("Verifies that two specified object variables refer to the same object. The assertion fails if they refer to different objects.") ]
/* voffset &H0040*/ Sub AreSame(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(11) ]
[ Description ("Verifies that two specified object variables refer to different objects. The assertion fails if they refer to the same object.") ]
/* voffset &H0044*/ Sub AreNotSame(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(12) ]
[ Description ("Verifies that all of the items in 2 arrays are equal. The assertion fails if any items is different, if either the lower bounds or upper bounds are different, or if the ranks (number of dimensions) differ.") ]
/* voffset &H0048*/ Sub SequenceEquals(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
[ DispId(13) ]
[ Description ("Verifies that at least one of the items in 2 arrays differs at any give index. The assertion fails if all of the items are the same, if the lower bounds and upper bounds are the same, and the ranks (number of dimensions) are the same.") ]
/* voffset &H004C*/ Sub NotSequenceEquals(ByVal Expected As Variant, ByVal Actual As Variant, Optional ByVal Message As String = "")
End Interface
[ InterfaceId ("69E0F7DF-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, COMExtensible ]
Interface IFake Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Property Get Verify() As Rubberduck.IVerify
[ DispId(2) ]
[ Description ("Configures the fake such as an invocation assigns the specified value to the specified ByRef argument.") ]
/* voffset &H0020*/ Sub AssignsByRef(ByVal Parameter As String, ByVal Value As Variant)
[ DispId(3) ]
[ Description ("Configures the fake such as an invocation raises the specified run-time eror.") ]
/* voffset &H0024*/ Sub RaisesError(Optional ByVal Number As Long = 0, Optional ByVal Description As String = "")
[ DispId(4) ]
/* voffset &H0028*/ Property Get PassThrough() As Boolean
[ DispId(4) ]
/* voffset &H002C*/ Property Let PassThrough(ByVal pRetVal As Boolean)
[ DispId(5) ]
[ Description ("Configures the fake such as the specified invocation returns the specified value.") ]
/* voffset &H0030*/ Sub Returns(ByVal Value As Variant, Optional ByVal Invocation As Long = -1)
[ DispId(6) ]
[ Description ("Configures the fake such as the specified invocation returns the specified value given a specific parameter value.") ]
/* voffset &H0034*/ Sub ReturnsWhen(ByVal Parameter As String, ByVal Argument As Variant, ByVal Value As Variant, Optional ByVal Invocation As Long = -1)
End Interface
[ InterfaceId ("69E0F7E0-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, COMExtensible ]
Interface IVerify Extends stdole.IDispatch
[ DispId(1) ]
[ Description ("Verifies that the faked procedure was called a minimum number of times.") ]
/* voffset &H001C*/ Sub AtLeast(ByVal Invocations As Long, Optional ByVal Message As String = "")
[ DispId(2) ]
[ Description ("Verifies that the faked procedure was called one or more times.") ]
/* voffset &H0020*/ Sub AtLeastOnce(Optional ByVal Message As String = "")
[ DispId(3) ]
[ Description ("Verifies that the faked procedure was called a maximum number of times.") ]
/* voffset &H0024*/ Sub AtMost(ByVal Invocations As Long, Optional ByVal Message As String = "")
[ DispId(4) ]
[ Description ("Verifies that the faked procedure was not called or was only called once.") ]
/* voffset &H0028*/ Sub AtMostOnce(Optional ByVal Message As String = "")
[ DispId(5) ]
[ Description ("Verifies that number of times the faked procedure was called falls within the supplied range.") ]
/* voffset &H002C*/ Sub Between(ByVal Minimum As Long, ByVal Maximum As Long, Optional ByVal Message As String = "")
[ DispId(6) ]
[ Description ("Verifies that the faked procedure was called a specific number of times.") ]
/* voffset &H0030*/ Sub Exactly(ByVal Invocations As Long, Optional ByVal Message As String = "")
[ DispId(7) ]
[ Description ("Verifies that the faked procedure is never called.") ]
/* voffset &H0034*/ Sub Never(Optional ByVal Message As String = "")
[ DispId(8) ]
[ Description ("Verifies that the faked procedure is called exactly one time.") ]
/* voffset &H0038*/ Sub Once(Optional ByVal Message As String = "")
[ DispId(9) ]
[ Description ("Verifies that a given parameter to the faked procedure matches a specific value.") ]
/* voffset &H003C*/ Sub Parameter(ByVal Parameter As String, ByVal Value As Variant, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
[ DispId(10) ]
[ Description ("Verifies that the value of a given parameter to the faked procedure falls within a specified range.") ]
/* voffset &H0040*/ Sub ParameterInRange(ByVal Parameter As String, ByVal Minimum As Double, ByVal Maximum As Double, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
[ DispId(11) ]
[ Description ("Verifies that an optional parameter was passed to the faked procedure. The value is not evaluated.") ]
/* voffset &H0044*/ Sub ParameterIsPassed(ByVal Parameter As String, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
[ DispId(12) ]
[ Description ("Verifies that the passed value of a given parameter is of a given type.") ]
/* voffset &H0048*/ Sub ParameterIsType(ByVal Parameter As String, ByVal TypeName As String, Optional ByVal Invocation As Long = 1, Optional ByVal Message As String = "")
End Interface
[ InterfaceId ("69E0F7DE-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, COMExtensible ]
Interface IFakesProvider Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Property Get MsgBox() As Rubberduck.IFake
[ DispId(2) ]
/* voffset &H0020*/ Property Get InputBox() As Rubberduck.IFake
[ DispId(3) ]
/* voffset &H0024*/ Property Get Beep() As Rubberduck.IStub
[ DispId(4) ]
/* voffset &H0028*/ Property Get Environ() As Rubberduck.IFake
[ DispId(5) ]
/* voffset &H002C*/ Property Get Timer() As Rubberduck.IFake
[ DispId(6) ]
/* voffset &H0030*/ Property Get DoEvents() As Rubberduck.IFake
[ DispId(7) ]
/* voffset &H0034*/ Property Get Shell() As Rubberduck.IFake
[ DispId(8) ]
/* voffset &H0038*/ Property Get SendKeys() As Rubberduck.IStub
[ DispId(9) ]
/* voffset &H003C*/ Property Get Kill() As Rubberduck.IStub
[ DispId(10) ]
/* voffset &H0040*/ Property Get MkDir() As Rubberduck.IStub
[ DispId(11) ]
/* voffset &H0044*/ Property Get RmDir() As Rubberduck.IStub
[ DispId(12) ]
/* voffset &H0048*/ Property Get ChDir() As Rubberduck.IStub
[ DispId(13) ]
/* voffset &H004C*/ Property Get ChDrive() As Rubberduck.IStub
[ DispId(14) ]
/* voffset &H0050*/ Property Get CurDir() As Rubberduck.IFake
[ DispId(15) ]
/* voffset &H0054*/ Property Get Now() As Rubberduck.IFake
[ DispId(16) ]
/* voffset &H0058*/ Property Get Time() As Rubberduck.IFake
[ DispId(17) ]
/* voffset &H005C*/ Property Get Date() As Rubberduck.IFake
End Interface
[ InterfaceId ("69E0F7E1-43F0-3B33-B105-9B8188A6F040") ]
[ DualInterface, COMExtensible ]
Interface IStub Extends stdole.IDispatch
[ DispId(1) ]
/* voffset &H001C*/ Property Get Verify() As Rubberduck.IVerify
[ DispId(2) ]
[ Description ("Configures the stub such as an invocation assigns the specified value to the specified ByRef argument.") ]
/* voffset &H0020*/ Sub AssignsByRef(ByVal Parameter As String, ByVal Value As Variant)
[ DispId(3) ]
[ Description ("Configures the stub such as an invocation raises the specified run-time eror.") ]
/* voffset &H0024*/ Sub RaisesError(Optional ByVal Number As Long = 0, Optional ByVal Description As String = "")
[ DispId(4) ]
/* voffset &H0028*/ Property Get PassThrough() As Boolean
[ DispId(4) ]
/* voffset &H002C*/ Property Let PassThrough(ByVal pRetVal As Boolean)
End Interface
End Library |
Beta Was this translation helpful? Give feedback.
-
Thanks @Greedquest and @retailcoder . Checking out OLEWoo nice, even source code😍 At least it should help investigating class and method attribute descriptions and clarify my understanding of COM objects. Parsing the .IDL could be solution. Wouldn't it easier obtaining the Type Info collections for class, properties, methods, method parameters and returns types from type info, collections of type info, member info etc save all the headaches parsing it. I can see in RD classless handing COM type info collections for Classs, Method, Parameter info etc. I would imagine would be similar classes in OLEWoo. (OWTypeLib.cs ,OWCoClass,OWMethod, OWIDispatchProperties,OWRecordMember etc) In VBA Argh slight headache why TLI reference was not working. I think you mentioned it on Code Review. Found the solution on stackoverflow ... a few hours later fixed the issue. tlbinf32.dll in a 64bits .Net application Maybe with the help of OLEWoo might identify why not seeing the descriptions from VBA: TypeLib Information Probably need to play around renenyffenegger code a bit more, output the results to file or form for starters etc. So general outline:
Implementation C# use RD components that would facility easy incorporation into RD. Alternatively in C# modify OLEWoo code.
Implementation My C# is average. The wrapping of the .Net class was my first working examples. Thou have done vast examination of the C# source code of the .Net framework while attempting to translate into VBA. One eternity later and 10,000++ lines of VBA probably will shelve that idea as already completed more in two weeks in C#. Attempting this at least promote learning C# and probably will need someone with more experience to "polish". Plus ek I'm not looking forward to manually creating the VBA COM wrappers. |
Beta Was this translation helpful? Give feedback.
-
I've created a new project Refactor-COM-object-to-VBA-COM-wrapper-class](https://github.com/MarkJohnstoneGitHub/Refactor-COM-object-to-VBA-COM-wrapper-class) In MS-Access using the TLI reference. Argh. Using TLI for the sub propertiesOfObj I can't see any descriptions for the class, methods, properties examing tlInfo, tlInfo.Members, etc. Wondering if to do with tlApp.InterfaceInfoFromObject(obj) and what details returned. Maybe a more appropriate |
Beta Was this translation helpful? Give feedback.
-
@Greedquest @retailcoder ComProject.cs appears what was looking for. 😁 I've successfully obtained a ComCoClass default interface ComInterface.cs object for a requested ComCoClass by name. ComProjectLibrary.cs see FindComCoClassInterface function. ComProjectLibrary.cs is a slightly modified version of RD's ComProject.cs. Now can proceed to the next stage refactoring the ComInterface object to implement a VBA class. A brief examination of ImplementInterface appears promising. ImplementInterfaceRefactoring.cs ClassModuleDeclaration has a constructor using ComInterface so hopefully easily to implement a class without the Com object references for each property and method. Require to examine QualifiedSelection |
Beta Was this translation helpful? Give feedback.
-
@retailcoder Tracked it down to the following: Is that correct? In Visual studio while testing Tokens.LongLong isn't being returned. As atm mainly concerend with 64 bitness removed the condition. Hmm not sure why failing thinking about it. Appears correct. Looks can easily obtain the method signitures for a Com object from the DeclarationName properties required. Didn't think was going to so easy. 😁 Was getting lost exploring how RD refactors implementing an interface. Argh crap found out my issue I'd unintentional set up build to 32-bit instead of targeting x64. |
Beta Was this translation helpful? Give feedback.
-
Would RD like to save ducklings going quackers, wrapping COM objects with numerous properties and methods for Christmas? 🦆
How feasible is it for RD or using the RD class repository to implement refactoring of type libraries to produce a class wrapper for a COM object?
Aim: From a type library, obtain class, properties, method s, method parameters and return information. Also including description attribute for class, properties and methods.
From the class information obtained, refactor to a optionally predeclared ,VBA class wrapping the COM object. Optionally could wrap using either late or early binding or both
So, for example a predeclared class:
Would have a private variable of the COM object
Each property and method would reference the COM object wrapped.
Description attribute added either using RD annotations and/or using the method description attribute.
Sounds very similar to what to current RD refactoring for an interface to a class.
Is the “guts” available to obtain the all of the type library details, including description attributes? I suspect a yes, thou not sure about description attributes.
Once have obtain the class information generating the code is similar with the addition of the COM object reference. I am not sure RD adds the descriptions attribute from the interface.
If one were to attempt to implement refactoring of COM objects what RD classes would be of interest to help from writing from scratch? I see things like COM type info wrappers and obtaining the list of COM references etc.
My specific aim is generate COM wrappers for classes at DotNetLib . I've implemented a few .Net class for DateTime, DateTimeOffset TimeSpan, TimeZoneInfo , thou only limited adhoc testing in VBA. Any methods using the IFormatProvider or returning a list for TimeZoneInfo.GetSystemTimeZones require implementation.
Beta Was this translation helpful? Give feedback.
All reactions