UDTs to Variants without a TypeLib File

[Elroy]

I added "File" to the subject. If we create a "dynamic" typelib, that'd be fine.

Ok, I've got this "sort of" working with some code written by Olaf (provided here). But The Trick is suggesting it can be done even more easily, just suggesting the following:

Windows aready has the ability to build IRecordInfo:

Option Explicit

Private Declare Sub memcpy Lib "kernel32" _
                    Alias "RtlMoveMemory" ( _
                    ByRef Destination As Any, _
                    ByRef Source As Any, _
                    ByVal Length As Long)
Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" _
                         Alias "__vbaObjSetAddref" ( _
                         ByRef dstObject As Any, _
                         ByRef srcObjPtr As Any) As Long
                        
Private Sub Form_Load()
    Dim cCreateTLB  As ICreateTypeLib
    Dim cCreateType As ICreateTypeInfo
    Dim cTLB        As ITypeLib
    Dim cInfo       As IRecordInfo
    Dim tVarDesc    As VARDESC
    Dim tGUID       As UUID
    Dim vUDT        As Variant
    Dim cCol        As New Collection
    
    Set cCreateTLB = CreateTypeLib2(SYS_WIN32, "temp")              ' // Create a library
    
    cCreateTLB.CreateTypeInfo "POINT", TKIND_RECORD, cCreateType    ' // Create POINT type

    tVarDesc.elemdescVar.tdesc.vt = VT_I4                           ' // Long type
    
    tVarDesc.memid = &H40000000
    cCreateType.AddVarDesc 0, tVarDesc                              ' // x field
    cCreateType.SetVarName 0, "x"
    tVarDesc.memid = &H40000001
    cCreateType.AddVarDesc 1, tVarDesc                              ' // y field
    cCreateType.SetVarName 1, "y"
    
    CoCreateGuid tGUID
    
    cCreateType.SetGuid tGUID                                       ' // Set UUID
    cCreateTLB.SaveAllChanges
    
    Set cTLB = cCreateTLB
    Set cInfo = GetRecordInfoFromTypeInfo(cTLB.GetTypeInfo(0))      ' // Get IRecordInfo

    vUDT = MakePoint(cInfo)
    
    vUDT.x = 5
    vUDT.y = 10
    
    cCol.Add vUDT
    
End Sub

Private Function MakePoint( _
                 ByVal cRI As IRecordInfo) As Variant
    Dim lData(3)    As Long
    
    lData(0) = VT_RECORD
    lData(2) = cRI.RecordCreate
    vbaObjSetAddref lData(3), ByVal ObjPtr(cRI)
    memcpy ByVal VarPtr(MakePoint), lData(0), 16
    
End Function

But Trick, you can be such a tease sometimes. I searched all over for definitions of things like CreateTypeLib2 and some of the other things seen in there, with no success.

I started this thread, hoping you might elaborate.

Sorry if I'm cargo-culting, but I've got no clue as to how to get started. I thought of pasting in some of the structures I've got from Olaf's code, but that seems like a wild-goose-chase. And I've still got no reference for that CreateTypeLib2 call. Is it a Windows API call you've declared with a few Optional arguments?

I'll continue reading the MSDN on IRecordInfo.

[Joe Caverly]

CreateTypeLib2 function (oleauto.h)

I found examples of CreateTypeLib2 in the code for Matt Curland's book
"Advanced Visual Basic 6"

On my system, under Project -> References
OLEEXP - Modern Shell Interfaces for VB6, v5.1

...which contains ICreateTypeLib and others.

Joe

[Elroy]

CreateTypeLib2 function (oleauto.h)

I found examples of CreateTypeLib2 in the code for Matt Curland's book
"Advanced Visual Basic 6"

On my system, under Project -> References
OLEEXP - Modern Shell Interfaces for VB6, v5.1

...which contains ICreateTypeLib and others.

Joe

Yeah, I found that too, but Trick has built a wrapper around it so that it returns a ICreateTypeLib interface.

