枚举结构和联合

If the retrieved type info is of type TKIND_RECORD or TKIND_UNION, the cvars member of the TYPEATTR structure contains the number of members or data members and the GetVarDesc method of the ITypeInfo interface retrieves a VARDESC structure that describes the specified member or data member.

The parsing of this type info is more convoluted that in the case of the constants because they don't contain simple values, but the names and types of the members of an structure that can be simple data types, but also pointers, arrays or even other structures.

' =====================================================================================

' Retrieves information about the members of records and unions, and of datamembers.

' Note: Bined.dll fails to retrieve information of several members of the VSPROPSHEETPAGE structure.

' =====================================================================================

FUNCTION CParseTypeLib.GetMembers (BYVAL pTypeInfo AS Afx_ITypeInfo PTR, BYVAL pTypeAttr AS TYPEATTR PTR, BYVAL hTreeView AS HWND, BYVAL hSubNode AS HTREEITEM, BYVAL bIsRecord AS BOOLEAN = FALSE) AS HRESULT

DIM x AS LONG ' // Loop counter

DIM y AS LONG ' // Loop counter

DIM hr AS HRESULT ' // HRESULT

DIM pVarDesc AS VARDESC PTR ' // Pointer to a VARDESC structure

DIM cbstrVarName AS CBSTR ' // Variable name

DIM cbstrVarType AS CBSTR ' // Variable type

DIM cbstrTypeKind AS CBSTR ' // Type kind

DIM cbstrFBKeyword AS CBSTR ' // FB keyword

DIM cbstrFBSyntax AS CBSTR ' // FB syntax

DIM wIndirectionLevel AS WORD ' // Indirection level

DIM pRefTypeInfo AS Afx_ITypeInfo PTR ' // Referenced TypeInfo interface

DIM pVarTypeAttr AS TYPEATTR PTR ' // Type attribute for the member

DIM ptdesc AS TYPEDESC PTR ' // Pointer to a TYPEDESC structure

DIM padesc AS ARRAYDESC PTR ' // Pointer to an ARRAYDESC structure

DIM hSubNode2 AS HTREEITEM ' // Sub node handle

DIM hSubNode3 AS HTREEITEM ' // Sub node handle

IF pTypeInfo = NULL OR pTypeAttr = NULL THEN RETURN E_INVALIDARG

FOR x = 0 TO pTypeAttr->cVars - 1

cbstrVarType.Clear : cbstrTypeKind.Clear : cbstrFBKeyword.Clear

' // Gets a reference to the VarDesc structure

hr = pTypeInfo->GetVarDesc(x, @pVarDesc)

IF hr <> S_OK OR pVarDesc = NULL THEN EXIT FOR

' // Retrieve information

pTypeInfo->GetDocumentation(pVarDesc->memid, @cbstrVarName, NULL, NULL, NULL)

hSubNode2 = TreeView_AddItem(hTreeView, hSubNode, NULL, cbstrVarName)

TreeView_AddItem(hTreeView, hSubNode2, NULL, "DispID = " & WSTR(pVarDesc->memid) & " [&h" & HEX(pVarDesc->memid, 8) & "]")

IF pVarDesc->wVarFlags THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Attributes = " & WSTR(pVarDesc->wVarFlags) & " [&h" & HEX(pVarDesc->wVarFlags, 8) & "]" & TLB_VarFlagsToStr(pVarDesc->wVarFlags))

wIndirectionLevel = 0

IF pVarDesc->elemdescVar.tdesc.vt = VT_USERDEFINED THEN

' // If it is a user defined type, retrieve its name

hr = pTypeInfo->GetRefTypeInfo(pVarDesc->elemdescVar.tdesc.hreftype, @pRefTypeInfo)

IF hr = S_OK AND pRefTypeInfo <> NULL THEN

cbstrVarType.Clear

hr = pRefTypeInfo->GetDocumentation(-1, @cbstrVarType, NULL, NULL, NULL)

