First and foremost, a huge thanks goes out to The Trick for showing me how to do most of this. Thanks also goes out to Fafalone for making the oleexp.tlb which exposes the necessary interfaces to VB6 which makes this possible. And I must thank Schmidt as well for some inspiration and the beginnings of some code snippets for copying UDTs in Variants to regular UDTs (and vice-versa).
Ok, what is this thing? The primary impetus behind it was to make an easy, fully functioning way to get UDTs into Variants, and to be able to use those UDTs when they're sitting in Variants. As it turns out, this whole thing has two pretty cool purposes:
It does precisely what I set out to do, dynamically (during runtime) create a TypeLib that contains whatever UDTs we want in it. This allows us to create (or assign) Variants with those UDTs, and easily pass them to wherever we want (even Public procedures in objects).
It took a trivial amount of code to also save the dynamic TypeLib that was created, as a TLB file. So, it's also (if you want) a TypeLib generator. This allows us to define all our UDTs, then save the TLB file, and then use it in a subsequent program. No need for MIDL nor any other tools. Furthermore, you can push the resulting TLB file into OleView if you'd like to disassemble it and see the actual IDL code.
All of the code is in the class module named UdtsToVariants.cls. Just grab this CLS file and toss it into any VBP project to start using it. You will need a reference in that project to the oleexp.tlb TypeLib.
It has its VB_PredeclaredId set to True, so there's no need to declare or instantiate it. Just start using it. And there should never be a need to instantiate more than one copy, so this works out perfectly. It just behaves like an extension of the VB6 language.
Prerequisite: As has been mentioned, this all makes use of the oleexp.tlb, version 5.4 or later. This is the only prerequisite, other than a reasonably late version of Windows. I didn't check to see when all of this stuff became available, but I do believe it's been available for quite some time.
Also, some might say "well, you're still using a TypeLib" file. Yes, that's true, but I'm not using a TypeLib file for my actual UDTs, which was what was important to me. I don't mind TypeLibs. I just mind TypeLibs that I constantly have to tweak on and reassemble with MIDL. This hides all of that.
Internally, the class name is UDT. Let me start by listing the Public procedures in this UDT class:
CreateNewUdtInDynamicTypeLib
StartNewUdt
AddItemToNewUdt
FinishNewUdt
SaveDynamicTypeLib
DynamicUdtCount
NewEmptyVariant
NewEmptyVariantUsingRecInfo
FromVariant
ToVariant
ToVariantUsingRecInfo
If you're just interested in UDTs with intrinsic types and late-bound objects, you can get away with only using the very first one (CreateNewUdtInDynamicTypeLib). This CreateNewUdtInDynamicTypeLib internally calls StartNewUdt, AddItemToNewUdt, & FinishNewUdt. However, if you want nested UDTs and/or arrays as your UDT items, you must explicitly call the StartNewUdt, AddItemToNewUdt, & FinishNewUdt trio. You will call AddItemToNewUdt for each item within your UDT, and you must be sure to call FinishNewUdt when you're done adding items.
The SaveDynamicTypeLib is entirely optional. You will use this only if you wish to save your created dynamic TypeLib to disk as a TLB file. It's always saved in the App.Path folder and always named DynamicUdt.tlb. Once it's saved, you can rename and/or move it to wherever you like, and then use it in whatever project you like.
DynamicUdtCount is simply a count of the UDTs you've created in your dynamic TypeLib. It's not very useful, other than, internally, the code must track this.
The NewEmptyVariant procedure returns a Variant containing a new/empty copy of any UDT you've created in your TypeLib. What's particularly nice is, even when in a Variant, you can still address your UDT's items with the dot (.) syntax. You will lose the IntelliSense help for the items, but they will still work so long as you don't misspell them. You'll get a runtme error if you do.
The NewEmptyVariantUsingRecInfo does the same thing as NewEmptyVariant, but is uses an IRecordInfo object (rather than the UDT's name) to get its work done. Typically, we don't have to worry about these IRecordInfo object at all. However, when we don't use them, internally, they have to be looked up in a Collection. If we're after pure speed, it's faster to explicitly save our IRecordInfo objects, and then use them when we wish to create Variants (as it circumvents the Collection lookup).
In some cases, you may want to create a dynamic TypeLib of your UDTs, and then also mirror these with actual (traditional) UDT declarations (eg., Type MyUdt: i1 As Long: i2 As Long: End Type). When you've mirrored your UDTs like this, the FromVariant, ToVariant, & ToVariantUsingRecInfo become useful. The FromVariant procedure allows us to copy a UDT in a Variant to a UDT variable that's declared in the standard way. The ToVariant procedure does the precise opposite, taking a standard UDT variable and puts it into a Variant with that UDT. The ToVariantUsingRecInfo is just a faster way to do this part (if we're saving our IRecordInfo objects).
What does this currently not do? The only thing I can think of that it currently doesn't do is TypeLibs with early-binding. For instance, let's say we've got a Class1 in our project. With a standard UDT, we can do something like the following:
Code:
Private Type MyUdt
i As Long
o As Class1 ' Early bound.
End Type
Using this dynamic TypeLib code, you can't do that. However, if we're willing to do it as late-binding, it will all work just fine:
Code:
Private Type MyUdt
i As Long
o As Object ' Late bound.
End Type
Rather than ramble on about what things do, let me continue by just showing several examples. I'll just use a Form1, and assume the UdtsToVariants.cls is included in the project, and that the oleexp.tlb is referenced.
Example #1, a simple UDT with a couple of intrinsic variables and an object:
Code:
Option Explicit
Private Sub Form_Load()
' Test of intrinsic types and late-bound objects.
Udt.CreateNewUdtInDynamicTypeLib "TestUdt1", "x", vbLong, "y", vbSingle, "s", vbString, "o", vbObject
Dim vTestUdt1 As Variant
vTestUdt1 = Udt.NewEmptyVariant("TestUdt1")
vTestUdt1.x = 5
vTestUdt1.y = 10
vTestUdt1.s = "asdf"
Set vTestUdt1.o = New StdFont
vTestUdt1.o.Name = "Courier New"
Debug.Print vTestUdt1.x, vTestUdt1.y, vTestUdt1.s, vTestUdt1.o.Name
' Prints out: 5 10 asdf Courier New
End Sub
The only two calls I made into the UDT object were CreateNewUdtInDynamicTypeLib and NewEmptyVariant. Let me talk about CreateNewUdtInDynamicTypeLib a bit. Here are its arguments:
sUdtName As String
ParamArray vUdtItemNamesAndTypes() As Variant
The sUdtName is obvious. It's just the name of our UDT we wish to create. The ParamArray vUdtItemNamesAndTypes() is a bit more complex, but not really if we're already familiar with creating standard UDTs. This is pairs of arguments. The first of each pair is a UDT item name, and then second is the item's type. Allowable types are: vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDate, vbString, vbBoolean, vbObject, & vbVariant.
There's really not much more to it than that. And since our UDT is in a Variant, we can pass it anywhere we like. Furthermore, we can make (Let) assignments to it's items (as shown) just like a standard UDT.
Example #2, expanding on example #1 just a bit:
We've added an explicitly declared standard UDT that mirrors the UDT we're creating with the dynamic TypeLib. And we also show how data from a UDT in a Variant can be moved to a standard UDT variable.
Code:
Option Explicit
Private Type TestUdt1
x As Long
y As Single
s As String
o As Object
End Type
Private Sub Form_Load()
' Test of intrinsic types and late-bound objects.
Udt.CreateNewUdtInDynamicTypeLib "TestUdt1", "x", vbLong, "y", vbSingle, "s", vbString, "o", vbObject
Dim vTestUdt1 As Variant
vTestUdt1 = Udt.NewEmptyVariant("TestUdt1")
vTestUdt1.x = 5
vTestUdt1.y = 10
vTestUdt1.s = "asdf"
Set vTestUdt1.o = New StdFont
vTestUdt1.o.Name = "Courier New"
Debug.Print vTestUdt1.x, vTestUdt1.y, vTestUdt1.s, vTestUdt1.o.Name
' Prints out: 5 10 asdf Courier New
Dim myTestUdt1 As TestUdt1
Udt.FromVariant vTestUdt1, VarPtr(myTestUdt1)
' Now, we've copied the Variant version of the UDT into a standard UDT.
' Let's just change Y, for grins.
myTestUdt1.y = 13
Debug.Print myTestUdt1.x, myTestUdt1.y, myTestUdt1.s, myTestUdt1.o.Name
' Prints out: 5 13 asdf Courier New
End Sub
This comes in particularly handy if you wish to use this UDTs-in-Variants, but you also wish to make API calls with the UDTs. If an API needs a UDT, you can't just pass the Variant containing the UDT. But you can just do something like the following:
Code:
' In the module's header.
Declare Sub SomeApiCall Lib "some_library" (ByRef MyUdt As TestUdt1)
' In some procedure.
Udt.FromVariant vTestUdt1, VarPtr(myTestUdt1)
Call SomeApiCall(myTestUdt1)
We've added an explicitly declared UDT (TestUdt1), and we've also copied our Variant UDT into a non-Variant UDT with the same items. This non-Variant UDT is a copy of the original Variant UDT. All intrinsics are copied, and the reference-count of the object is incremented.
For the next example, let's uninstantiate that StdFont object, and then put it back into the Variant UDT.
The latest UdtsToVariants.cls, along with a small test project, will always be attached to this post:
2/10/2023 The initial version released.
Last edited by Elroy; Feb 12th, 2023 at 12:32 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Example #3, putting our standard UDT back into a Variant UDT:
Code:
Option Explicit
Private Type TestUdt1
x As Long
y As Single
s As String
o As Object
End Type
Private Sub Form_Load()
' Test of intrinsic types and late-bound objects.
Udt.CreateNewUdtInDynamicTypeLib "TestUdt1", "x", vbLong, "y", vbSingle, "s", vbString, "o", vbObject
Dim vTestUdt1 As Variant
vTestUdt1 = Udt.NewEmptyVariant("TestUdt1")
vTestUdt1.x = 5
vTestUdt1.y = 10
vTestUdt1.s = "asdf"
Set vTestUdt1.o = New StdFont
vTestUdt1.o.Name = "Courier New"
Debug.Print vTestUdt1.x, vTestUdt1.y, vTestUdt1.s, vTestUdt1.o.Name
' Prints out: 5 10 asdf Courier New
Dim myTestUdt1 As TestUdt1
Udt.FromVariant vTestUdt1, VarPtr(myTestUdt1)
' Now, we've copied the Variant version of the UDT into a standard UDT.
' Let's just change Y, for grins.
myTestUdt1.y = 13
Debug.Print myTestUdt1.x, myTestUdt1.y, myTestUdt1.s, myTestUdt1.o.Name
' Prints out: 5 13 asdf Courier New
'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
Set myTestUdt1.o = Nothing
vTestUdt1 = Udt.ToVariant("TestUdt1", VarPtr(myTestUdt1))
Debug.Print vTestUdt1.x, vTestUdt1.y, vTestUdt1.s, TypeName(vTestUdt1.o)
' Prints out: 5 13 asdf Nothing
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
End Sub
When we put it back, we stepped on the last instantiated copy of our StdFont, so it's reference count went to zero, and it was uninstantiated. That's just the nuances of dealing with objects, and I won't go into that in detail here. I did check and test, and object are being correctly handled in all of this. Truth be told, it's all just piggy-backing onto the way VB6 already works. So, object arrays or nested objects should all work just fine (and I did test and found no problems).
Example #4, returning to example #1, but adding one line of code:
Code:
Option Explicit
Private Sub Form_Load()
' Test of intrinsic types and late-bound objects.
Udt.CreateNewUdtInDynamicTypeLib "TestUdt1", "x", vbLong, "y", vbSingle, "s", vbString, "o", vbObject
Dim vTestUdt1 As Variant
vTestUdt1 = Udt.NewEmptyVariant("TestUdt1")
vTestUdt1.x = 5
vTestUdt1.y = 10
vTestUdt1.s = "asdf"
Set vTestUdt1.o = New StdFont
vTestUdt1.o.Name = "Courier New"
Debug.Print vTestUdt1.x, vTestUdt1.y, vTestUdt1.s, vTestUdt1.o.Name
' Prints out: 5 10 asdf Courier New
'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
Udt.SaveDynamicTypeLib
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
End Sub
We've just added the Udt.SaveDynamicTypeLib line. As stated earlier, it's not necessary to do this for all of this to work. Also, as it's written, the DynamicUdt.tlb file is written into the App.Path, which may cause problems for some applications. You should only execute this SaveDynamicTypeLib call if you wish to use all of this as a utility to generate TypeLib files for your UDTs.
I took the generated DynamicUdt.tlb and ran it through Oleview (which isn't necessary at all), and here's the disassembled TypeLib (reformatted just a touch):
Code:
[
uuid(7CF35D85-0158-45D7-8E3E-0E9D492CD2C9),
version(1.0)
]
library
{
// Forward declare all types defined in this typelib
typedef [uuid(BCB917D3-B188-49B7-9202-B2D3D3392936)]
struct tagTestUdt1
{
long x;
single y;
BSTR s;
IDispatch* o;
} TestUdt1;
};
For those familiar with TypeLib source code, this should look familiar. For others, maybe not so much.
The biggest advantage of this is that you could take this DynamicUdt.tlb file (possibly renamed, which wouldn't hurt anything), and use it in any other project. Doing that would obviate any/all need to explicitly declare these UDTs. Their UDT types would just be available to you. Furthermore, any UDT variable declared with these types could be place into a Variant, and passed anywhere you like. Also, if the UDT isn't in a Variant, it'll pass into API calls just fine (even when declared from the type in a TypeLib).
If the TLB file isn't in the same folder as your VBP file, you may need to register it with the regtlib utility in Windows.
Example #5, UDTs with arrays (either static or dynamic):
This is where we can no longer use the CreateNewUdtInDynamicTypeLib call, and we must resort to the StartNewUdt, AddItemToNewUdt, FinishNewUdt calls. The StartNewUdt is easy. Just supply a UDT name and call it. Here is its declaration:
Code:
Public Sub StartNewUdt(sUdtName As String)
AddItemToNewUdt is a bit more complex, and here's its declaration:
Code:
Public Sub AddItemToNewUdt(sItemName As String, ByVal iItemType As VbVarType, _
Optional iItemTypeModifier As UdtItemTypeModifiers, _
Optional sNestedUdtName As String, _
Optional iDimensions As Long, _
Optional iLBound1 As Long, Optional iUBound1 As Long, _
Optional iLBound2 As Long, Optional iUBound2 As Long, _
Optional iLBound3 As Long, Optional iUBound3 As Long, _
Optional iLBound4 As Long, Optional iUBound4 As Long, _
Optional iLBound5 As Long, Optional iUBound5 As Long, _
Optional iLBound6 As Long, Optional iUBound6 As Long) ' iDimension & the bounds are used ONLY for static arrays.
We call this once for each item in our UDT, and a different sItemName is specified each time.
As with CreateNewUdtInDynamicTypeLib the iItemType can be any of the following: vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDate, vbString, vbBoolean, vbObject, & vbVariant.
In addition, iItemType can be vbUserDefinedType, but we'll get to that a bit later.
We also get a new Enum that can be used when calling AddItemToNewUdt:
Code:
Public Enum UdtItemTypeModifiers
vbStaticArray = &H10000 ' | Only one of these two can be specified.
vbDynamicArray = &H20000 ' /
End Enum
This is used to create either static or dynamic arrays for a specific UDT item, and is specified in the iItemTypeModifier argument. If you're using this AddItemToNewUdt approach, and it's not an array, leave this argument blank.
And finally, when we've added all our UDT's items, we must call FinishNewUdt to finish things up. If this isn't called, bad things will happen. It's analogous to a Select Case with no End Select. However, I don't have control over VB6's syntax checker, so you just have to take care to do this.
Code:
Option Explicit
Private Sub Form_Load()
' Test of static and dynamic arrays.
Udt.StartNewUdt "TestUdt2"
Udt.AddItemToNewUdt "sa", vbLong, vbStaticArray, , 2, 0, 5, 0, 3
Udt.AddItemToNewUdt "da", vbLong, vbDynamicArray
Udt.FinishNewUdt
Dim vTestUdt2 As Variant
vTestUdt2 = Udt.NewEmptyVariant("TestUdt2")
' Assign some numbers to static array.
' Note that these still throw array out of bounds errors if they need to.
vTestUdt2.sa(0, 0) = 100
vTestUdt2.sa(1, 1) = 111
' Redim our dynamic array.
' These will also throw out of bounds errors, and/or not dimensioned errors if they need to.
ReDim vTestUdt2.da(-2 To 4, 3 To 5)
' Assign some numbers.
vTestUdt2.da(-2, 3) = 523
vTestUdt2.da(4, 5) = 545
' Show results:
Debug.Print vTestUdt2.sa(0, 0); vTestUdt2.sa(1, 1); vTestUdt2.da(-2, 3); vTestUdt2.da(4, 5)
' Output: 100 111 523 545
End Sub
For grins, I threw in a Udt.SaveDynamicTypeLib line in the above code and disassembled the resulting TLB. Here's what it looks like:
Code:
[
uuid(AAA506AA-20D3-413D-8311-17CF5A4EE17A),
version(1.0)
]
library
{
// Forward declare all types defined in this typelib
typedef [uuid(61E4CDD1-725D-455E-BED0-98CA62489424)]
struct tagTestUdt2
{
long sa[6][4];
SAFEARRAY(long) da;
} TestUdt2;
};
I'm not sure why, but I just think it's super cool that VB6 can do this.
A Bit More on SaveDynamicTypeLib:
Let me take a moment to say a bit more about the SaveDynamicTypeLib call. There are three optional arguments to this call:
Optional ByVal sGuid As String
Optional iMajorVersion As Integer = 1
Optional iMinorVersion As Integer = 0
If you don't supply a GUID, a random one will be generated and supplied. However, if you are actually using this TLB file in another project, you may want to let it generate a GUID the first time, then see what it is and then save it, re-using it if/when you regenerate your TLB file. That way, you will maintain some degree of compatibility. Also, if you're registering your TLB file, it'll use that same GUID in the registry, rather than cluttering up your registry with a bunch of different GUID numbers.
The iMajorVersion and iMinorVersion numbers are entirely at your discretion. In the disassembled TLB file, you can see version(1.0). To the left of the decimal is major, and to the right is minor.
Last edited by Elroy; Feb 12th, 2023 at 12:30 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
The following is an example of nesting our TestUdt1 (from example #1) into TestUdt3. I've nested it both as a simple nesting, and also as a static array, just to illustrate how both can be done.
As with typically declared UDTs, the UDT to be nested must be created before the parent can be created.
Code:
Option Explicit
Private Sub Form_Load()
' Create our child UDT to be nested.
Udt.CreateNewUdtInDynamicTypeLib "TestUdt1", "x", vbLong, "y", vbSingle, "s", vbString, "o", vbObject
' Create our parent UDT with TestUdt1 nested (once as non-array, and secondly as static array).
Udt.StartNewUdt "TestUdt3"
Udt.AddItemToNewUdt "u1", vbUserDefinedType, , "TestUdt1"
Udt.AddItemToNewUdt "sa1", vbUserDefinedType, vbStaticArray, "TestUdt1", 1, 0, 5
Udt.FinishNewUdt
' Create a Variant with our TestUdt3, set some values, and print.
Dim v3 As Variant
v3 = Udt.NewEmptyVariant("TestUdt3")
v3.u1.x = 111
v3.u1.y = 1.234!
v3.u1.s = "asdf"
Set v3.u1.o = New StdFont
v3.u1.o.Name = "Courier New"
' We'll just pick on array element 3.
v3.sa1(3).x = 222
v3.sa1(3).y = 2.468!
v3.sa1(3).s = "qwer"
Set v3.sa1(3).o = New StdFont
v3.sa1(3).o = "Segoe UI"
Debug.Print v3.u1.x, v3.u1.y, v3.u1.s, v3.u1.o.Name
' Output: 111 1.234 asdf Courier New
Debug.Print v3.sa1(3).x, v3.sa1(3).y, v3.sa1(3).s, v3.sa1(3).o.Name
' Output: 222 2.468 qwer Segoe UI
End Sub
And if we'd used a dynamic array rather than a static array, we'd need to use ReDim before we could actually use it.
Arguments of the AddItemToNewUdt procedure:
Here is the list of arguments to the AddItemToNewUdt procedure:
sItemName
iItemType
iItemTypeModifier
sNestedUdtName
iDimensions
iLBound1 & iUBound1 thru iLBound6 & iUBound6
Only the first two are required, and they are fairly obvious. The iItemType has all the intrinsic variable types allowed (vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDate, vbString, vbBoolean, vbObject, & vbVariant), and in addition, there's a new vbUserDefinedType allowed that wasn't allowed in the CreateNewUdtInDynamicTypeLib call. This vbUserDefinedType type is what allows us to nest UDTs, as seen above in example #6.
The iItemTypeModifier is either vbStaticArray or vbDynamicArray. If we don't wish an array, leave it blank (no passed argument).
The sNestedUdtName is used only if iItemType=vbUserDefinedType. Otherwise, sNestedUdtName is ignored.
The iDimensions is used only if iItemTypeModifier=vbStaticArray. Otherwise, iDimensions is ignored. This is how we specify how many dimensions our static array has. Accomodations for up to 6 dimensions are provided. In theory, this could be expanded to more dimensions, but I felt 6 was enough for most typical circumstances. Also, more would require more arguments in the lower-bound and upper-bound specifications. (And just as an FYI, I couldn't use a ParamArray for the bounds because you can't combine "Optional" with "ParamArray".)
As with iDimensions, the iLBound1 & iUBound1 thru iLBound6 & iUBound6 arguments are only used if iItemTypeModifier=vbStaticArray. Otherwise, they are ignored. Furthermore, only the ones corresponding to how many dimensions you've specified (iDimensions) are actually examined, with others ignored.
As we can see, in the above example #6, all the arguments were used (with the exception of all the iLbound# & iUBound# arguments, where only the first set was used).
Return of the FinishNewUdt procedure:
As with the CreateNewUdtInDynamicTypeLib procedure, the FinishNewUdt procedure returns an IRecordInfo object that's associated with the TypeLib UDT just created. In most cases, you can safely discard this IRecordInfo return (same as for CreateNewUdtInDynamicTypeLib). This will only be used if you wish to call the alternate NewEmptyVariantUsingRecInfo or ToVariantUsingRecInfo procedures. And, the only reason to consider using these alternate procedures is because they're a bit faster than the NewEmptyVariant and ToVariant procedures. The NewEmptyVariant and ToVariant procedures have to do a Collection lookup whereas the NewEmptyVariantUsingRecInfo or ToVariantUsingRecInfo procedures don't. However, if you only have a few UDTs, the Collection lookups should be extremely fast.
The only time it's worth considering using the NewEmptyVariantUsingRecInfoand/or ToVariantUsingRecInfo procedures is if you're extremely worried about speed.
Last edited by Elroy; Feb 10th, 2023 at 03:53 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
That's about it. The rest is just combinations and permutations of what's already been outlined.
And, to say again, I've done quite a bit of testing, and everything seems to work as expected ... including the reference count increase/decrease of objects, and their un-instantiation when those reference counts go to zero.
To say again, using the IRecordInfo (exposed with the help of Fafalone's oleexp.tlb), this is all little more than code that just piggybacks on what VB6 is already doing under the hood.
Bullet-point summary:
This is all about the UdtsToVariants.cls (with the actual class named "UDT" as seen in the above examples). And it has its VB_PredeclaredId set to True, so there's no need to declare or instantiate it.
To use this UdtsToVariants.cls in a project, that project must have a reference set to oleexp.tlb for version 5.4 or later.
Using this UDT class, we can dynamically create a TypeLib of our UDTs, and either directly use that TypeLib or save it as a TLB file and then use that file in other projects.
If saved, the TLB file is named DynamicUdt.tlb, and will be saved to the App.Path folder. Once saved, this TLB file can be renamed if you like. To be used in another project, it will need to be moved to that project's folder and/or registered (with the regtlib utility).
For flat (no arrays, no nesting) UDTs, the CreateNewUdtInDynamicTypeLib is the only call needed.
If your UDT contains arrays (either dynamic or static) and/or has nested UDTs, you can use the StartNewUdt, AddItemToNewUdt, FinishNewUdt set of calls to create your UDT.
Once UDTs are created in the dynamic TypeLib, the NewEmptyVariant call can be used to easily create new Variant variables with any of your UDTs.
Once we have a Variant containing a UDT, we can make assignments (Let ...) to its items just like a standard UDT.
If, in addition to creating your UDTs in the dynamic TypeLib, you also create "mirrored" declarations of your UDTs in the standard way, you can use the FromVariant & ToVariant calls to move your data from a Variant containing your UDT into a standard UDT variable, or vice-versa.
When in a Variant, your UDTs can be passed anywhere you like, as this was the original impetus for this whole endeavor. You can even put these Variants containing UDTs into a Collection if you so desired. Also, in the above examples, I scoped all the test Variants to the Form_Load procedure. However, these Variants with UDTS can be scoped to any level you like, and they'll work just fine.
Last edited by Elroy; Feb 10th, 2023 at 06:48 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I wonder if any of the structures I have been manually parsing in vb6 compiled binaries are actually serialized irecord structures. Will have to compare.
BTW you can use this method for serializing such UDTs.
Maybe I'll add a "Serialized" method after this has been out there for a bit. That's not a bad idea.
Got to finish the documentation first though.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I wonder if any of the structures I have been manually parsing in vb6 compiled binaries are actually serialized irecord structures. Will have to compare.
No, they don't.
Originally Posted by Elroy
Maybe I'll add a "Serialized" method after this has been out there for a bit. That's not a bad idea.
Got to finish the documentation first though.
It isn't serializing it's marshaling - sorry, my mistake. It's another thing. When you serialize an object you save its state and when you deserialize an object you create full copy of previous object. When you marshal an object you save an information to have access to the original object. You have a new cloned object in the first case and you have the reference to the original object in the second one. Although you can serialize non-object types without problems.
I'd like to make a post that outlines the different options we now have for getting UDTs into Variants:
Use the above UdtsToVariants.cls and make a dynamic (runtime) TypeLib, and then use it in the same project. Upside: Easy to use/understand by VB6 programmers. Downside: You must separately create Variant UDTs and standard UDT variables, possibly copying data between them with the methods in UdtsToVariants.cls.
Use the above UdtsToVariants.cls, and then save the TLB file, and then register and reference that in another project. Upside: Easy to use/understand by VB6 programmers. Downside: You must futz with a TLB file during development.
Just turn your project into an ActiveX.exe with a creatable class, and put your UDTs in this creatable class as Public UDTs. Upside: Fairly easy to use/understand by VB6 programmers. Downside: Your final executable is far from portable, requiring admin rights on first execution so it can register itself, and also possible registry clutter.
Create an ActiveX.dll that's used with your project which has a creatable class with your UDTs in it as Public UDTs. Upside: Fairly easy to use/understand by VB6 programmers. Downside: This ActiveX.dll must be distributed with your executable and registered (or setup with SxS, or dynamically loaded).
Write an IDL for your UDTs, and then assemble it into a TLB file with MIDL or MKTYPLIB, and then register and reference that in your project. Upside: This was the way things were originally intended to be done. Downsides: Requires knowledge of how to write C-like IDL files, requires knowledge of how to execute either MIDL or MKTYPLIB, and also requires futzing with a TLB file during development.
Create a project with your UDTs, and then compile it as an ActiveX.exe, telling it to create "Remote Server Files" which will cause it to create a TLB file when it's compiled. Upside: Easy to create TLB file with VB6. Downside: Creating a TLB file this way will cause it to need to be distributed (and registered) with your final project's executable. And this approach can also cause possible registry clutter.
When someone asks about this in the future, I'll probably reference this post.
------------------------------------
ADDED: And yes, as VanGough pointed out (and suggested in posts above), if you keep your TLB file with your project's source, and reference it their, you don't absolutely have to register it to use it. In my main project, I tend to keep my TLB files in a sub-folder of my main source code folder. (There are actually many sub-folders there for a variety of purposes.) But again, that last option (creating TLB files with the "Remote Server Files" option), is possibly the worst option in the list because of the various dependencies it wraps into the TLB file.
Last edited by Elroy; Feb 12th, 2023 at 04:00 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
As far as I know the TLB does not need to be registered as long as it's present in the same folder as the executable. It just loads it from there on every execution. Very interesting info about the checkbox to produce "Remote Server Files". I just tried it and it does produce a TLB file as well as a VBR file (which is just a text file containing various registry keys describing the classes present in the ActiveX EXE). I don't know what's the purpose of this VBR file since the ActiveX EXE still needs to be run as administrator if you copy it to another location...
On the other hand a TLB never needs to be distributed along with your executables. It is only needed if you distribute source code. All info in the TLB gets compiled in the executable when you make it.
Last edited by VanGoghGaming; Feb 12th, 2023 at 01:59 PM.
As far as I know the TLB does not need to be registered as long as it's present in the same folder as the executable. It just loads it from there on every execution. Very interesting info about the checkbox to produce "Remote Server Files". I just tried it and it does produce a TLB file as well as a VBR file (which is just a text file containing various registry keys describing the classes present in the ActiveX EXE). I don't know what's the purpose of this VBR file since the ActiveX EXE still needs to be run as administrator if you copy it to another location...
On the other hand a TLB never needs to be distributed along with your executables. It is only needed if you distribute source code. All info in the TLB gets compiled in the executable when you make it.
If you create a TLB file using the "Remote Server Files" option, it DOES need to be distributed ... test it!
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
It's crazy how this forum has the habit of resurfacing subjects already discussed years ago! (and that's not a bad thing, human memory needs constant refreshing!)
Last edited by VanGoghGaming; Feb 12th, 2023 at 05:04 PM.
I check today, that we can use the class for UDT changing to make a new if we wish, and I do an experiment: I make a command button and I make there some udt, one of them already created in the form's udt class (as Elroy does) and the second with changed name. So after the call to new udt return the second one, and works, but the typelib (the class) not exist any more. I suspect that the iRecordinfo of variant (which exist on any variant, as the last 4 bytes) keep alive this object.
This is the example (just use an OLEEXP, I didn't include it).
I check today, that we can use the class for UDT changing to make a new if we wish, and I do an experiment: I make a command button and I make there some udt, one of them already created in the form's udt class (as Elroy does) and the second with changed name. So after the call to new udt return the second one, and works, but the typelib (the class) not exist any more. I suspect that the iRecordinfo of variant (which exist on any variant, as the last 4 bytes) keep alive this object.
This is the example (just use an OLEEXP, I didn't include it).
A COM object has reference counter so it's alive until the last reference is gone.
Yes, the IrecordInfo is an object and not need the typelib to survive from a return from a function where we make that. The problem will be if the object happen to defined in another process. When we call an object from ActiveX.exe, that object lives in another process and the system use RPC to access it. So a variant returned by that type of object (from a method) should have a iRecordInfo remote or something. I didn't try that.
Is there any handy way to get from an object the list of puplic variants and enums ?
Last edited by georgekar; Feb 13th, 2023 at 04:54 PM.
Yes, the IrecordInfo is an object and not need the typelib to survive from a return from a function where we make that. The problem will be if the object happen to defined in another process. When we call an object from ActiveX.exe, that object leave in another process and the system use RPC to access it. So a variant returned by that type of object (from a method) should have a iRecordInfo remote or something. I didn't try that.
Is there any handy way to get from an object the list of puplic variants and enums ?
Hi George,
I certainly don't mind discussions of this stuff, and I'm interested myself. However, if you wouldn't mind, could you please possibly start a new post with this question over in the regular Q&A section? This isn't exactly relevant to the OP of this thread.
Thanks,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
No problem. It just seemed like this discussion might go on for a while.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Elroy, do you try to pass an UDT as member of UDT? Maybe you have to use the modified class which I provide, which do something simple: It takes a filename using a random name. Also the class can be create any number of objects.
In my Interpreter I have install a way to read/write fields (just for experiment), but not for using arguments to fields (although trick provide a way, I need some more information, to not allow the user to pass arguments to those fields who didn't have arguments). On way to know that, is when the user make an UDT, so I can handle it by using a json or xml to store the info, temporary until the program of user return to immediate mode (which means the actual program, the environment of M2000 as I named it, still running). So I need to read a class some info for UDT (and also Enum variable types, which for now I have also problem to get a list). For now I can read modules/functions/properties of a class and export a list of arguments, although when I found UDT I can't get the name. I am not using typelib to handle.
This is my sub for getting info:
Code:
Public Function GetAllMembers(mList As FastCollection, obj As Object _
) As Boolean
Dim IDsp As IDispatch.IDispatchM2000
Dim IDsp1 As IDispatch.IDispatchM2000
Dim riid As IDispatch.IID
Dim params As IDispatch.DISPPARAMS
Dim Excep As IDispatch.EXCEPINFO
Dim mAttr As TYPEATTR
Set mList = New FastCollection
Dim ppFuncDesc As Long, fncdsc As FUNCDESC, cFuncs As Long
Dim ppVarDesc As Long, vardsc As VARDESC
Dim ParamDesc As TPARAMDESC, hlp As Long, pRefType As Long
Dim TypeDesc As TTYPEDESC, retval$
Dim ret As Long, pctinfo As Long, ppTInfo As Long, typeInf As IUnknown
Dim pAttr As Long
Dim tKind As Long
Set IDsp = obj
Dim cFncs As Long, CVars As Long, ttt$
Dim i As Long
Dim j As Long
Dim strNames() As String, strName As String, aName As String, count As Long
Dim acc As Long, CTX As Long
Const TYPEFLAG_FDUAL = &H40
Const TYPEFLAG_FPREDECLID = &H8
'' may have a GET and a LET for same name
mList.AllowAnyKey
ret = IDsp.GetTypeInfo(ByVal 0, ByVal 0, ppTInfo)
If ppTInfo = 0 Or ret <> 0 Then
If Err Then Err.Clear
Exit Function
End If
If IDsp.GetTypeInfoCount(count) <> &H80004001 Then
Debug.Print ">>>>>>>>>>", count
End If
Set typeInf = ResolveObjPtrNoRef(ppTInfo)
ITypeInfo_GetTypeAttr typeInf, pAttr
If pAttr = 0 Then Set typeInf = Nothing: Exit Function
memcpy mAttr, ByVal pAttr, Len(mAttr)
If (mAttr.wTypeFlags And TYPEFLAG_FPREDECLID) = &H8 Then
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Set typeInf = Nothing
Exit Function
End If
If (mAttr.wTypeFlags And TYPEFLAG_FDUAL) Then
If mAttr.typekind <> TKIND_DISPATCH Then
ITypeInfo_GetRefTypeOfImplType typeInf, -1, pRefType
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
ITypeInfo_GetRefTypeInfo typeInf, pRefType, ppTInfo
Set typeInf = ResolveObjPtrNoRef(ppTInfo)
ITypeInfo_GetTypeAttr typeInf, pAttr
memcpy mAttr, ByVal pAttr, Len(mAttr)
End If
End If
If TKIND_DISPATCH = mAttr.typekind Then
cFuncs = mAttr.cFuncs '' mAttr.cVars
For j = 0 To mAttr.cFuncs - 1
ITypeInfo_GetFuncDesc typeInf, j, ppFuncDesc
CpyMem fncdsc, ByVal ppFuncDesc, Len(fncdsc)
acc = fncdsc.lprgelemdescParam
ret = ITypeInfo_GetDocumentation(typeInf, fncdsc.memid, strName, vbNullString, CTX, vbNullString)
mList.AddKey UCase(strName), ""
Select Case fncdsc.invkind
Case INVOKE_EVENTFUNC:
strName = "Event " + strName
Case INVOKE_FUNC:
If fncdsc.elemdesc.vt = 24 Then
strName = "Sub " + strName
Else
strName = "Function " + strName
End If
Case INVOKE_PROPERTY_GET:
strName = "Property Get " + strName
Case INVOKE_PROPERTY_PUT:
strName = "Property Let " + strName
Case INVOKE_PROPERTY_PUTREF:
strName = "Property Set " + strName
End Select
mList.ToEnd ' move to last
ProcTask2 Basestack1
hlp = fncdsc.cParams
If hlp > 0 Then
cFncs = 0
ReDim strNames(fncdsc.cParams + 1) As String
aName = vbNullString
ret = ITypeInfo_GetDocumentation(typeInf, fncdsc.memid, aName, vbNullString, CTX, vbNullString)
ret = ITypeInfo_GetNames(typeInf, fncdsc.memid, strNames(), fncdsc.cParams + 1, cFncs)
If Not ret Then
strName = strName + "("
For i = 1 To hlp
If IsBadCodePtr(acc) = 0 Then
CopyBytes Len(ParamDesc), VarPtr(ParamDesc), ByVal acc + 8
CopyBytes Len(TypeDesc), VarPtr(TypeDesc), ByVal acc
End If
acc = acc + 16
ttt$ = ""
retval$ = ""
If strNames(i) = "" Then strNames(i) = "Value"
If (ParamDesc.wParamFlags And PARAMFLAG_FRETVAL) = &H8 Then
retval$ = " as " + stringifyTypeDesc(TypeDesc, typeInf)
Else
If (ParamDesc.wParamFlags And PARAMFLAG_FIN) = &H1 Then ttt$ = "in "
If (ParamDesc.wParamFlags And PARAMFLAG_FOUT) = &H2 Then ttt$ = ttt$ + "out "
If i > (hlp - fncdsc.cParamsOpt) And fncdsc.cParamsOpt <> 0 Then
strName = strName + "[" + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf) + "]"
Else
If fncdsc.cParamsOpt = 0 And (ParamDesc.wParamFlags And PARAMFLAG_FOPT) > 0 Then
strName = strName + "[" + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf) + "]"
Else
strName = strName + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf)
End If
End If
If i < hlp Then strName = strName + ", "
End If
Next i
strName = strName + ")"
End If
End If
If retval$ = "" Then
If fncdsc.elemdesc.vt = 24 Then
mList.Value = strName
Else
CopyBytes Len(TypeDesc), VarPtr(TypeDesc), VarPtr(fncdsc.elemdesc.pTypeDesc)
mList.Value = strName + " as " + stringifyTypeDesc(TypeDesc, typeInf)
End If
Else
mList.Value = strName + retval$
End If
ITypeInfo_ReleaseFuncDesc typeInf, ppFuncDesc
Next j
ReDim strNames(1) As String
End If
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Set typeInf = Nothing
Set IDsp = Nothing
GetAllMembers = True
End Function
I use a way to call a function on an interface by using offset of vtable. So ITypeInfo_GetTypeAttr is a call on &HC offset for that object (if the obj is a ITypeInfo)
See the double Varptr(), pReturn need one, but because point to ppTypeAttr need another from ppTypeAttr.
I found this way from modUnregCOM from Trick (2015)
Code:
Public Sub ITypeInfo_GetTypeAttr( _
ByVal obj As IUnknown, _
ByRef ppTypeAttr As Long)
Dim resultCall As Long
Dim pReturn As Variant
ppTypeAttr = 0
pReturn = VarPtr(ppTypeAttr)
resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(pReturn), 0)
If ppTypeAttr = 0 Then Exit Sub
If resultCall Then Err.Raise resultCall
End Sub
If you were to use my approach (showed to me by The Trick) seen above in that UdtsToVariants.cls code, you could certainly build all your UDT TypeLibs. Furthermore, you could explicitly save all the UDT names and the UDT item names. That would save you needing to dig them back out of the TypeLib, but I'm not sure if that's viable for you or not.
I'm not using any of the UDT-in-Public-Class tricks that The Trick has been talking about. Rather, I'm directly using the CreateTypeLib2 function.
Not sure if that helps or not.
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
There is a list here https://jeffpar.github.io/kbarchive/id/vbwin/
which have a lot of issues
This is for not process UDT from late binding objects which return UDT https://jeffpar.github.io/kbarchive/kb/184/Q184898/
As I think about, when say about early binding, say that the analogue with the use of DISPID for functions but for UDT fields, because the problem is at the compiling code where the field name can't be known so the compiler do not make a speculation and just call the way Trick show before, the way I use to read fields in M2000 using vbaVarLateMemCallLdRf, which is latebound, and may don't exist so I have to handle the error. I think VB6 to avoid to check for error, check if the UDT type is known only when assigning to a variable UDT.
Bug VB6 crash when get a UDT from c++ which have enum type field, but not crash when that field turn to Long. We can get an UDT from c++ without using typelib (we get UDT from functions from a c++ library) https://jeffpar.github.io/kbarchive/kb/221/Q221101/
"A circular dependency compilation error can occur when a User Defined Type (UDT)
is defined in a class module that implements another base class interface, and
the base class module has references to the UDT." https://jeffpar.github.io/kbarchive/kb/255/Q255757/
"If you copy a nested user defined type (UDT) with a fixed-length String array to
a fixed-length String by using a RtlMoveMemory API call, you may not get the
right result." https://jeffpar.github.io/kbarchive/kb/262/Q262667/
>>>>>When you open a project and do anything that uses IntelliSense, you receive a
"permission denied" error message when you try to recompile the project. The
project defines a public User Defined Type (UDT) that it uses as a parameter to
a public function, and binary compatibility is set. https://jeffpar.github.io/kbarchive/kb/282/Q282233/
My Interest is not to have UDT for fun, but for using them calling external functions/objects from activeX.dll (the most). Because I have the Group class which is like UDT (with nested UDT) but have methods so it is a kind of object, and we can get copies like udt or pointers to use them as objects. Also I have a "structure" type, like c types, which make a special "typelib" for using buffers of memory assigning types at specific offsets, so this is more like a udt. The difference is that it isn't a UDT which may have Arrays of type SafeArray.
So I am in a stage of thinking what is the most "clever" to do with UDT. I am not in a hurry although. So I am waiting to think the best solution, doing experiments and reading this forum (always).
when i add DynamicUdt.tlb to new vb6 project,ide Crashed, suggesting that the TLB has no name.
Additional questions:
It will be more convenient if you can directly input the structure code of VB6, automatically parse and identify and create TLB.
Is it possible to create a TLB file with code, and then add a CLASS in it, and wrap CLASS1 of VB6 into a TLB?
The tools I've tried before just create a TLB file of the user structure
Code:
moCreateTLB.SetGuid uGuid
moCreateTLB.SetVersion iMajorVersion, iMinorVersion
If TlbName = "" Then TlbName = "ABC_UserDataType"
moCreateTLB.SetName TlbName
Last edited by xiaoyao; Jun 21st, 2023 at 05:29 PM.
My Interest is not to have UDT for fun, but for using them calling external functions/objects from activeX.dll (the most). Because I have the Group class which is like UDT (with nested UDT) but have methods so it is a kind of object, and we can get copies like udt or pointers to use them as objects. Also I have a "structure" type, like c types, which make a special "typelib" for using buffers of memory assigning types at specific offsets, so this is more like a udt. The difference is that it isn't a UDT which may have Arrays of type SafeArray.
So I am in a stage of thinking what is the most "clever" to do with UDT. I am not in a hurry although. So I am waiting to think the best solution, doing experiments and reading this forum (always).
It would be great if you can provide the complete code for testing, upload a small project
First and foremost, a huge thanks goes out to [U][URL="https://www.vbforums.com/member.php?246405-The-trick"]The The latest UdtsToVariants.cls, along with a small test project, will always be attached to this post:[
Code:
Dim uNested As UdtNest
Udt.FromVariant UdtNested, VarPtr(uNested) ' Ok, we should now have a copy of UdtNested.
can we use bind varaint point ,not copy data?FromVariant
It's crazy how this forum has the habit of resurfacing subjects already discussed years ago! (and that's not a bad thing, human memory needs constant refreshing!)
If you can use a pointer, such as the address of the structure variable A in the module, the variable B in a process passed to another class retrieves the original structure, and directly manipulates the properties of the structure.
In this way, the data of A and B are the same, and they are modified synchronously, which is convenient.
i have a test ,put user dtata type to Variant argument:
Code:
Dim vv As Variant
vv = DataTypeToVV(VarPtr(U1))
Call SubInClass1(vv)
vvToDataType vv, VarPtr(U1)
Code:
Private Type UserInfo
ID As Long
v As Byte
UserName As String
End Type
Private Sub Form_Load()
IntDataType
End Sub
Sub IntDataType()
Udt.SetTlbFile
Udt.CreateNewUdtInDynamicTypeLib "UserInfo2", "ID", vbLong, "v", vbByte, "UserName", vbString
End Sub
Function DataTypeToVV(DataTypePtr As Long) As Variant
DataTypeToVV = Udt.ToVariant("UserInfo2", DataTypePtr)
End Function
Sub vvToDataType(vv As Variant, DataTypePtr As Long)
Udt.FromVariant vv, DataTypePtr
End Sub
Private Sub SubInClass1(vv As Variant)
'Copy Data tO U2
Dim U2 As UserInfo
Udt.FromVariant vv, VarPtr(U2)
'change Data
U2.v = U2.v + 1
U2.UserName = U2.UserName & "_NEW"
'callback ,return new data '传回
vv = Udt.ToVariant("UserInfo2", VarPtr(U2))
End Sub
Private Sub Command1_Click()
Dim U1 As UserInfo
U1.ID = 135
U1.v = 1
U1.UserName = "TOM"
MsgBox "First Data:" & U1.ID & "," & U1.v & "," & U1.UserName
Dim vv As Variant
vv = DataTypeToVV(VarPtr(U1))
Call SubInClass1(vv)
vvToDataType vv, VarPtr(U1)
MsgBox "New Data u1=" & U1.ID & "," & U1.v & "," & U1.UserName
End Sub
Very nice work Elroy. I would have loved to have this 20 years ago when I was dealing with sharing and serializing public UDTs between ActiveX exes, regular exes, and ActiveX dlls.
Elroy, do you try to pass an UDT as member of UDT? Maybe you have to use the modified class which I provide, which do something simple: It takes a filename using a random name. Also the class can be create any number of objects.
In my Interpreter I have install a way to read/write fields (just for experiment), but not for using arguments to fields (although trick provide a way, I need some more information, to not allow the user to pass arguments to those fields who didn't have arguments). On way to know that, is when the user make an UDT, so I can handle it by using a json or xml to store the info, temporary until the program of user return to immediate mode (which means the actual program, the environment of M2000 as I named it, still running). So I need to read a class some info for UDT (and also Enum variable types, which for now I have also problem to get a list). For now I can read modules/functions/properties of a class and export a list of arguments, although when I found UDT I can't get the name. I am not using typelib to handle.
This is my sub for getting info:
Code:
Public Function GetAllMembers(mList As FastCollection, obj As Object _
) As Boolean
Dim IDsp As IDispatch.IDispatchM2000
Dim IDsp1 As IDispatch.IDispatchM2000
Dim riid As IDispatch.IID
Dim params As IDispatch.DISPPARAMS
Dim Excep As IDispatch.EXCEPINFO
Dim mAttr As TYPEATTR
Set mList = New FastCollection
Dim ppFuncDesc As Long, fncdsc As FUNCDESC, cFuncs As Long
Dim ppVarDesc As Long, vardsc As VARDESC
Dim ParamDesc As TPARAMDESC, hlp As Long, pRefType As Long
Dim TypeDesc As TTYPEDESC, retval$
Dim ret As Long, pctinfo As Long, ppTInfo As Long, typeInf As IUnknown
Dim pAttr As Long
Dim tKind As Long
Set IDsp = obj
Dim cFncs As Long, CVars As Long, ttt$
Dim i As Long
Dim j As Long
Dim strNames() As String, strName As String, aName As String, count As Long
Dim acc As Long, CTX As Long
Const TYPEFLAG_FDUAL = &H40
Const TYPEFLAG_FPREDECLID = &H8
'' may have a GET and a LET for same name
mList.AllowAnyKey
ret = IDsp.GetTypeInfo(ByVal 0, ByVal 0, ppTInfo)
If ppTInfo = 0 Or ret <> 0 Then
If Err Then Err.Clear
Exit Function
End If
If IDsp.GetTypeInfoCount(count) <> &H80004001 Then
Debug.Print ">>>>>>>>>>", count
End If
Set typeInf = ResolveObjPtrNoRef(ppTInfo)
ITypeInfo_GetTypeAttr typeInf, pAttr
If pAttr = 0 Then Set typeInf = Nothing: Exit Function
memcpy mAttr, ByVal pAttr, Len(mAttr)
If (mAttr.wTypeFlags And TYPEFLAG_FPREDECLID) = &H8 Then
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Set typeInf = Nothing
Exit Function
End If
If (mAttr.wTypeFlags And TYPEFLAG_FDUAL) Then
If mAttr.typekind <> TKIND_DISPATCH Then
ITypeInfo_GetRefTypeOfImplType typeInf, -1, pRefType
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
ITypeInfo_GetRefTypeInfo typeInf, pRefType, ppTInfo
Set typeInf = ResolveObjPtrNoRef(ppTInfo)
ITypeInfo_GetTypeAttr typeInf, pAttr
memcpy mAttr, ByVal pAttr, Len(mAttr)
End If
End If
If TKIND_DISPATCH = mAttr.typekind Then
cFuncs = mAttr.cFuncs '' mAttr.cVars
For j = 0 To mAttr.cFuncs - 1
ITypeInfo_GetFuncDesc typeInf, j, ppFuncDesc
CpyMem fncdsc, ByVal ppFuncDesc, Len(fncdsc)
acc = fncdsc.lprgelemdescParam
ret = ITypeInfo_GetDocumentation(typeInf, fncdsc.memid, strName, vbNullString, CTX, vbNullString)
mList.AddKey UCase(strName), ""
Select Case fncdsc.invkind
Case INVOKE_EVENTFUNC:
strName = "Event " + strName
Case INVOKE_FUNC:
If fncdsc.elemdesc.vt = 24 Then
strName = "Sub " + strName
Else
strName = "Function " + strName
End If
Case INVOKE_PROPERTY_GET:
strName = "Property Get " + strName
Case INVOKE_PROPERTY_PUT:
strName = "Property Let " + strName
Case INVOKE_PROPERTY_PUTREF:
strName = "Property Set " + strName
End Select
mList.ToEnd ' move to last
ProcTask2 Basestack1
hlp = fncdsc.cParams
If hlp > 0 Then
cFncs = 0
ReDim strNames(fncdsc.cParams + 1) As String
aName = vbNullString
ret = ITypeInfo_GetDocumentation(typeInf, fncdsc.memid, aName, vbNullString, CTX, vbNullString)
ret = ITypeInfo_GetNames(typeInf, fncdsc.memid, strNames(), fncdsc.cParams + 1, cFncs)
If Not ret Then
strName = strName + "("
For i = 1 To hlp
If IsBadCodePtr(acc) = 0 Then
CopyBytes Len(ParamDesc), VarPtr(ParamDesc), ByVal acc + 8
CopyBytes Len(TypeDesc), VarPtr(TypeDesc), ByVal acc
End If
acc = acc + 16
ttt$ = ""
retval$ = ""
If strNames(i) = "" Then strNames(i) = "Value"
If (ParamDesc.wParamFlags And PARAMFLAG_FRETVAL) = &H8 Then
retval$ = " as " + stringifyTypeDesc(TypeDesc, typeInf)
Else
If (ParamDesc.wParamFlags And PARAMFLAG_FIN) = &H1 Then ttt$ = "in "
If (ParamDesc.wParamFlags And PARAMFLAG_FOUT) = &H2 Then ttt$ = ttt$ + "out "
If i > (hlp - fncdsc.cParamsOpt) And fncdsc.cParamsOpt <> 0 Then
strName = strName + "[" + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf) + "]"
Else
If fncdsc.cParamsOpt = 0 And (ParamDesc.wParamFlags And PARAMFLAG_FOPT) > 0 Then
strName = strName + "[" + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf) + "]"
Else
strName = strName + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf)
End If
End If
If i < hlp Then strName = strName + ", "
End If
Next i
strName = strName + ")"
End If
End If
If retval$ = "" Then
If fncdsc.elemdesc.vt = 24 Then
mList.Value = strName
Else
CopyBytes Len(TypeDesc), VarPtr(TypeDesc), VarPtr(fncdsc.elemdesc.pTypeDesc)
mList.Value = strName + " as " + stringifyTypeDesc(TypeDesc, typeInf)
End If
Else
mList.Value = strName + retval$
End If
ITypeInfo_ReleaseFuncDesc typeInf, ppFuncDesc
Next j
ReDim strNames(1) As String
End If
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Set typeInf = Nothing
Set IDsp = Nothing
GetAllMembers = True
End Function
I use a way to call a function on an interface by using offset of vtable. So ITypeInfo_GetTypeAttr is a call on &HC offset for that object (if the obj is a ITypeInfo)
See the double Varptr(), pReturn need one, but because point to ppTypeAttr need another from ppTypeAttr.
I found this way from modUnregCOM from Trick (2015)
Code:
Public Sub ITypeInfo_GetTypeAttr( _
ByVal obj As IUnknown, _
ByRef ppTypeAttr As Long)
Dim resultCall As Long
Dim pReturn As Variant
ppTypeAttr = 0
pReturn = VarPtr(ppTypeAttr)
resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(pReturn), 0)
If ppTypeAttr = 0 Then Exit Sub
If resultCall Then Err.Raise resultCall
End Sub
do you have a full code for get all cParams names ,types?
Declare Worksheet "{00020820-0000-0000-C000-000000000046}"
alfa=param(Worksheet)
Report Type$(Worksheet)' Workbook
IF LEN(ALFA)>1 THEN {
For i=0 to len(alfa)-1
Report 3, alfa$(i!)' use index, not key
Next i
}
This code print this:
Sub QueryInterface(in riid *GUID, out ppvObj **void)
Function AddRef as ULONG
Function Release as ULONG
Sub GetTypeInfoCount(out pctinfo *UINT)
Sub GetTypeInfo(in itinfo UINT, in lcid ULONG, out pptinfo **void)
Sub GetIDsOfNames(in riid *GUID, in rgszNames **char, in cNames UINT, in lcid ULONG, out rgdispid *Long)
Sub Invoke(in dispidMember Long, in riid *GUID, in lcid ULONG, in wFlags USHORT, in pdispparams *DISPPARAMS, out pvarResult *VARIANT, out pexcepinfo *EXCEPINFO, out puArgErr *UINT)
Property Get Application as *Application
Property Get Creator as XlCreator
Property Get Parent as IDispatch*
Property Get AcceptLabelsInFormulas as VARIANT_BOOL
Property Let AcceptLabelsInFormulas(in Value VARIANT_BOOL)
Sub Activate
Property Get ActiveChart as *Chart
Property Get ActiveSheet as IDispatch*
Property Get Author as String
Property Let Author(in Value String)
Property Get AutoUpdateFrequency as Long
Property Let AutoUpdateFrequency(in Value Long)
Property Get AutoUpdateSaveChanges as VARIANT_BOOL
Property Let AutoUpdateSaveChanges(in Value VARIANT_BOOL)
Property Get ChangeHistoryDuration as Long
Property Let ChangeHistoryDuration(in Value Long)
Property Get BuiltinDocumentProperties as IDispatch*
Sub ChangeFileAccess(in Mode XlFileAccess, [in WritePassword VARIANT], [in Notify VARIANT])
Sub ChangeLink(in Name String, in NewName String, [in Type XlLinkType])
Property Get Charts as *Sheets
Sub Close([in SaveChanges VARIANT], [in Filename VARIANT], [in RouteWorkbook VARIANT])
Property Get CodeName as String
Property Get _CodeName as String
Property Let _CodeName(in Value String)
Property Get Colors([in Index VARIANT]) as VARIANT
Property Let Colors(in Index VARIANT, [in Value VARIANT])
Property Get CommandBars as *CommandBars
Property Get Comments as String
Property Let Comments(in Value String)
Property Get ConflictResolution as XlSaveConflictResolution
Property Let ConflictResolution(in Value XlSaveConflictResolution)
Property Get Container as IDispatch*
Property Get CreateBackup as VARIANT_BOOL
Property Get CustomDocumentProperties as IDispatch*
Property Get Date1904 as VARIANT_BOOL
Property Let Date1904(in Value VARIANT_BOOL)
Sub DeleteNumberFormat(in NumberFormat String)
Property Get DialogSheets as *Sheets
Property Get DisplayDrawingObjects as XlDisplayDrawingObjects
Property Let DisplayDrawingObjects(in Value XlDisplayDrawingObjects)
Function ExclusiveAccess as VARIANT_BOOL
Property Get FileFormat as XlFileFormat
Sub ForwardMailer
Property Get FullName as String
Property Get HasMailer as VARIANT_BOOL
Property Let HasMailer(in Value VARIANT_BOOL)
Property Get HasPassword as VARIANT_BOOL
Property Get HasRoutingSlip as VARIANT_BOOL
Property Let HasRoutingSlip(in Value VARIANT_BOOL)
Property Get IsAddin as VARIANT_BOOL
Property Let IsAddin(in Value VARIANT_BOOL)
Property Get Keywords as String
Property Let Keywords(in Value String)
Function LinkInfo(in Name String, in LinkInfo XlLinkInfo, [in Type VARIANT], [in EditionRef VARIANT]) as VARIANT
Function LinkSources([in Type VARIANT]) as VARIANT
Property Get Mailer as *Mailer
Sub MergeWorkbook(in Filename VARIANT)
Property Get Modules as *Sheets
Property Get MultiUserEditing as VARIANT_BOOL
Property Get Name as String
Property Get Names as *Names
Function NewWindow as *Window
Property Get OnSave as String
Property Let OnSave(in Value String)
Property Get OnSheetActivate as String
Property Let OnSheetActivate(in Value String)
Property Get OnSheetDeactivate as String
Property Let OnSheetDeactivate(in Value String)
Sub OpenLinks(in Name String, [in ReadOnly VARIANT], [in Type VARIANT])
Property Get Path as String
Property Get PersonalViewListSettings as VARIANT_BOOL
Property Let PersonalViewListSettings(in Value VARIANT_BOOL)
Property Get PersonalViewPrintSettings as VARIANT_BOOL
Property Let PersonalViewPrintSettings(in Value VARIANT_BOOL)
Function PivotCaches as *PivotCaches
Sub Post([in DestName VARIANT])
Property Get PrecisionAsDisplayed as VARIANT_BOOL
Property Let PrecisionAsDisplayed(in Value VARIANT_BOOL)
Sub __PrintOut([in From VARIANT], [in To VARIANT], [in Copies VARIANT], [in Preview VARIANT], [in ActivePrinter VARIANT], [in PrintToFile VARIANT], [in Collate VARIANT])
Sub PrintPreview([in EnableChanges VARIANT])
Sub _Protect([in Password VARIANT], [in Structure VARIANT], [in Windows VARIANT])
Sub _ProtectSharing([in Filename VARIANT], [in Password VARIANT], [in WriteResPassword VARIANT], [in ReadOnlyRecommended VARIANT], [in CreateBackup VARIANT], [in SharingPassword VARIANT])
Property Get ProtectStructure as VARIANT_BOOL
Property Get ProtectWindows as VARIANT_BOOL
Property Get ReadOnly as VARIANT_BOOL
Property Get _ReadOnlyRecommended as VARIANT_BOOL
Sub RefreshAll
Sub Reply
Sub ReplyAll
Sub RemoveUser(in Index Long)
Property Get RevisionNumber as Long
Sub Route
Property Get Routed as VARIANT_BOOL
Property Get RoutingSlip as *RoutingSlip
Sub RunAutoMacros(in Which XlRunAutoMacro)
Sub Save
Sub __SaveAs(in Filename VARIANT, in FileFormat VARIANT, in Password VARIANT, in WriteResPassword VARIANT, in ReadOnlyRecommended VARIANT, in CreateBackup VARIANT, in AccessMode XlSaveAsAccessMode, [in ConflictResolution VARIANT], [in AddToMru VARIANT], [in TextCodepage VARIANT], [in TextVisualLayout VARIANT])
Sub SaveCopyAs([in Filename VARIANT])
Property Get Saved as VARIANT_BOOL
Property Let Saved(in Value VARIANT_BOOL)
Property Get SaveLinkValues as VARIANT_BOOL
Property Let SaveLinkValues(in Value VARIANT_BOOL)
Sub SendMail(in Recipients VARIANT, [in Subject VARIANT], [in ReturnReceipt VARIANT])
Sub SendMailer([in FileFormat VARIANT], [in Priority XlPriority])
Sub SetLinkOnData(in Name String, [in Procedure VARIANT])
Property Get Sheets as *Sheets
Property Get ShowConflictHistory as VARIANT_BOOL
Property Let ShowConflictHistory(in Value VARIANT_BOOL)
Property Get Styles as *Styles
Property Get Subject as String
Property Let Subject(in Value String)
Property Get Title as String
Property Let Title(in Value String)
Sub Unprotect([in Password VARIANT])
Sub UnprotectSharing([in SharingPassword VARIANT])
Sub UpdateFromFile
Sub UpdateLink([in Name VARIANT], [in Type VARIANT])
Property Get UpdateRemoteReferences as VARIANT_BOOL
Property Let UpdateRemoteReferences(in Value VARIANT_BOOL)
Property Get UserControl as VARIANT_BOOL
Property Let UserControl(in Value VARIANT_BOOL)
Property Get UserStatus as VARIANT
Property Get CustomViews as *CustomViews
Property Get Windows as *Windows
Property Get Worksheets as *Sheets
Property Get WriteReserved as VARIANT_BOOL
Property Get WriteReservedBy as String
Property Get Excel4IntlMacroSheets as *Sheets
Property Get Excel4MacroSheets as *Sheets
Property Get TemplateRemoveExtData as VARIANT_BOOL
Property Let TemplateRemoveExtData(in Value VARIANT_BOOL)
Sub HighlightChangesOptions([in When VARIANT], [in Who VARIANT], [in Where VARIANT])
Property Get HighlightChangesOnScreen as VARIANT_BOOL
Property Let HighlightChangesOnScreen(in Value VARIANT_BOOL)
Property Get KeepChangeHistory as VARIANT_BOOL
Property Let KeepChangeHistory(in Value VARIANT_BOOL)
Property Get ListChangesOnNewSheet as VARIANT_BOOL
Property Let ListChangesOnNewSheet(in Value VARIANT_BOOL)
Sub PurgeChangeHistoryNow(in Days Long, [in SharingPassword VARIANT])
Sub AcceptAllChanges([in When VARIANT], [in Who VARIANT], [in Where VARIANT])
Sub RejectAllChanges([in When VARIANT], [in Who VARIANT], [in Where VARIANT])
Sub PivotTableWizard([in SourceType VARIANT], [in SourceData VARIANT], [in TableDestination VARIANT], [in TableName VARIANT], [in RowGrand VARIANT], [in ColumnGrand VARIANT], [in SaveData VARIANT], [in HasAutoFormat VARIANT], [in AutoPage VARIANT], [in Reserved VARIANT], [in BackgroundQuery VARIANT], [in OptimizeCache VARIANT], [in PageFieldOrder VARIANT], [in PageFieldWrapCount VARIANT], [in ReadData VARIANT], [in Connection VARIANT])
Sub ResetColors
Property Get VBProject as *VBProject
Sub FollowHyperlink(in Address String, [in SubAddress VARIANT], [in NewWindow VARIANT], [in AddHistory VARIANT], [in ExtraInfo VARIANT], [in Method VARIANT], [in HeaderInfo VARIANT])
Sub AddToFavorites
Property Get IsInplace as VARIANT_BOOL
Sub _PrintOut([in From VARIANT], [in To VARIANT], [in Copies VARIANT], [in Preview VARIANT], [in ActivePrinter VARIANT], [in PrintToFile VARIANT], [in Collate VARIANT], [in PrToFileName VARIANT])
Sub WebPagePreview
Property Get PublishObjects as *PublishObjects
Property Get WebOptions as *WebOptions
Sub ReloadAs(in Encoding MsoEncoding)
Property Get HTMLProject as *HTMLProject
Property Get EnvelopeVisible as VARIANT_BOOL
Property Let EnvelopeVisible(in Value VARIANT_BOOL)
Property Get CalculationVersion as Long
Sub Dummy17(in calcid Long)
Sub sblt(in s String)
Property Get VBASigned as VARIANT_BOOL
Property Get ShowPivotTableFieldList as VARIANT_BOOL
Property Let ShowPivotTableFieldList(in Value VARIANT_BOOL)
Property Get UpdateLinks as XlUpdateLinks
Property Let UpdateLinks(in Value XlUpdateLinks)
Sub BreakLink(in Name String, in Type XlLinkType)
Sub Dummy16
Sub _SaveAs(in Filename VARIANT, in FileFormat VARIANT, in Password VARIANT, in WriteResPassword VARIANT, in ReadOnlyRecommended VARIANT, in CreateBackup VARIANT, in AccessMode XlSaveAsAccessMode, [in ConflictResolution VARIANT], [in AddToMru VARIANT], [in TextCodepage VARIANT], [in TextVisualLayout VARIANT], [in Local VARIANT])
Property Get EnableAutoRecover as VARIANT_BOOL
Property Let EnableAutoRecover(in Value VARIANT_BOOL)
Property Get RemovePersonalInformation as VARIANT_BOOL
Property Let RemovePersonalInformation(in Value VARIANT_BOOL)
Property Get FullNameURLEncoded as String
Sub CheckIn([in SaveChanges VARIANT], [in Comments VARIANT], [in MakePublic VARIANT])
Function CanCheckIn as VARIANT_BOOL
Sub SendForReview([in Recipients VARIANT], [in Subject VARIANT], [in ShowMessage VARIANT], [in IncludeAttachment VARIANT])
Sub ReplyWithChanges([in ShowMessage VARIANT])
Sub EndReview
Property Get Password as String
Property Let Password(in Value String)
Property Get WritePassword as String
Property Let WritePassword(in Value String)
Property Get PasswordEncryptionProvider as String
Property Get PasswordEncryptionAlgorithm as String
Property Get PasswordEncryptionKeyLength as Long
Sub SetPasswordEncryptionOptions([in PasswordEncryptionProvider VARIANT], [in PasswordEncryptionAlgorithm VARIANT], [in PasswordEncryptionKeyLength VARIANT], [in PasswordEncryptionFileProperties VARIANT])
Property Get PasswordEncryptionFileProperties as VARIANT_BOOL
Property Get ReadOnlyRecommended as VARIANT_BOOL
Property Let ReadOnlyRecommended(in Value VARIANT_BOOL)
Sub Protect([in Password VARIANT], [in Structure VARIANT], [in Windows VARIANT])
Property Get SmartTagOptions as *SmartTagOptions
Sub RecheckSmartTags
Property Get Permission as *Permission
Property Get SharedWorkspace as *SharedWorkspace
Property Get Sync as *Sync
Sub SendFaxOverInternet([in Recipients VARIANT], [in Subject VARIANT], [in ShowMessage VARIANT])
Property Get XmlNamespaces as *XmlNamespaces
Property Get XmlMaps as *XmlMaps
Function XmlImport(in Url String, out ImportMap **XmlMap, [in Overwrite VARIANT], [in Destination VARIANT]) as XlXmlImportResult
Property Get SmartDocument as *SmartDocument
Property Get DocumentLibraryVersions as *DocumentLibraryVersions
Property Get InactiveListBorderVisible as VARIANT_BOOL
Property Let InactiveListBorderVisible(in Value VARIANT_BOOL)
Property Get DisplayInkComments as VARIANT_BOOL
Property Let DisplayInkComments(in Value VARIANT_BOOL)
Function XmlImportXml(in Data String, out ImportMap **XmlMap, [in Overwrite VARIANT], [in Destination VARIANT]) as XlXmlImportResult
Sub SaveAsXMLData(in Filename String, in Map *XmlMap)
Sub ToggleFormsDesign
Property Get ContentTypeProperties as *MetaProperties
Property Get Connections as *Connections
Sub RemoveDocumentInformation(in RemoveDocInfoType XlRemoveDocInfoType)
Property Get Signatures as *SignatureSet
Sub CheckInWithVersion([in SaveChanges VARIANT], [in Comments VARIANT], [in MakePublic VARIANT], [in VersionType VARIANT])
Property Get ServerPolicy as *ServerPolicy
Sub LockServerFile
Property Get DocumentInspectors as *DocumentInspectors
Function GetWorkflowTasks as *WorkflowTasks
Function GetWorkflowTemplates as *WorkflowTemplates
Sub PrintOut([in From VARIANT], [in To VARIANT], [in Copies VARIANT], [in Preview VARIANT], [in ActivePrinter VARIANT], [in PrintToFile VARIANT], [in Collate VARIANT], [in PrToFileName VARIANT], [in IgnorePrintAreas VARIANT])
Property Get ServerViewableItems as *ServerViewableItems
Property Get TableStyles as *TableStyles
Property Get DefaultTableStyle as VARIANT
Property Let DefaultTableStyle(in Value VARIANT)
Property Get DefaultPivotTableStyle as VARIANT
Property Let DefaultPivotTableStyle(in Value VARIANT)
Property Get CheckCompatibility as VARIANT_BOOL
Property Let CheckCompatibility(in Value VARIANT_BOOL)
Property Get HasVBProject as VARIANT_BOOL
Property Get CustomXMLParts as *CustomXMLParts
Property Get Final as VARIANT_BOOL
Property Let Final(in Value VARIANT_BOOL)
Property Get Research as *Research
Property Get Theme as *OfficeTheme
Sub ApplyTheme(in Filename String)
Property Get Excel8CompatibilityMode as VARIANT_BOOL
Property Get ConnectionsDisabled as VARIANT_BOOL
Sub EnableConnections
Property Get ShowPivotChartActiveFields as VARIANT_BOOL
Property Let ShowPivotChartActiveFields(in Value VARIANT_BOOL)
Sub _ExportAsFixedFormat(in Type XlFixedFormatType, [in Filename VARIANT], [in Quality VARIANT], [in IncludeDocProperties VARIANT], [in IgnorePrintAreas VARIANT], [in From VARIANT], [in To VARIANT], [in OpenAfterPublish VARIANT], [in FixedFormatExtClassPtr VARIANT])
Property Get IconSets as *IconSets
Property Get EncryptionProvider as String
Property Let EncryptionProvider(in Value String)
Property Get DoNotPromptForConvert as VARIANT_BOOL
Property Let DoNotPromptForConvert(in Value VARIANT_BOOL)
Property Get ForceFullCalculation as VARIANT_BOOL
Property Let ForceFullCalculation(in Value VARIANT_BOOL)
Sub ProtectSharing([in Filename VARIANT], [in Password VARIANT], [in WriteResPassword VARIANT], [in ReadOnlyRecommended VARIANT], [in CreateBackup VARIANT], [in SharingPassword VARIANT], [in FileFormat VARIANT])
Property Get SlicerCaches as *SlicerCaches
Property Get ActiveSlicer as *Slicer
Property Get DefaultSlicerStyle as VARIANT
Property Let DefaultSlicerStyle(in Value VARIANT)
Sub Dummy26
Sub Dummy27
Property Get AccuracyVersion as Long
Property Let AccuracyVersion(in Value Long)
Property Get CaseSensitive as VARIANT_BOOL
Property Get UseWholeCellCriteria as VARIANT_BOOL
Property Get UseWildcards as VARIANT_BOOL
Property Get PivotTables as IDispatch*
Property Get Model as *Model
Property Get ChartDataPointTrack as VARIANT_BOOL
Property Let ChartDataPointTrack(in Value VARIANT_BOOL)
Property Get DefaultTimelineStyle as VARIANT
Property Let DefaultTimelineStyle(in Value VARIANT)
Property Get Queries as *Queries
Sub CreateForecastSheet(in Timeline *Range, in Values *Range, [in ForecastStart VARIANT], [in ForecastEnd VARIANT], [in ConfInt VARIANT], [in Seasonality VARIANT], [in DataCompletion VARIANT], [in Aggregation VARIANT], [in ChartType VARIANT], [in ShowStatsTable VARIANT])
Property Get WorkIdentity as String
Property Let WorkIdentity(in Value String)
Sub SaveAs(in Filename VARIANT, in FileFormat VARIANT, in Password VARIANT, in WriteResPassword VARIANT, in ReadOnlyRecommended VARIANT, in CreateBackup VARIANT, in AccessMode XlSaveAsAccessMode, [in ConflictResolution VARIANT], [in AddToMru VARIANT], [in TextCodepage VARIANT], [in TextVisualLayout VARIANT], [in Local VARIANT], [in WorkIdentity VARIANT])
Sub ExportAsFixedFormat(in Type XlFixedFormatType, [in Filename VARIANT], [in Quality VARIANT], [in IncludeDocProperties VARIANT], [in IgnorePrintAreas VARIANT], [in From VARIANT], [in To VARIANT], [in OpenAfterPublish VARIANT], [in FixedFormatExtClassPtr VARIANT], [in WorkIdentity VARIANT])
Function PublishToDocs(in Title String, in DisclosureScope XlPublishToDocsDisclosureScope, [in OverwriteUrl VARIANT]) as String
Function LookUpInDocs([in Filename VARIANT]) as *PublishedDocs
Function PublishToPBI([in PublishType VARIANT], [in nameConflict VARIANT], [in bstrGroupName VARIANT]) as String
Property Get AutoSaveOn as VARIANT_BOOL
Property Let AutoSaveOn(in Value VARIANT_BOOL)
Sub ConvertComments
Property Get SensitivityLabel as *ISensitivityLabel
Property Get ExternalCodeServiceTimeout as Long
Property Let ExternalCodeServiceTimeout(in Value Long)
Property Get CompatibilityVersion as Long
Property Let CompatibilityVersion(in Value Long)
Something new: You can read the code for M2000 either reading BAS, FRM, CLS as ANSI encoding cp1253 (you choose font from VB6 editor Oprions: Courier New Greek), or now there is another folder UTF8 with all the code as UTF8 (so Greek letters displayed) to read these from github browser.
Document a$
Declare Worksheet "{00020820-0000-0000-C000-000000000046}"
alfa=param(Worksheet)
Report Type$(Worksheet)' Workbook
if len(ALFA)>1 then
For i=0 to len(alfa)-1
a$=alfa$(i!)+{
}
Next i
end if
clipboard a$
Document a$
Declare Worksheet "{00020820-0000-0000-C000-000000000046}"
alfa=param(Worksheet)
Report Type$(Worksheet)' Workbook
if len(ALFA)>1 then
For i=0 to len(alfa)-1
a$=alfa$(i!)+{
}
Next i
end if
clipboard a$
I found a new way in the back. It's like copying all this data into an area of memory.A lot of things in the type library have to be copied separately, and there is no way to read all the data directly with a structure, which is more troublesome.
Code:
For i = 1 To hlp
If IsBadCodePtr(acc) = 0 Then
CopyBytes Len(ParamDesc), VarPtr(ParamDesc), ByVal acc + 8
CopyBytes Len(TypeDesc), VarPtr(TypeDesc), ByVal acc
End If
acc = acc + 16
ttt$ = ""
retval$ = ""
If strNames(i) = "" Then strNames(i) = "Value"
If (ParamDesc.wParamFlags And PARAMFLAG_FRETVAL) = &H8 Then
retval$ = " as " + stringifyTypeDesc(TypeDesc, typeInf)
Else
If (ParamDesc.wParamFlags And PARAMFLAG_FIN) = &H1 Then ttt$ = "in "
If (ParamDesc.wParamFlags And PARAMFLAG_FOUT) = &H2 Then ttt$ = ttt$ + "out "
If i > (hlp - fncdsc.cParamsOpt) And fncdsc.cParamsOpt <> 0 Then
strName = strName + "[" + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf) + "]"
Else
If fncdsc.cParamsOpt = 0 And (ParamDesc.wParamFlags And PARAMFLAG_FOPT) > 0 Then
strName = strName + "[" + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf) + "]"
Else
strName = strName + ttt$ + strNames(i) + " " + stringifyTypeDesc(TypeDesc, typeInf)
End If
End If
If i < hlp Then strName = strName + ", "
End If
Next i
Using a principle similar to this approach, but I didn't succeed.
Code:
ITypeInfo_GetTypeAttr typeInf, pAttr
If pAttr = 0 Then Set typeInf = Nothing: Exit Function
memcpy mAttr, ByVal pAttr, Len(mAttr)
If (mAttr.wTypeFlags A
Vars
For j = 0 To mAttr.cFuncs - 1
ITypeInfo_GetFuncDesc typeInf, j, ppFuncDesc
CpyMem fncdsc, ByVal ppFuncDesc, Len(fncdsc)
acc = fncdsc.lprgelemdescParam
If you use a oleexp. TLB, I don't know if there is a way to do it without any copying of memory.
Last edited by xiaoyao; Dec 17th, 2025 at 04:51 AM.
Dynamic UDT TypeLibs
Reply With Quote
Originally Posted by The trick
Re: Dynamic UDT TypeLibs
Re: Dynamic UDT TypeLibs
(and that's not a bad thing, human memory needs constant refreshing!)