[VanGoghGaming]

There's no wrapper, just add a reference to OLEEXP and the code runs correctly, the variant is created and added to the collection.

[Joe Caverly]

Indeed, works as you said.

Attachment 186877

Joe

[loquat]

Private Declare Function CreateTypeLib Lib "oleaut32" (ByVal StrSrc As Long, ByVal Path As Long, a As ICreateTypeLib) As Long
'Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
Private Declare Function CoCreateGuid Lib "ole32" (id As Any) As Long
Private Declare Function IIDFromString Lib "ole32.dll" (ByVal pstCls As Long, clsid As UUID) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal pstCls As Long, clsid As UUID) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Dim pCreateTypeLib As ICreateTypeLib
Dim pTypeLib As ITypeLib
Dim InterfaceTypeInfo As ICreateTypeInfo
Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"

Function CreateTLb(FileName As String, Optional RIID As String = "") As ICreateTypeLib
    Dim IID As UUID
    IID = StringToIID(RIID)
    CreateTypeLib SYS_WIN32, StrPtr(FileName), pCreateTypeLib  '创建类库
    Set pTypeLib = pCreateTypeLib
    pCreateTypeLib.SetGuid IID
    
End Function

Function CreateTypeInfo(TypeInfoName As String, Kind As TypeKind, Optional RIID As String = "") As ICreateTypeInfo
    Dim IID As UUID
    IID = StringToIID(RIID)
    pCreateTypeLib.CreateTypeInfo TypeInfoName, Kind, CreateTypeInfo
    Set pTypeLib = pCreateTypeLib
    CreateTypeInfo.SetGuid IID
End Function

