Option Explicit

Public Function GetInterfaces(ByVal module As String) As String
    Dim typeinfos As typeinfos
    Dim typeinfo As typeinfo
    Dim interfaceinfo As interfaceinfo
    Dim ti As TypeLibInfo
    
    ' Type Library ffnen:
    Set ti = TypeLibInfoFromFile(module)
    Set typeinfos = ti.typeinfos
    For Each typeinfo In typeinfos
        ' eine Klasseninformation?
        If typeinfo.TypeKind = 5 Then
            ' ja, auslesen:
            For Each interfaceinfo In typeinfo.Interfaces
                ' Objekte auslesen:
                GetInterfaces = GetInterfaces & interfaceinfo.Name & vbCrLf
            Next
        End If
    Next
End Function

Public Function GetTypeInfos(ByVal module As String) As String
    Dim typeinfos As typeinfos
    Dim typeinfo As typeinfo
    Dim TypeLibInfo As TypeLibInfo
    
    ' type Library ffen:
    Set TypeLibInfo = TypeLibInfoFromFile(module)
    
    ' Module auslesen:
    Set typeinfos = TypeLibInfo.typeinfos
    For Each typeinfo In typeinfos
        GetTypeInfos = GetTypeInfos & typeinfo.Name & vbCrLf
    Next
End Function


Public Function EnumInterface(ByVal module As String, ByVal interface As String, Optional ByVal infotype As Long = 239) As String
    Dim ti As TypeLibInfo
    Dim ik As InvokeKinds
    Dim SearchData As Long
    Dim SIMember As SearchItem
    Dim SearchResult As SearchResults
    Dim reference As String
    
    ' Type Library ffnen:
    Set ti = TypeLibInfoFromFile(module)
    
    ' Suchkriterien definieren
    Call ti.ResetSearchCriteria(TYPEFLAG_FRESTRICTED, False, True)
    Call ti.SetMemberFilters(FUNCFLAG_FRESTRICTED Or FUNCFLAG_FNONBROWSABLE, VARFLAG_FRESTRICTED Or VARFLAG_FNONBROWSABLE)

    On Error Resume Next
    SearchData = ti.MakeSearchData(interface, infotype)
    If Not Err.Number = 0 Then
        Err.Clear
        Exit Function
    End If
    
    ' Ergebnis auslesen:
    Set SearchResult = ti.GetMembers(SearchData, True)
    For Each SIMember In SearchResult
        ik = SIMember.InvokeKinds
        ' Detailinformation auslesen:
        EnumInterface = EnumInterface & DecodeMember(ti, SearchData, SIMember.InvokeKinds, SIMember.Name, reference) & vbCrLf
    Next
    
End Function


Private Function DecodeMember(TLInf As TypeLibInfo, ByVal SearchData As Long, ByVal InvokeKinds As InvokeKinds, ByVal MemberName As String, ByRef refinfo As String) As String
    Dim pi As ParameterInfo
    Dim komma As String
    Dim fIsConstant As Boolean
    Dim retVal As String

    With TLInf
        ' eine Konstante?
        fIsConstant = GetSearchType(SearchData) And tliStConstants
    
        With .GetMemberInfo(SearchData, InvokeKinds, -1, MemberName)
            ' Art des Eintrags ermitteln:
            If fIsConstant Then
                retVal = "Const "
            ElseIf InvokeKinds = INVOKE_FUNC Or InvokeKinds = INVOKE_EVENTFUNC Then
                Select Case .ReturnType.VarType
                    Case VT_VOID, VT_HRESULT
                        retVal = "Sub "
                    Case Else
                        retVal = "Function "
                End Select
            Else
                retVal = "Property "
            End If
        
            ' Name des Eintrags:
            retVal = retVal & .Name
                
            With .Parameters
                ' gibt es Argumente?
                If .Count Then
                    retVal = retVal & "("
                    komma = ""
                    For Each pi In .Me
                        retVal = retVal & komma & pi.Name
                        komma = ","
                    Next
                    retVal = retVal & ")"
                End If
            End With
        
            ' eine Konstante? Vordefinierten Wert ermitteln:
            If fIsConstant Then retVal = retVal & " = " & .Value
            
            ' gibt es eine Dokumentation?
            If Len(.HelpString) = 0 Then
                DecodeMember = retVal & vbTab
            Else
                DecodeMember = retVal & vbTab & "(" & .HelpString & ")"
            End If
        End With
    End With
End Function

Private Function GetSearchType(ByVal SearchData As Long) As TliSearchTypes
    If SearchData And &H80000000 Then
        GetSearchType = ((SearchData And &H7FFFFFFF) \ &H1000000 And &H7F&) Or &H80
    Else
        GetSearchType = SearchData \ &H1000000 And &HFF&
    End If
End Function

