Home All Groups Group Topic Archive Search About

A Class to get the name of Enum constant at runtime

Author
8 Oct 2005 10:47 PM
adaway
Today I writed some code for getting the name of an enumeration at
runtime.
I wrote a simple function, and a bigger class (faster and powerfull :-)

Example:
said that you are looking the cursortype property of an instance of Ado
recordset.
The property value is 2. You know that cursortype property is an Enum
"CursorTypeEnum".
What do the value 2 mean?

sample code:

  Dim rs As ADODB.Recordset
  ...
  ...
  ...
  Dim EnI As TlbEnumInfo 'this is my class
  Set EnI = New TlbEnumInfo
  Set EnI.ObjOfTheLibraryThatContainEnum = rs 'this is needed
  MsgBox rs.CursorType & " = " & _
      EnI.GetEnumDescription(rs.CursorType , "CursorTypeEnum")
'And the message box will tell you "2 = adOpenStatic" :-)
  EnI.LoadAllEnum 'load all enumeration
  TextBox1.Text = EnI.AllLoadedEnumToString 'put all enumeration in a
textbox


You can get the description of an Enum form it's value.
You can get the value of an Enum form it's description.
You can get a list of all Enum in a TypeLib.
You can get Max and Min value of any enum.
You can get the number of the descrptor in an Enum.
You can get the list of value/description.
You can iterate all the enum value/description.

The property ObjOfTheLibraryThatContainEnum must point to an instance
of an object of the library that contain the enum. For an ADODB enum
can be: a recordset, a recordset.fields, recordset.fils(0),
connection...

There are even some function for converting a single enum, or all enum,
in a TypeLib in a string, so you ca put it in a text box :-)

I hope this class can be usefull to someone.
Use at you own risk. These function/class can contain bugs.
I only tried it a little.

By, Adaway


'===========================================================
'                   The simple function
'===========================================================
'This is a simpler, single procedure for finding the name of an enum
Public Function GetEnumDescriptionDirect(EnumValue As Long, _
  EnumName As String, obj As Object) As String
  On Error GoTo Error_GetEnumDescriptionDirect

  Dim mTLI As TypeLibInfo
  Dim mTI As TypeInfo
  Dim mMI As MemberInfo
  Dim ct As Long
  Dim cm As Long

  GetEnumDescriptionDirect = "Unable to find Name of value " _
    & EnumValue & " in " & EnumName & " enumeration."

  'get TypeLibInfo from a running object
  Set mTLI = TLI.InterfaceInfoFromObject(obj).Parent


  'loop all typeInfo, the collection is 1-based
  For ct = 1 To mTLI.TypeInfos.Count
    Set mTI = mTLI.TypeInfos.Item(ct)


    'analyze only the Enumeration
    If mTI.TypeKind = TKIND_ENUM And mTI.Name = EnumName _
      Then

      'We found the right enumeration, now we can search
      'for the right value
      For cm = 1 To mTI.Members.Count
        Set mMI = mTI.Members.Item(cm)

        If mMI.Value = EnumValue Then
          GetEnumDescriptionDirect = mMI.Name
          Exit Function
        End If
      Next

    End If
  Next


  Set mMI = Nothing
  Set mTI = Nothing
  Set mTLI = Nothing

  Exit Function

Error_GetEnumDescriptionDirect:

  MsgBox Err.Source & " - " & Err.Description & " - " & _
    Err.Number & " - " & Err.LastDllError

End Function
'===========================================================
'                  End of the simple function
'===========================================================





'=============================================
'=============================================
'
' BEGIN OF THE CLASS TlbEnumInfo.cls
'
'=============================================
'=============================================

Option Explicit
Option Compare Text
'This class need a reference to "TypeLib Information" (TBLINF32.DLL)


'=====================================================
'                 Public Type
'=====================================================


Public Type V2N
  Value As Long
  Descr As String
End Type


Public Type MyEnumInfo
  EnumName As String
  Values() As V2N
  ValueCount As Long
  MinEnumVal As Long
  MaxEnumVal As Long
End Type



'=====================================================
'                 Data
'=====================================================


Private EnI() As MyEnumInfo
Private mObjThatContainEnum As Object
Private mNotFoundVal As Long
Private mLibName As String
Private mLibPath As String