'Private Sub Command1_Click()
'
'    Dim pCreateTypeLib As ICreateTypeLib            '创建类库
'    Dim pTypeLib As ITypeLib                        '类库
'
'    Dim ModuleTypeInfo As ICreateTypeInfo           '模块
'    Dim EnumTypeInfo As ICreateTypeInfo             '枚举
'    Dim InterfaceTypeInfo As ICreateTypeInfo        '接口
'    Dim DispInterfaceTypeInfo As ICreateTypeInfo    '事件接口
'    Dim ComTypeInfo As ICreateTypeInfo              '组件
'    Dim TypedefInfo As ICreateTypeInfo              '别名
'    Dim StructTypeInfo As ICreateTypeInfo           '结构体
'    Dim UnionTypeInfo As ICreateTypeInfo            '联合体
'
'    Dim IID As UUID
'    Dim Ret As Long
'
'    Call CreateTypeLib(SYS_WIN32, StrPtr("c:\tmp.tlb"), pCreateTypeLib) '创建类库
'    Set pTypeLib = pCreateTypeLib                                       '实现ICreateTypeInfo=ITypeInfo
'
'    CoCreateGuid IID                '更新GUID
'    With pCreateTypeLib             '类库设置
'        .SetName "testLib"
'        .SetVersion 1, 0
'        .SetDocString "My Tlb"
'        .SetGuid IID
'        .CreateTypeInfo "testInterface", TKIND_DISPATCH, InterfaceTypeInfo           '接口
'        .CreateTypeInfo "testDispInterface", TKIND_DISPATCH, DispInterfaceTypeInfo  'Disp接口
'        .CreateTypeInfo "User32", TKIND_MODULE, ModuleTypeInfo                      '模块
'        .CreateTypeInfo "TestEnum", TKIND_ENUM, EnumTypeInfo                        '枚举
'        .CreateTypeInfo "TestCCom", TKIND_COCLASS, ComTypeInfo                      '组件
'        .CreateTypeInfo "TestTypedef", TKIND_ALIAS, TypedefInfo                     '别名
'        .CreateTypeInfo "TestStruct", TKIND_RECORD, StructTypeInfo                  '结构体
'        .CreateTypeInfo "TestUnion", TKIND_UNION, UnionTypeInfo                     '联合体
'    End With
'
'    Dim telemdesc(4) As ELEMDESC
'    telemdesc(0) = CreateParams(VT_I4)
'    telemdesc(1) = CreateParams(VT_I4)
'    telemdesc(2) = CreateParams(VT_PTR Or VT_I4)
'    telemdesc(3) = CreateParams(VT_I4)
'
'     CoCreateGuid IID
'
'    Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
'    Dim s(4) As String
'    s(0) = "Add"
'    s(1) = "a"
'    s(2) = "b"
'    s(3) = "c"
'    s(4) = "d"
'    Const IID___Com = "{62DD544B-09E0-4340-8FF8-41CCC0FD0666}"
'    With InterfaceTypeInfo          '接口设置
'        .AddRefTypeInfo ImportInterface("C:\Windows\SysWOW64\stdole32.tlb", IID_IDispatch), Ret '设置父类
'        .AddImplType 0, Ret
'        .AddFuncDesc 0, CreateFunction(0, FUNC_DISPATCH, INVOKE_FUNC, 3, telemdesc)
'        .SetFuncAndParamNames 0, s(0), 4
'        .SetGuid StringToIID(IID___Com)
'        .SetDocString "My Interface"
'        .LayOut
'    End With
'
'    CoCreateGuid IID
'
'    With DispInterfaceTypeInfo       'Disp接口设置
'        .AddRefTypeInfo ImportInterface("C:\Windows\SysWOW64\stdole32.tlb", IID_IDispatch), Ret '设置父类
'        .AddImplType 0, Ret
'        .AddFuncDesc 0, CreateFunction(0, FUNC_DISPATCH, INVOKE_FUNC, 4, telemdesc)
'        .SetFuncAndParamNames 0, s(0), 5
'        .SetGuid IID
'        .SetDocString "My DispInterface"
'        .LayOut
'    End With
'
'    With EnumTypeInfo           'Enum接口设置
'        .AddVarDesc 0, CreateVar(1, VT_I2, VAR_CONST, 0)
'        .SetVarName 0, "test"
'        .AddVarDesc 0, CreateVar(2, VT_I2, VAR_CONST, 1)
'        .SetVarName 0, "tttt"
'        .SetDocString "My Enum"
'        .LayOut
'    End With
'
'    With ModuleTypeInfo         '模块设置
'        .SetDocString "My Module"
'        .AddFuncDesc 0, CreateFunction(222, FUNC_STATIC, INVOKE_FUNC, 4, telemdesc)
'        .SetFuncAndParamNames 0, s(0), 5
'        .DefineFuncAsDllEntry 0, "user32.DLL", "MessageBoxW"
'        .AddVarDesc 0, CreateVar(1, VT_BSTR, VAR_CONST, "fdsfdsf")
'        .SetVarName 0, "tfff"
'        .LayOut
'    End With
'
'    Dim TypeTest As TYPEDESC
'    With TypeTest
'        .vt = VT_I4
'    End With
'
'    With TypedefInfo        '别名设置
'        .SetDocString "My Typedef"
'        .SetTypeDescAlias TypeTest
'        .LayOut
'    End With
'
'    With StructTypeInfo      '结构体设置
'        .SetDocString "My Struct"
'        .AddVarDesc 0, CreateVar(1, VT_I2, VAR_PERINSTANCE)
'        .SetVarName 0, "test1"
'        .AddVarDesc 1, CreateVar(2, VT_I4, VAR_PERINSTANCE)
'        .SetVarName 1, "test2"
'        .LayOut
'    End With
'
'    With UnionTypeInfo      '联合体设置
'        .SetDocString "My Union"
'        .AddVarDesc 0, CreateVar(3, VT_I4, VAR_PERINSTANCE)
'        .SetVarName 0, "test3"
'        .AddVarDesc 1, CreateVar(4, VT_I2, VAR_PERINSTANCE)
'        .SetVarName 1, "test4"
'        .LayOut
'    End With
'
'    CoCreateGuid IID
'    Const CLSID_Com = "{920DCEED-B3DD-4110-8F2F-981A554E07FF}"
'    With ComTypeInfo        '组件设置
'        .SetDocString "My ComClass"
'        .SetGuid StringToIID(CLSID_Com)
'        .AddRefTypeInfo pTypeLib.GetTypeInfo(0), Ret  '设置子掊口
'        .AddImplType 0, Ret
'        .SetImplTypeFlags 0, IMPLTYPEFLAG_FDEFAULT   '默认 'default、dual、oleautomation、hidden、source(事件)
'
'        .AddRefTypeInfo pTypeLib.GetTypeInfo(1), Ret  '设置事件掊口
'        .AddImplType 1, Ret
'        .SetImplTypeFlags 1, IMPLTYPEFLAG_FDEFAULT Or IMPLTYPEFLAG_FSOURCE
'
'        .SetTypeFlags TYPEFLAG_FCANCREATE   '可以创建
'        .LayOut
'    End With
'
'    pCreateTypeLib.SaveAllChanges
'
'End Sub

