COM の Typelib 情報をダンプするスクリプト

dumpTypelib.vbs

'
'   Dump COM Type Library Information
'
'   Usage:
'     cscript dumpTypelib.vbs /target:(target exe/dll/ocx name)
'
'   Example:
'     cscript //nologo dumpTypelib.vbs /target:c:\Windows\SysWOW64\TLBINF32.dll
'
target = WScript.Arguments.Named("target")
Main(target)

sub Main(target)
    set tlb = CreateObject("TLI.TypeLibInfo")

    WScript.Echo("[Typelib]")

    tlb.ContainingFile = target
    WScript.Echo(vbTab & "Name=" & tlb.Name)
    WScript.Echo(vbTab & "HelpString=" & tlb.HelpString)
    WScript.Echo(vbTab & "GUID=" & tlb.Guid)
    WScript.Echo(vbTab & "Version=" & tlb.MajorVersion & "." & tlb.MinorVersion)

    WScript.Echo("[TypeInfos]")
    for each inf in tlb.TypeInfos
        WScript.Echo(vbTab & "[" & inf.TypeKindString & "]" & inf.Name &  "  " & inf.Guid ) 
        if inf.TypeKindString = "coclass" then
            WScript.Echo(vbTab & vbTab & "DefaultInterface=" & inf.DefaultInterface.Name)
        else
            if inf.TypeKindString <> "alias" then
                EnumMembers(inf)
            end if
        End If
    Next
end sub

sub EnumMembers(info)
    for each member in info.Members
        if member.DescKind = 1 then ' member is func
            WScript.Echo( _
                        vbTab & vbTab & _
                        "(" & invokeKind(member.InvokeKind) & ") " & _
                        member.Name & _
                        ParseParams(member) & _
                        " as " &  VBTypeName(member.ReturnType) _
                    )
        else
            WScript.Echo(vbTab & vbTab & member.Name)
        end if
    Next
end sub

function InvokeKind(kind)

    if kind and 32 then 'const
        InvokeKind = "Const"
        exit function
    end if

    select case kind
        case 16:            InvokeKind = "Event"
        case 1:             InvokeKind = "Method"
        case 2:             InvokeKind = "Property Get"
        case 4:             InvokeKind = "Property Let"
        case 8:             InvokeKind = "Property Set"
        case (4 or 2):      InvokeKind = "Property Get/Let"
        case (8 or 2):      InvokeKind = "Property Get/Set"
        case (2 or 4 or 8): InvokeKind = "Property Get/Let/Set"
        case else:          InvokeKind = "Unknown"
    end select

end function

function ParseParams(member)
    res = "("
    for each param in member.Parameters
        if len(res) > 1 then
            res = res & ", "
        end if
        if param.Default or param.Optional then
            res = res & "Optional "
        end if 
        res = res & param.Name & " as " & VBTypeName(param.VarTypeInfo)
        if param.Default then
            res = res & " = """ & param.DefaultValue & """"
        end if
    next
    res = res & ")" 
    ParseParams = res
end function

function VBTypeName(anyType)
    with anyType
        vt = .VarType
        if vt and &h2000 then 'array
            VBTypeName = "Array of "
        elseif vt and &h1000 then '
            VBTypeName = "Fixed size array of "
        end if

        vtBase = vt and not (&h2000 or &h1000)

        if vtBase then
            VBTypeName = VBTypeName & TypeName(.TypedVariant)
        else
            on error resume next
            VBTypeName = VBTypeName & .TypeInfo.Name
            if Err then
                VBTypeName = VBTypeName & "<Unregistered External Type>"
            end if
            on error goto 0
        end if
    end with
end function


' vim: sw=4 ts=4