'=====================================================
'                 Public Properties
'=====================================================


Public Property Get ObjOfTheLibraryThatContainEnum() As _
  Object
  Set ObjOfTheLibraryThatContainEnum = mObjThatContainEnum
End Property
Public Property Set ObjOfTheLibraryThatContainEnum(Value As _
  Object)
  If mObjThatContainEnum Is Nothing Then
    Set mObjThatContainEnum = Value
  Else
    Err.Raise vbObjectError + 513, "ObjThatContainEnum", _
      "Error! ObjOfTheLibraryThatContainEnum can be set only" & _
      " 1 time! (if you want to use another object, create" & _
      " another instance of TlbEnumInfo)"
  End If
End Property



Public Property Get EnumInfoByIndex(Index As Long) As _
  MyEnumInfo
  If Index > Me.EnumCount - 1 Then Err.Raise vbObjectError _
    + 513, "EnumInfoByIndex", "Error! Index > (EnumCount-1)!"
  EnumInfoByIndex = EnI(Index)
End Property

Public Property Get EnumInfo(EnumName As String) As _
  MyEnumInfo
  EnumInfo = EnI(FindEnumAndLoadIfMissing(EnumName))
End Property

Public Property Get EnumCount() As Long
  EnumCount = ArrayCount(EnI)
End Property

Public Property Get LibName() As String
  LibName = mLibName
End Property

Public Property Get LibPath() As String
  LibPath = mLibPath
End Property


'=====================================================
'                 Init
'=====================================================


Private Sub Class_Initialize()
  mNotFoundVal = -2147483648#
End Sub
Private Sub Class_Terminate()
  ReDim EnI(0)
  Set mObjThatContainEnum = Nothing
End Sub



'=====================================================
'                 Public Function
'=====================================================


'load all the enumeration of the Lib
Public Sub LoadAllEnum()
  LoadEnum "", True
End Sub

'get the value of the enum description
Public Function GetEnumValue(EnumValueDescription As String, _
  EnumName As String) As Long
  Dim Idx As Long
  Idx = FindEnumAndLoadIfMissing(EnumName)

  GetEnumValue = iGetEnumValue(EnumValueDescription, _
    EnI(Idx))
End Function


'Return an enum description from its value. Load the enumeration
'if not present in EnI (array of MyEnumInfo)
Public Function GetEnumDescription(EnumValue As Long, _
  EnumName As String) As String
  Dim Idx As Long
  Idx = FindEnumAndLoadIfMissing(EnumName)

  GetEnumDescription = iGetEnumDescription(EnumValue, _
    EnI(Idx))
End Function


Public Function GetEnumMaxValue(EnumName As String) As Long
  Dim Idx As Long
  Idx = FindEnumAndLoadIfMissing(EnumName)

  GetEnumMaxValue = EnI(Idx).MaxEnumVal
End Function


Public Function GetEnumMinValue(EnumName As String) As Long
  Dim Idx As Long
  Idx = FindEnumAndLoadIfMissing(EnumName)

  GetEnumMinValue = EnI(Idx).MinEnumVal
End Function


Public Function EnumToString(EnumName As String) As String
  Dim st As String

  Dim Idx As Long
  Idx = FindEnumAndLoadIfMissing(EnumName)

  EnumToString = EnumToStringByIndex(Idx)
End Function


Public Function EnumToStringByIndex(Index As Long) As String
  Dim st As String
  If Index > Me.EnumCount - 1 Then Err.Raise vbObjectError _
    + 513, "EnumToStringByIndex", _
    "Error! Index > (EnumCount-1)!"

  st = mLibName & "." & EnI(Index).EnumName & vbTab & vbTab _
    & " (Values = " & EnI(Index).MinEnumVal & ".." & _
    EnI(Index).MaxEnumVal & ", Total of " & _
    EnI(Index).ValueCount & " Value/Descriptor)" & vbCrLf
  Dim c As Long
  For c = 0 To EnI(Index).ValueCount - 1
    st = st & "    " & EnI(Index).Values(c).Descr & "  =  " _
      & EnI(Index).Values(c).Value & vbCrLf
  Next

  EnumToStringByIndex = st