Function CreateVar(id As Long, VarType As VARENUM, Kind As VARKIND, Optional Value As Variant) As VARDESC
    With CreateVar                          '创建变量
        .memid = id                         'ID
        .VARKIND = Kind                     '类别
        If IsMissing(Value) = False Then .oInst_varValue = VarPtr(Value)    '值
        .elemdescVar.tdesc.vt = VarType     '类型
    End With
End Function

Function CreateParams(vt As VARENUM, Optional pTypeDesc As Long) As ELEMDESC
    With CreateParams                       '创建参数
        .tdesc.vt = vt                      '类型
        .tdesc.pTypeDesc = pTypeDesc
       ' .PARAMDESC.pPARAMDESCEX = vbNull
       ' .PARAMDESC.wParamFlags = IDLFLAG_FIN
    End With
End Function

Function CreateFunction(id As Long, FUNCKIND As FUNCKIND, invkind As InvokeKind, Optional paramCount As Long = 0, Optional params As Long = 0, Optional ret As VARENUM = VT_HRESULT) As FUNCDESC
    With CreateFunction                     '创建函数
        .memid = id                         'id
        .CallConv = CC_STDCALL              '约定
        .FUNCKIND = FUNCKIND                'FUNC_PUREVIRTUAL 虚表 FUNC_DISPATCH 自动化 FUNC_STATIC静态
        .invkind = invkind                  'func get let set
        .oVft = 0
        If paramCount > 0 And params <> 0 Then
            .lprgELEMDESCParam = params   '参数
            .cParams = paramCount                   '参数个数
            .cParamsOpt = 0
        End If
        .elemdescFunc.tdesc.vt = ret        '返回值
    End With
End Function

Function ImportInterface(Optional LibPath As String = "", Optional IID As String = "{00000000-0000-0000-C000-000000000046}", Optional Index As Long = 0) As ITypeInfo
    Dim pTLibStdOle As ITypeLib, IdispatchIID As UUID
    '
    Dim ptinfoIDispatch As ITypeInfo
    If LibPath = "" Then
        Set pTLibStdOle = pTypeLib
    Else
        Set pTLibStdOle = LoadTypeLib(LibPath)
    
    End If
    If IID = "" Then
        Set ImportInterface = pTLibStdOle.GetTypeInfo(Index)
    Else
        IIDFromString StrPtr(IID), IdispatchIID
        Set ImportInterface = pTLibStdOle.GetTypeInfoOfIID(IdispatchIID)
    End If
End Function

Function StringToIID(IID As String) As UUID
    If IID = "" Then
        CoCreateGuid StringToIID
    Else
      ' IID = "{3AC9C1E3-4E49-C648-921A-F3965F389DF8}"
        CLSIDFromString StrPtr(IID), StringToIID
    End If
End Function

Sub Save()
    On Error GoTo ErrLine
    pCreateTypeLib.SaveAllChanges
