Binaryworld - A command-line Object Browser that uses Reflection ... [ VB.net -> Classes & Objects ]

' This code is taken from Francesco Balena's
' "Programming Microsoft Visual Basic .NET" - MS Press 2002, ISBN 0735613753
' You can read a free chapter of the book at
' http://www.vb2themax.com/HtmlDoc.asp?Table=Books&ID=101000

Imports System.Reflection

Module MainModule

  Sub Main()
    ' Get command-line arguments.
    Dim args() As String = Environment.GetCommandLineArgs()
    Dim cmd As String = Environment.CommandLine
    Dim ty As Type
    Dim mbrTypes As MemberTypes = MemberTypes.All
    Dim mbrName As String = ""
    Dim mi As MemberInfo

    ' If no arguments, /? or /help
    If args.Length <= 1 OrElse args(1) = "/?" OrElse String.Compare(args(1), _
      "/help", True) = 0 Then
      ' Show command-line syntax and exit.
      Console.WriteLine("Command-line Type Browser - by Francesco Balena")
      Console.WriteLine(" Syntax: typebrow typename [membername[*]]")
      Exit Sub
    End If

    Dim i As Integer = args(1).IndexOf(","c)
    If i < 0 Then
      ' Create the type as specified by first argument.
      ty = Type.GetType(args(1), False, True)
    Else
      ' Create the assembly specified in the last part of the first
      ' argument
      Dim asmname As String = args(1).Substring(i + 1)
      Dim asm As [Assembly] = [Assembly].LoadWithPartialName(asmname)
      ' Get the type in the specified assembly.
      ty = asm.GetType(args(1).Substring(0, i), False, True)
    End If

    If ty Is Nothing Then
      ' Exit if error.
      Console.WriteLine("Unable to create type ""{0}""", args(1))
      Exit Sub
    End If

    ' If the user asked for a particular name.
    If args.Length > 2 Then
      ' Retrieve the name
      mbrName = args(2)
    End If

    ' Get the list of member info to be displayed
    Dim minfos() As MemberInfo = ty.FindMembers(mbrTypes, _
      BindingFlags.Public Or BindingFlags.Instance Or BindingFlags.Static, _
      AddressOf CustomMemberFilter, mbrName)

    ' Display information on all these members.
    For Each mi In minfos
      Console.WriteLine(MemberDescription(mi))
    Next
  End Sub

  ' This is the custom filter for members.
  ' On entry filterCriteria holds the name of the member we're looking for.
  ' (Supports partial names with a trailing asterisk, as in "Repl*".)
  Function CustomMemberFilter(ByVal m As MemberInfo, _
    ByVal filterCriteria As Object) As Boolean
    ' Discard accessor methods for properties.
    If m.Name.StartsWith("get_") Or m.Name.StartsWith("set_") Then
      Return False
    End If

    ' Get the search filter in uppercase.
    Dim search As String = filterCriteria.ToString.ToUpper
    If search = "" Then Return True

    If search.EndsWith("*") Then
      ' If there is a trailing asterisk, checks for partial match.
      If m.Name.ToUpper.StartsWith(search.Substring(0, _
        search.Length - 1)) Then Return True
    Else
      ' Otherwise search for exact match.
      If m.Name.ToUpper = search Then Return True
    End If
  End Function

  ' Return the syntax for a member (field, property, methods, event).
  Function MemberDescription(ByVal mi As MemberInfo) As String
    Dim res As String

    ' Different treatment for different types
    Select Case mi.MemberType
      Case MemberTypes.Field
        ' Fields: append As clause.
        Dim fdi As FieldInfo = CType(mi, FieldInfo)
        res &= NameDescription(mi, fdi.IsStatic) & VBTypeDescription _
          (fdi.FieldType)

      Case MemberTypes.Property
        ' Properties: append parameter list and return type.
        Dim pri As PropertyInfo = CType(mi, PropertyInfo)
        res &= NameDescription(mi, False) & ParamListDescription _
          (pri.GetIndexParameters)
        res &= VBTypeDescription(pri.PropertyType)

      Case MemberTypes.Method
        ' Methods: append parameter list and return type.
        Dim mti As MethodInfo = CType(mi, MethodInfo)
        res &= NameDescription(mi, mti.IsStatic) & ParamListDescription _
          (mti.GetParameters)
        If Not (mti.ReturnType Is Nothing) Then
          res &= VBTypeDescription(mti.ReturnType, True)
        End If

      Case MemberTypes.Constructor
        ' Constructor
        Dim cti As ConstructorInfo = CType(mi, ConstructorInfo)
        res &= NameDescription(mi, False) & ParamListDescription _
          (cti.GetParameters)

      Case MemberTypes.Event
        ' Events: append parameter list.
        Dim evi As EventInfo = CType(mi, EventInfo)
        ' Get the type that corresponds to the underlying delegate.
        Dim delType As Type = evi.EventHandlerType
        Dim mi2 As MethodInfo = delType.GetMethod("Invoke")
        res &= NameDescription(mi, False) & ParamListDescription _
          (mi2.GetParameters)
    End Select

    Return res
  End Function

  ' Return a description for name.
  ' (Including Shared and member type description.)
  Function NameDescription(ByVal mi As MemberInfo, ByVal IsStatic As Boolean) _
    As String
    Dim res As String

    ' Prefix with Shared if necessary
    If IsStatic Then
      res = "Shared "
    End If

    ' Append member type, but distinguish between Sub and Function
    If mi.MemberType <> MemberTypes.Method Then
      ' if not a method, we can simply use the Enum.Format method.
      res &= [Enum].Format(mi.MemberType.GetType, mi.MemberType, _
        "G") & " "
    Else
      Dim meth As MethodInfo = CType(mi, MethodInfo)
      If meth.ReturnType.Name = "Void" Then
        res &= "Sub "
      Else
        res &= "Function "
      End If
    End If

    ' Append name and return to caller.
    If mi.MemberType = MemberTypes.Constructor Then
      ' Visual Basic constructors are named "new"
      res &= "New"
    Else
      ' A non-constructor element.
      res &= mi.Name
    End If

    Return res
  End Function

  ' Return the description for a list of parameters.
  Function ParamListDescription(ByVal pinfos() As ParameterInfo) As String
    Dim res As String = "("
    Dim i As Integer

    ' Iterate over all parameters.
    For i = 0 To pinfos.GetUpperBound(0)
      ' Append description for this parameter.
      res &= ParamDescription(pinfos(i))
      ' Append a comma if this isn't the last argument.
      If i < pinfos.GetUpperBound(0) Then res &= ", "
    Next
    ' Close the parenthesis and return to caller.
    Return res & ")"
  End Function

  ' Return a description for a single parameter.
  Function ParamDescription(ByVal pi As ParameterInfo) As String
    Dim res As String
    Dim pt As Type = pi.ParameterType

    ' Start with Optional if necessary.
    If pi.IsOptional Then res = "Optional "

    ' Append ByVal or ByRef.
    If pt.IsByRef Then
      res &= "ByRef "
    Else
      res &= "ByVal "
    End If

    ' Append the parameter name.
    res &= pi.Name
    ' Append the type, but convert it to VB syntax.
    res &= VBTypeDescription(pt)

    ' Append the default value, if there is one.
    If pi.IsOptional Then
      ' Enclose the default value within quotes if it is a string.
      If pt Is GetType(System.String) Then
        res &= " = """ & pi.DefaultValue.ToString & """"
      Else
        res &= " = " & pi.DefaultValue.ToString
      End If
    End If

    ' Return to the caller.
    Return res
  End Function

  ' Return a parameter type in VB-friendly format.
  Function VBTypeDescription(ByVal ty As Type, _
    Optional ByVal PostfixArrayMarks As Boolean = False) As String
    Dim res As String

    ' Get the return type as a string.
    res &= ty.Name
    ' Drop trailing "[]" pair, is there is one.
    If res.EndsWith("[]") Then
      res = res.Substring(0, res.Length - 2)
    End If
    ' Drop trailing *, if there is one.
    If res.EndsWith("*") Then
      res = res.Substring(0, res.Length - 1)
    End If

    ' Adjust for VB-friendly names.
    Select Case res
      Case "Int16"
        res = "Short"
      Case "Int32"
        res = "Integer"
      Case "Int64"
        res = "Long"
      Case "Void"
        ' this is the type "returned" by Sub
        Return ""
    End Select

    ' Append "AS" and "()" if this is an array.
    If Not ty.IsArray Then
      res = " As " & res
    ElseIf PostfixArrayMarks Then
      ' Append trailing () pair.
      res = " As " & res & "()"
    Else
      ' Prefix leading () pair.
      res = "() As " & res
    End If

    ' Return to the caller.
    Return res
  End Function

End Module