A Class to get the name of Enum constant at runtime

Tech-Archive recommends: Fix windows errors by optimizing your registry

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
'
'=============================================
'=============================================

.

Relevant Pages