ErrLine:
End Sub

Private Sub Command2_Click()
    Dim tlapp As Object ' New TLI.TLIApplication
    Dim TLb As Object ' TLI.TypeLibInfo
    Dim lib As ITypeLib
    Dim t As ITypeInfo
    Dim v As VARDESC
    Set lib = LoadTypeLib("C:\Users\Administrator\Desktop\com玩具\tlb\olelib.tlb")
    Set t = lib.GetTypeInfo(2)
    Dim l As Long
    l = t.GetVarDesc(0)
    t.GetTypeAttr
'    Dim memid As Long, rgBstrNames As String, cMaxNames As Long
'    t.GetNames  , rgBstrNames, 1
'    Dim id As Long, n As String
'    t.GetNames 1073741827, n, 1
    CopyMemory v, ByVal l, LenB(v)
    Set tlapp = CreateObject("TLI.TLIApplication")
    Set TLb = tlapp.TypeLibInfoFromFile("C:\Users\Administrator\Desktop\com玩具\tlb\olelib.tlb")
    Dim o As Object
    Dim i As Long
    For Each o In TLb.TypeInfos
        'Debug.Print o.TypeKindString
        If o.TypeKindString = "record" Then
            Debug.Print o.name, o.TypeKindString ', o.Members(8).MemberId, i
        End If
        i = i + 1
    Next
    
End Sub

Private Sub Command3_Click()
    'testFunc 0, "21321", "3213", 0
End Sub

Public Property Let TlbName(ByVal Value As String)
    pCreateTypeLib.SetName Value
End Property

Public Property Let TlbVersion(wMajorVerNum As Integer, wMinorVerNum As Integer)
    pCreateTypeLib.SetVersion wMajorVerNum, wMinorVerNum
End Property

Public Property Let TlbDocString(ByVal Value As String)
    pCreateTypeLib.SetDocString Value
End Property

[The trick]

Yeah, I found that too, but Trick has built a wrapper around it so that it returns a ICreateTypeLib interface.

As VanGoghGaming already wrote i use OLEEXP with all the definitions. ICreateTypeLib2 derives from ICreateTypeLib so you can use CreateTypeLib2. There is a bug (i'll report) with CreateTypeLib declaration in OLEEXP so i used CreateTypeLib2 instead.

[xiaoyao]

Private Declare Function CreateTypeLib Lib "oleaut32" (ByVal StrSrc As Long, ByVal Path As Long, a As ICreateTypeLib) As Long
'Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
Private Declare Function CoCreateGuid Lib "ole32" (id As Any) As Long
Private Declare Function IIDFromString Lib "ole32.dll" (ByVal pstCls As Long, clsid As UUID) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal pstCls As Long, clsid As UUID) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Dim pCreateTypeLib As ICreateTypeLib
Dim pTypeLib As ITypeLib
Dim InterfaceTypeInfo As ICreateTypeInfo
Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"

Function CreateTLb(FileName As String, Optional RIID As String = "") As ICreateTypeLib
    Dim IID As UUID
    IID = StringToIID(RIID)
    CreateTypeLib SYS_WIN32, StrPtr(FileName), pCreateTypeLib  '????
    Set pTypeLib = pCreateTypeLib
    pCreateTypeLib.SetGuid IID
    
End Function

Function CreateTypeInfo(TypeInfoName As String, Kind As TypeKind, Optional RIID As String = "") As ICreateTypeInfo
    Dim IID As UUID
    IID = StringToIID(RIID)
    pCreateTypeLib.CreateTypeInfo TypeInfoName, Kind, CreateTypeInfo
    Set pTypeLib = pCreateTypeLib
    CreateTypeInfo.SetGuid IID
End Function