hr = pRefTypeInfo->GetTypeAttr(@pVarTypeAttr)

IF hr = S_OK AND pVarTypeAttr <> NULL THEN

IF pVarTypeAttr->typekind = TKIND_ALIAS THEN

cbstrTypeKind = TLB_TypeKindToStr(pVarTypeAttr->typekind) & " | " & TLB_VarTypeToConstant(pVarTypeAttr->tdescalias.vt)

ELSE

cbstrTypeKind = TLB_TypeKindToStr(pVarTypeAttr->typekind)

END IF

TreeView_AddItem(hTreeView, hSubNode2, NULL, "TypeKind = " & cbstrTypeKind)

pRefTypeInfo->ReleaseTypeAttr(pVarTypeAttr)

pVarTypeAttr = NULL

END IF

IF pRefTypeInfo THEN pRefTypeInfo->Release

ELSE

cbstrVarType = "GetRefTypeInfo failed - Error: &h" & HEX(hr, 8)

END IF

ELSEIF pVarDesc->elemdescVar.tdesc.vt = VT_PTR THEN

wIndirectionLevel = 1

ptdesc = pVarDesc->elemdescVar.tdesc.lptdesc

SELECT CASE ptdesc->vt

' // If it is another pointer, loop again

CASE VT_PTR

wIndirectionLevel += 1

ptdesc = ptdesc->lptdesc

CASE VT_USERDEFINED

hr = pTypeInfo->GetRefTypeInfo(ptdesc->hreftype, @pRefTypeInfo)

IF hr = S_OK AND pRefTypeInfo <> NULL THEN

cbstrVarType.Clear

hr = pRefTypeInfo->GetDocumentation(-1, @cbstrVarType, NULL, NULL, NULL)

IF hr = S_OK THEN

pRefTypeInfo->GetTypeAttr(@pVarTypeAttr)

IF hr = S_OK AND pVarTypeAttr <> NULL THEN

IF pVarTypeAttr->typekind = TKIND_ALIAS THEN

cbstrTypeKind = TLB_TypeKindToStr(pVarTypeAttr->typekind) & " | " & TLB_VarTypeToConstant(pVarTypeAttr->tdescalias.vt)

ELSE

cbstrTypeKind = TLB_TypeKindToStr(pVarTypeAttr->typekind)

END IF

TreeView_AddItem(hTreeView, hSubNode2, NULL, "TypeKind = " & cbstrTypeKind)

pRefTypeInfo->ReleaseTypeAttr(pVarTypeAttr)

pVarTypeAttr = NULL

END IF

IF pRefTypeInfo THEN pRefTypeInfo->Release

EXIT DO

ELSE

cbstrVarType = "GetRefTypeInfo failed - Error: &h" & HEX(hr, 8)

END IF

CASE ELSE

' // Get the equivalent type

cbstrVarType = TLB_VarTypeToConstant(ptdesc->vt)

cbstrFBKeyword = TLB_VarTypeToKeyword(ptdesc->vt)

EXIT DO

END SELECT

LOOP

ELSE

' // Get the equivalent type

cbstrVarType = TLB_VarTypeToConstant(pVarDesc->elemdescVar.tdesc.vt)

cbstrFBKeyword = TLB_VarTypeToKeyword(pVarDesc->elemdescVar.tdesc.vt)

END IF

IF bIsRecord = FALSE THEN

TreeView_AddItem(hTreeView, hSubNode2, NULL, "VarType = " & cbstrVarType)

ELSE ' // Records and unions only

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Indirection level = " & WSTR(wIndirectionLevel))

' ' // Add the "tag_" prefix to structures and unions

' IF cbstrTypeKind = "TKIND_RECORD" OR cbstrTypeKind = "TKIND_UNION" THEN cbstrVarType = "tag" & cbstrVarType

' // END isn't allowed as a member name

IF UCASE(cbstrVarName) = "END" THEN cbstrVarName += "_"

' // Use generic data types for enums and interfaces