End Function


Public Function AllLoadedEnumToString() As String
  Dim st As String
  Dim Idx As Long

  AllLoadedEnumToString = ""
  If Me.EnumCount = 0 Then Exit Function

  st = "Enumeration of Lib " & Me.LibName & " (" & _
    Me.LibPath & ")" & vbCrLf & vbCrLf

  For Idx = 0 To Me.EnumCount - 1
    st = st & EnumToStringByIndex(Idx)
    st = st & vbCrLf
  Next

  AllLoadedEnumToString = st
End Function


'=====================================================
'                 Private Function
'=====================================================



'count the element of an array
Private Function ArrayCount(obj As Variant) As Long
'check if it's an array
  If Not IsArray(obj) Then Err.Raise vbObjectError + 513, _
    "ArrayCount", "Error! The obj is not an array!"

  On Error GoTo eError

  ArrayCount = UBound(obj) - LBound(obj) + 1


  Exit Function

eError:
  ArrayCount = 0
End Function


'return mNotFoundVal if not found
Private Function FindEnumInfoIndex(EnumName As String) As _
  Long
  FindEnumInfoIndex = mNotFoundVal
  If ArrayCount(EnI) = 0 Then Exit Function

  Dim c As Long
  For c = LBound(EnI) To UBound(EnI)
    If EnI(c).EnumName = EnumName Then
      FindEnumInfoIndex = c
      Exit Function
    End If
  Next
End Function


'Return an enum description from its value
Private Function iGetEnumDescription(EnumValue As Long, en _
  As MyEnumInfo) As String
  If ArrayCount(en.Values) = 0 Then Err.Raise vbObjectError _
    + 513, "iGetEnumValueDescription", _
    "Error! The array is empty!"

  Dim c As Long
  For c = LBound(en.Values) To UBound(en.Values)
    If en.Values(c).Value = EnumValue Then
      iGetEnumDescription = en.Values(c).Descr
      Exit Function
    End If
  Next

  Err.Raise vbObjectError + 513, "iGetEnumValueDescription", _
    "Error! EnumValue not found!"
End Function


Private Function iGetEnumValue(EnumValueDescription As _
  String, en As MyEnumInfo) As Long
  If ArrayCount(en.Values) = 0 Then Err.Raise vbObjectError _
    + 513, "iGetEnumValue", "Error! The array is empty!"

  Dim c As Long
  For c = LBound(en.Values) To UBound(en.Values)
    If en.Values(c).Descr = EnumValueDescription Then
      iGetEnumValue = en.Values(c).Value
      Exit Function
    End If
  Next

  Err.Raise vbObjectError + 513, "iGetEnumValueDescription", _
    "Error! EnumValue not found!"
End Function


'return the EnI index of the enum, try to load the enum if it
'is missing from EnI throw an error if unable to load the enum
Private Function FindEnumAndLoadIfMissing(EnumName As _
  String) As Long
  If mObjThatContainEnum Is Nothing Then Err.Raise _
    vbObjectError + 513, "GetEnumValueDescription", _
    "Error! ObjOfTheLibraryThatContainEnum is nothing! This" & _
    " property must contain a reference to an instance of" & _
    " an object of the library that contain the enum." & _
    " Example: if I need an enum from ADO" & _
    " ObjOfTheLibraryThatContainEnum can point to an" & _
    " instance of the following objects: recordset," & _
    " recordset.fields, recordset.fields(0), connection.... "

  Dim Idx As Long
  Idx = FindEnumInfoIndex(EnumName)
  If Idx = mNotFoundVal Then
    'enum is not initializaed
    If LoadEnum(EnumName, False) = True Then
      'if ok, get the last enum
      Idx = ArrayCount(EnI) - 1
    Else
      Err.Raise vbObjectError + 513, _
        "FindEnumAndLoadIfMissing", _
        "Error! Enumeration not found!"
    End If
  End If

  FindEnumAndLoadIfMissing = Idx
End Function