'Private Sub Command1_Click()
'
'    Dim pCreateTypeLib As ICreateTypeLib            '????
'    Dim pTypeLib As ITypeLib                        '??
'
'    Dim ModuleTypeInfo As ICreateTypeInfo           '??
'    Dim EnumTypeInfo As ICreateTypeInfo             '??
'    Dim InterfaceTypeInfo As ICreateTypeInfo        '??
'    Dim DispInterfaceTypeInfo As ICreateTypeInfo    '????
'    Dim ComTypeInfo As ICreateTypeInfo              '??
'    Dim TypedefInfo As ICreateTypeInfo              '??
'    Dim StructTypeInfo As ICreateTypeInfo           '???
'    Dim UnionTypeInfo As ICreateTypeInfo            '???
'
'    Dim IID As UUID
'    Dim Ret As Long
'
'    Call CreateTypeLib(SYS_WIN32, StrPtr("c:\tmp.tlb"), pCreateTypeLib) '????
'    Set pTypeLib = pCreateTypeLib                                       '??ICreateTypeInfo=ITypeInfo
'
'    CoCreateGuid IID                '??GUID
'    With pCreateTypeLib             '????
'        .SetName "testLib"
'        .SetVersion 1, 0
'        .SetDocString "My Tlb"
'        .SetGuid IID
'        .CreateTypeInfo "testInterface", TKIND_DISPATCH, InterfaceTypeInfo           '??
'        .CreateTypeInfo "testDispInterface", TKIND_DISPATCH, DispInterfaceTypeInfo  'Disp??
'        .CreateTypeInfo "User32", TKIND_MODULE, ModuleTypeInfo                      '??
'        .CreateTypeInfo "TestEnum", TKIND_ENUM, EnumTypeInfo                        '??
'        .CreateTypeInfo "TestCCom", TKIND_COCLASS, ComTypeInfo                      '??
'        .CreateTypeInfo "TestTypedef", TKIND_ALIAS, TypedefInfo                     '??
'        .CreateTypeInfo "TestStruct", TKIND_RECORD, StructTypeInfo                  '???
'        .CreateTypeInfo "TestUnion", TKIND_UNION, UnionTypeInfo                     '???
'    End With
'
'    Dim telemdesc(4) As ELEMDESC
'    telemdesc(0) = CreateParams(VT_I4)
'    telemdesc(1) = CreateParams(VT_I4)
'    telemdesc(2) = CreateParams(VT_PTR Or VT_I4)
'    telemdesc(3) = CreateParams(VT_I4)
'
'     CoCreateGuid IID
'
'    Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
'    Dim s(4) As String
'    s(0) = "Add"
'    s(1) = "a"
'    s(2) = "b"
'    s(3) = "c"
'    s(4) = "d"
'    Const IID___Com = "{62DD544B-09E0-4340-8FF8-41CCC0FD0666}"
'    With InterfaceTypeInfo          '????
'        .AddRefTypeInfo ImportInterface("C:\Windows\SysWOW64\stdole32.tlb", IID_IDispatch), Ret '????
'        .AddImplType 0, Ret
'        .AddFuncDesc 0, CreateFunction(0, FUNC_DISPATCH, INVOKE_FUNC, 3, telemdesc)
'        .SetFuncAndParamNames 0, s(0), 4
'        .SetGuid StringToIID(IID___Com)
'        .SetDocString "My Interface"
'        .LayOut
'    End With
'
'    CoCreateGuid IID
'
'    With DispInterfaceTypeInfo       'Disp????
'        .AddRefTypeInfo ImportInterface("C:\Windows\SysWOW64\stdole32.tlb", IID_IDispatch), Ret '????
'        .AddImplType 0, Ret
'        .AddFuncDesc 0, CreateFunction(0, FUNC_DISPATCH, INVOKE_FUNC, 4, telemdesc)
'        .SetFuncAndParamNames 0, s(0), 5
'        .SetGuid IID
'        .SetDocString "My DispInterface"
'        .LayOut
'    End With
'
'    With EnumTypeInfo           'Enum????
'        .AddVarDesc 0, CreateVar(1, VT_I2, VAR_CONST, 0)
'        .SetVarName 0, "test"
'        .AddVarDesc 0, CreateVar(2, VT_I2, VAR_CONST, 1)
'        .SetVarName 0, "tttt"
'        .SetDocString "My Enum"
'        .LayOut
'    End With
'
'    With ModuleTypeInfo         '????
'        .SetDocString "My Module"
'        .AddFuncDesc 0, CreateFunction(222, FUNC_STATIC, INVOKE_FUNC, 4, telemdesc)
'        .SetFuncAndParamNames 0, s(0), 5
'        .DefineFuncAsDllEntry 0, "user32.DLL", "MessageBoxW"
'        .AddVarDesc 0, CreateVar(1, VT_BSTR, VAR_CONST, "fdsfdsf")
'        .SetVarName 0, "tfff"
'        .LayOut
'    End With
'
'    Dim TypeTest As TYPEDESC
'    With TypeTest
'        .vt = VT_I4
'    End With
'
'    With TypedefInfo        '????
'        .SetDocString "My Typedef"
'        .SetTypeDescAlias TypeTest
'        .LayOut
'    End With
'
'    With StructTypeInfo      '?????
'        .SetDocString "My Struct"
'        .AddVarDesc 0, CreateVar(1, VT_I2, VAR_PERINSTANCE)
'        .SetVarName 0, "test1"
'        .AddVarDesc 1, CreateVar(2, VT_I4, VAR_PERINSTANCE)
'        .SetVarName 1, "test2"
'        .LayOut
'    End With
'
'    With UnionTypeInfo      '?????
'        .SetDocString "My Union"
'        .AddVarDesc 0, CreateVar(3, VT_I4, VAR_PERINSTANCE)
'        .SetVarName 0, "test3"
'        .AddVarDesc 1, CreateVar(4, VT_I2, VAR_PERINSTANCE)
'        .SetVarName 1, "test4"
'        .LayOut
'    End With
'
'    CoCreateGuid IID
'    Const CLSID_Com = "{920DCEED-B3DD-4110-8F2F-981A554E07FF}"
'    With ComTypeInfo        '????
'        .SetDocString "My ComClass"
'        .SetGuid StringToIID(CLSID_Com)
'        .AddRefTypeInfo pTypeLib.GetTypeInfo(0), Ret  '?????
'        .AddImplType 0, Ret
'        .SetImplTypeFlags 0, IMPLTYPEFLAG_FDEFAULT   '?? 'default?dual?oleautomation?hidden?source(??)
'
'        .AddRefTypeInfo pTypeLib.GetTypeInfo(1), Ret  '??????
'        .AddImplType 1, Ret
'        .SetImplTypeFlags 1, IMPLTYPEFLAG_FDEFAULT Or IMPLTYPEFLAG_FSOURCE
'
'        .SetTypeFlags TYPEFLAG_FCANCREATE   '????
'        .LayOut
'    End With
'
'    pCreateTypeLib.SaveAllChanges
'
'End Sub