IF cbstrFBKeyword = "" THEN cbstrFBKeyword = cbstrVarType

' // Add the "tag_" prefix to structures and unions

' IF cbstrTypeKind = "TKIND_RECORD" OR cbstrTypeKind = "TKIND_UNION" THEN cbstrFBKeyword = "tag_" & cbstrFBKeyword

IF wIndirectionLevel > 0 THEN cbstrFBKeyword += " PTR"

' IF cbstrTypeKind = "TKIND_ALIAS | VT_PTR" THEN cbstrFBKeyword = "VOID"

IF cbstrTypeKind = "TKIND_ALIAS | VT_PTR" THEN cbstrFBKeyword = cbstrVarType & " PTR"

IF cbstrTypeKind = "TKIND_ENUM" THEN cbstrFBKeyword = cbstrVarType

IF cbstrTypeKind = "TKIND_UNKNOWN" THEN cbstrFBKeyword = "IUnknown PTR"

IF cbstrTypeKind = "TKIND_DISPATCH" THEN cbstrFBKeyword = "IDispatch PTR"

IF pVarDesc->elemdescVar.tdesc.vt = VT_CARRAY THEN

padesc = pVarDesc->elemdescVar.tdesc.lpadesc

cbstrVarType += " | " & TLB_VarTypeToConstant(padesc->tdescElem.vt)

cbstrVarName += " ("

FOR y = 0 TO padesc->cDims - 1

cbstrVarName += WSTR(padesc->rgbounds(y).lLBound) & " TO "

cbstrVarName += WSTR(padesc->rgbounds(y).lLBound + padesc->rgbounds(y).cElements - 1)

IF padesc->cDims > 1 THEN cbstrVarName += ", "

cbstrVarName += ")"

cbstrFBKeyword = TLB_VarTypeToKeyword(padesc->tdescElem.vt)

END IF

TreeView_AddItem(hTreeView, hSubNode2, NULL, "VarType = " & cbstrVarType)

IF pVarDesc->elemdescVar.tdesc.vt = VT_CARRAY THEN

padesc = pVarDesc->elemdescVar.tdesc.lpadesc

hSubNode3 = TreeView_AddItem(hTreeView, hSubNode2, NULL, "Dimensions = " & WSTR(padesc->cDims))

FOR y = 0 TO padesc->cDims - 1

TreeView_AddItem(hTreeView, hSubNode3, NULL, "Dimension " & WSTR(y + 1) & " lower bound = " & WSTR(padesc->rgbounds(y).lLBound))

TreeView_AddItem(hTreeView, hSubNode3, NULL, "Dimension " & WSTR(y + 1) & " elements = " & WSTR(padesc->rgbounds(y).cElements))

TreeView_Expand(hTreeView, hSubNode3, TVE_EXPAND)

END IF

' ' // FB syntax

SELECT CASE **cbstrVarType

CASE "VT_LPSTR", "VT_CARRAY | VT_LPSTR"

cbstrFBSyntax = cbstrVarName & " AS ZSTRING PTR"

CASE "VT_LPWSTR", "VT_CARRAY | VT_LPWSTR"

cbstrFBSyntax = cbstrVarName & " AS WSTRING PTR"

CASE ELSE

cbstrFBSyntax = **cbstrVarName & " AS " & **cbstrFBKeyword

END SELECT

TreeView_AddItem(hTreeView, hSubNode2, NULL, "FB syntax = " & cbstrFBSyntax)

END IF

' // Expand the nodes

' TreeView_Expand(hTreeView, hSubNode2, TVE_EXPAND)

TreeView_Expand(hTreeView, hSubNode, TVE_EXPAND)

' // Release the VARDESC structure

pTypeInfo->ReleaseVarDesc(pVarDesc)

pVarDesc = NULL

IF pVarDesc THEN pTypeInfo->ReleaseVarDesc(pVarDesc)

' // Just to satisfy the compiler rules; it has no useful meaning

FUNCTION = hr

END FUNCTION

' =====================================================================================