|
code
newsgroups
|
|||||||||||||||||||||||
|
|||||||||||||||||||||||
A Class to get the name of Enum constant at runtimeruntime. 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 ' '============================================= '============================================= "adaway" <ada***@gmail.com> wrote in message Thanks for sharing... if you use that code in an app, be sure to add 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 :-) 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.. |
|||||||||||||||||||||||