Function CreateVar(id As Long, VarType As VARENUM, Kind As VARKIND, Optional Value As Variant) As VARDESC
    With CreateVar                          '????
        .memid = id                         'ID
        .VARKIND = Kind                     '??
        If IsMissing(Value) = False Then .oInst_varValue = VarPtr(Value)    '?
        .elemdescVar.tdesc.vt = VarType     '??
    End With
End Function

Function CreateParams(vt As VARENUM, Optional pTypeDesc As Long) As ELEMDESC
    With CreateParams                       '????
        .tdesc.vt = vt                      '??
        .tdesc.pTypeDesc = pTypeDesc
       ' .PARAMDESC.pPARAMDESCEX = vbNull
       ' .PARAMDESC.wParamFlags = IDLFLAG_FIN
    End With
End Function

Function CreateFunction(id As Long, FUNCKIND As FUNCKIND, invkind As InvokeKind, Optional paramCount As Long = 0, Optional params As Long = 0, Optional ret As VARENUM = VT_HRESULT) As FUNCDESC
    With CreateFunction                     '????
        .memid = id                         'id
        .CallConv = CC_STDCALL              '??
        .FUNCKIND = FUNCKIND                'FUNC_PUREVIRTUAL ?? FUNC_DISPATCH ??? FUNC_STATIC??
        .invkind = invkind                  'func get let set
        .oVft = 0
        If paramCount > 0 And params <> 0 Then
            .lprgELEMDESCParam = params   '??
            .cParams = paramCount                   '????
            .cParamsOpt = 0
        End If
        .elemdescFunc.tdesc.vt = ret        '???
    End With
