Как сделать TLB

'mMain.bas из проекта CreateTypeLib.vbp
Option Explicit
 
Private Declare Function CreateTypeLib Lib "oleaut32" (ByVal StrSrc As Long, ByVal path As Long, a As Any) As Long
Private Declare Function CoCreateGuid Lib "ole32" (IID_TYPELIB As Any) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal pstCls As Long, clsid As UUID) As Long
 
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
 
Sub Main()
    Dim hRef As Long
    Dim TypeLib As ICreateTypeLib
    Dim TypeInfo As ICreateTypeInfo
    Dim ComTypeInfo As ICreateTypeInfo
 
    Dim ptlibStdOle As ITypeLib
    Dim ptinfoIDispatch As ITypeInfo
    
    Dim IID_TYPELIB As UUID
    Dim IID_TYPEINFO As UUID
    Dim IID_DISPATCH As UUID
    
    Dim oFunc As FUNCDESC
    Dim oElement As ELEMDESC
    
    CoCreateGuid IID_TYPELIB
    CoCreateGuid IID_TYPEINFO
 
    CreateTypeLib SYS_WIN32, StrPtr("c:\a.tlb"), TypeLib
    
    With TypeLib
        .SetName "testlib"
        .SetVersion 1, 0
        .SetDocString "My Tlb"
        .SetGuid IID_TYPELIB
        .CreateTypeInfo "TestCCom", TKIND_COCLASS, ComTypeInfo
        .CreateTypeInfo "testInterface", TKIND_INTERFACE, TypeInfo
    End With
    
    With oElement
        .tdesc.vt = VT_BSTR
        .idlddesc.dwReserved = vbNull
        .idlddesc.wIDLFlags = IDLFLAG_FIN
    End With
    With oFunc
        .memid = 0
        .callconv = CC_STDCALL
        .FUNCKIND = FUNC_PUREVIRTUAL
        .invkind = INVOKE_FUNC
        .oVft = 0
        .lprgELEMDESCParam = VarPtr(oElement)
        .cParams = 1
        .cParamsOpt = 0
        .elemdescFunc.tdesc.vt = VT_HRESULT
    End With
    
    Set ptlibStdOle = LoadTypeLib("C:\Windows\SysWOW64\stdole32.tlb")
    IIDFromString StrPtr(IID_IDispatch), IID_DISPATCH
    Set ptinfoIDispatch = ptlibStdOle.GetTypeInfoOfIID(IID_DISPATCH)
    With TypeInfo
        '.SetImplTypeFlags(0, IMPLTYPEFLAG_FDEFAULT or IMPLTYPEFLAG_FSOURCE)
        .AddRefTypeInfo ptinfoIDispatch, hRef
        .AddImplType 0, hRef
        .AddFuncDesc 0, oFunc
        Dim s(1) As String
        s(0) = "testFunc"
        s(1) = "s"
        .SetFuncAndParamNames 0, s(0), 2
        .SetGuid IID_TYPEINFO
        .SetDocString "myInterface"
        .LayOut
    End With
 
    With ComTypeInfo
        '.AddRefTypeInfo TypeInfo, hRef   'can not run through
        '.AddImplType 0, hRef
        .SetTypeFlags (TYPEFLAG_FCANCREATE)
        .LayOut
    End With
    TypeLib.SaveAllChanges
    MsgBox "tlb create ok!", , ""
End Sub