'Load an enumeration in EnI; return true if ok, false if enum not found
Private Function LoadEnum(EnumName As String, LoadAllEnum _
  As Boolean) As Boolean
  If mObjThatContainEnum Is Nothing Then Err.Raise _
    vbObjectError + 513, "GetEnumValueDescription", _
    "Error! ObjOfTheLibraryThatContainEnum is nothing! This" & _
    " property must contain a reference to an instance of" & _
    " an object of the library that contain the enum." & _
    " Example: if I need an enum from ADO" & _
    " ObjOfTheLibraryThatContainEnum can point to an" & _
    " instance of the following objects: recordset," & _
    " recordset.fields, recordset.fields(0), connection.... "

  On Error GoTo Error_InitEnum

  Dim mTLI As TypeLibInfo
  Dim mTI As TypeInfo
  Dim ct As Long
  Dim cm As Long

  LoadEnum = False

  'get TypeLibInfo from a running object
  Set mTLI = _
    TLI.InterfaceInfoFromObject(mObjThatContainEnum).Parent

  'Library Name (Es. "ADODB")
  mLibName = mTLI.Name
  mLibPath = mTLI.ContainingFile


  'loop all typeInfo, the collection is 1-based
  For ct = 1 To mTLI.TypeInfos.Count
    Set mTI = mTLI.TypeInfos.Item(ct)


    'analyze only the Enumeration
    If mTI.TypeKind = TKIND_ENUM Then

      Dim LoadTheEnum As Boolean
      LoadTheEnum = False
      If (LoadAllEnum = True) And _
        (FindEnumInfoIndex(EnumName) = mNotFoundVal) Then _
        LoadTheEnum = True
      If (LoadAllEnum = False) And (mTI.Name = EnumName) _
        Then LoadTheEnum = True


      If LoadTheEnum = True Then
        'add space for new enum
        Dim NewEnum As Long
        NewEnum = ArrayCount(EnI)
        ReDim Preserve EnI(0 To NewEnum)

        'init enum data
        EnI(NewEnum).EnumName = mTI.Name
        EnI(NewEnum).MinEnumVal = 2147483647
        EnI(NewEnum).MaxEnumVal = -2147483648#
        EnI(NewEnum).ValueCount = mTI.Members.Count

        'found the right enumeration; add to the local array
        For cm = 1 To mTI.Members.Count
          'add space for new enum value
          Dim NewEnumVal As Long
          NewEnumVal = ArrayCount(EnI(NewEnum).Values)
          ReDim Preserve EnI(NewEnum).Values(0 To _
            NewEnumVal)

          'store the data
          EnI(NewEnum).Values(NewEnumVal).Descr = _
            mTI.Members.Item(cm).Name
          EnI(NewEnum).Values(NewEnumVal).Value = _
            mTI.Members.Item(cm).Value

          'check for Min adn Max Value
          If EnI(NewEnum).Values(NewEnumVal).Value > _
            EnI(NewEnum).MaxEnumVal Then _
            EnI(NewEnum).MaxEnumVal = _
            EnI(NewEnum).Values(NewEnumVal).Value
          If EnI(NewEnum).Values(NewEnumVal).Value < _
            EnI(NewEnum).MinEnumVal Then _
            EnI(NewEnum).MinEnumVal = _
            EnI(NewEnum).Values(NewEnumVal).Value

        Next

        LoadEnum = True

      End If

    End If
  Next


  Set mTI = Nothing
  Set mTLI = Nothing

  Exit Function

Error_InitEnum:
  MsgBox Err.Source & " - " & Err.Description & " - " & _
    Err.Number & " - " & Err.LastDllError
End Function



'=============================================
'=============================================
'
' END OF THE CLASS TlbEnumInfo.cls
'
'=============================================
'=============================================

Author
9 Oct 2005 2:27 AM
Ken Halter
"adaway" <ada***@gmail.com> wrote in message
news:1128811623.271478.231270@g49g2000cwa.googlegroups.com...
> Today I writed some code for getting the name of an enumeration at
> runtime.
> I wrote a simple function, and a bigger class (faster and powerfull :-)

Thanks for sharing... if you use that code in an app, be sure to add
tlbinf32.dll to your setup package...

--
Ken Halter - MS-MVP-VB - http://www.vbsight.com
DLL Hell problems? Try ComGuard - http://www.vbsight.com/ComGuard.htm
Please keep all discussions in the groups..