End Function

Function ImportInterface(Optional LibPath As String = "", Optional IID As String = "{00000000-0000-0000-C000-000000000046}", Optional Index As Long = 0) As ITypeInfo
    Dim pTLibStdOle As ITypeLib, IdispatchIID As UUID
    '
    Dim ptinfoIDispatch As ITypeInfo
    If LibPath = "" Then
        Set pTLibStdOle = pTypeLib
    Else
        Set pTLibStdOle = LoadTypeLib(LibPath)
    
    End If
    If IID = "" Then
        Set ImportInterface = pTLibStdOle.GetTypeInfo(Index)
    Else
        IIDFromString StrPtr(IID), IdispatchIID
        Set ImportInterface = pTLibStdOle.GetTypeInfoOfIID(IdispatchIID)
    End If
End Function

Function StringToIID(IID As String) As UUID
    If IID = "" Then
        CoCreateGuid StringToIID
    Else
      ' IID = "{3AC9C1E3-4E49-C648-921A-F3965F389DF8}"
        CLSIDFromString StrPtr(IID), StringToIID
    End If
End Function

Sub Save()
    On Error GoTo ErrLine
    pCreateTypeLib.SaveAllChanges
ErrLine:
End Sub

Private Sub Command2_Click()
    Dim tlapp As Object ' New TLI.TLIApplication
    Dim TLb As Object ' TLI.TypeLibInfo
    Dim lib As ITypeLib
    Dim t As ITypeInfo
    Dim v As VARDESC
    Set lib = LoadTypeLib("C:\Users\Administrator\Desktop\com??\tlb\olelib.tlb")
    Set t = lib.GetTypeInfo(2)
    Dim l As Long
    l = t.GetVarDesc(0)
    t.GetTypeAttr
'    Dim memid As Long, rgBstrNames As String, cMaxNames As Long
'    t.GetNames  , rgBstrNames, 1
'    Dim id As Long, n As String
'    t.GetNames 1073741827, n, 1
    CopyMemory v, ByVal l, LenB(v)
    Set tlapp = CreateObject("TLI.TLIApplication")
    Set TLb = tlapp.TypeLibInfoFromFile("C:\Users\Administrator\Desktop\com??\tlb\olelib.tlb")
    Dim o As Object
    Dim i As Long
    For Each o In TLb.TypeInfos
        'Debug.Print o.TypeKindString
        If o.TypeKindString = "record" Then
            Debug.Print o.name, o.TypeKindString ', o.Members(8).MemberId, i
        End If
        i = i + 1
    Next
    
End Sub

Private Sub Command3_Click()
    'testFunc 0, "21321", "3213", 0
End Sub

Public Property Let TlbName(ByVal Value As String)
    pCreateTypeLib.SetName Value
End Property

Public Property Let TlbVersion(wMajorVerNum As Integer, wMinorVerNum As Integer)
    pCreateTypeLib.SetVersion wMajorVerNum, wMinorVerNum
End Property

Public Property Let TlbDocString(ByVal Value As String)
    pCreateTypeLib.SetDocString Value
End Property

can you give me a sample for :make win32api.tlb
like :findwindow,sendmessage?
Call CreateTypeLib(SYS_WIN32, StrPtr("c:\tmp.tlb"), pCreateTypeLib)