检索方法和属性

The cFuncs member of the TYPEATTR structure contains the number of methods and properties implemented in an interface and the GetFuncDesc method of the ITypeInfo interface retrieves the FUNCDESC structure that contains information about a specified function ( https://msdn.microsoft.com/en-us/library/windows/desktop/ms221425(v=vs.85).aspx ), as well as the return type.

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

' Retrieve information about the methods, properties and functions.

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

FUNCTION CParseTypeLib.GetFunctions (BYVAL pTypeInfo AS Afx_ITypeInfo PTR, BYVAL pTypeAttr AS TYPEATTR PTR, _

BYVAL hTreeView AS HWND, BYVAL hSubNode AS HTREEITEM, BYVAL bVTableView AS BOOLEAN, BYVAL bIsMethod AS BOOLEAN = FALSE, _

BYVAL pTKind AS TYPEKIND = -1, BYVAL pwszImplInterface AS WSTRING PTR = NULL) AS HRESULT

DIM hr AS HRESULT ' // HRESULT

DIM x AS LONG ' // Loop counter

DIM hSubNode2 AS HTREEITEM ' // Sub node handle

DIM pFuncDesc AS FUNCDESC PTR ' // Pointer to a FUNCDESC structure

DIM cbstrName AS CBSTR ' // Name

DIM cbstrHelpString AS CBSTR ' // Help string

DIM dwHelpContext AS DWORD ' // Help context number

DIM cbstrDllName AS CBSTR ' // DLL name

DIM cbstrEntryPoint AS CBSTR ' // Entry point

DIM wOrdinal AS WORD ' // Ordinal

DIM pRefTypeInfo AS Afx_ITypeInfo PTR ' // Referenced TypeInfo interface

DIM pReturnTypeAttr AS TYPEATTR PTR ' // Referenced TYPEATTR structure

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

DIM ReturnTypeKind AS TYPEKIND ' // Return value type kind

DIM cbstrType AS CBSTR ' // Type

IF pTypeInfo = NULL OR pTypeAttr = NULL THEN RETURN E_INVALIDARG

DIM cbOrigName AS CBSTR

FOR x = 0 TO pTypeAttr->cFuncs - 1

' // Gets a reference to the FuncDesc structure

hr = pTypeInfo->GetFuncDesc(x, @pFuncDesc)

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

' // Retrieve the name

cbstrName.Clear : cbstrHelpString.Clear

pTypeInfo->GetDocumentation(pFuncDesc->memid, @cbstrName, @cbstrHelpString, @dwHelpContext, NULL)

IF bIsMethod THEN

' ------------------------------------------------------------------

' Workaround for libraries that can have illegal method names.

' For example, TLBINF32.DLL has a property called GetTypeInfo.

' ------------------------------------------------------------------

DIM vtOffset AS LONG

#ifdef __FB_64BIT__

vtOffset = 48

#else

vtOffset = 24

#endif

IF UCASE$(cbstrName) = "QUERYINTERFACE" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "ADDREF" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "RELEASE" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "GETTYPEINFOCOUNT" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "GETTYPEINFO" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "GETIDSOFNAMES" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "INVOKE" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"

IF UCASE$(cbstrName) = "DELETE" THEN cbstrName += "_"

IF UCASE$(cbstrName) = "PROPERTY" THEN cbstrName += "_"

IF pTKind = TKIND_INTERFACE OR pTKind = TKIND_DISPATCH THEN

IF pFuncDesc->invkind = INVOKE_FUNC THEN cbstrName = "METHOD " & cbstrName

IF pFuncDesc->invkind = INVOKE_PROPERTYGET THEN cbstrName = "PROPERTY GET " & cbstrName

IF pFuncDesc->invkind = INVOKE_PROPERTYPUT THEN cbstrName = "PROPERTY PUT " & cbstrName

IF pFuncDesc->invkind = INVOKE_PROPERTYPUTREF THEN cbstrName = "PROPERTY PUTREF " & cbstrName

END IF

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

TreeView_AddItem(hTreeView, hSubNode2, NULL, "VTable offset = " & WSTR(pFuncdesc->oVft) & " [&h" & HEX(pFuncdesc->oVft, 8) & "]")

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

IF LEN(cbstrHelpString) THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Help string = " & cbstrHelpString)

IF dwHelpContext THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Help context = " & WSTR(dwHelpContext))

ELSE

IF pFuncDesc->elemdescFunc.tdesc.vt = VT_VOID THEN

hSubNode2 = TreeView_AddItem(hTreeView, hSubNode, NULL, "SUB " & cbstrName)

ELSE

hSubNode2 = TreeView_AddItem(hTreeView, hSubNode, NULL, "FUNCTION " & cbstrName)

END IF

IF LEN(cbstrHelpString) THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Help string = " & cbstrHelpString)

IF dwHelpContext THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Help context = " & WSTR(dwHelpContext))

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

cbstrDllName.Clear : cbstrEntryPoint.Clear

hr = pTypeInfo->GetDllEntry(pFuncDesc->memid, pFuncDesc->invkind, @cbstrDllName, @cbstrEntryPoint, @wOrdinal)

IF hr = S_OK THEN

IF LEN(cbstrDllName) THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "DLL name = " & cbstrDllName)

IF LEN(cbstrEntryPoint) THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Entry point = " & cbstrEntryPoint)

IF wOrdinal THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Ordinal = " & WSTR(wOrdinal))

END IF

' // Kind of function

SELECT CASE pFuncDesc->funckind

CASE FUNC_VIRTUAL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "FuncKind = Virtual")

CASE FUNC_PUREVIRTUAL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "FuncKind = Pure virtual")

CASE FUNC_NONVIRTUAL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "FuncKind = Non virtual")

CASE FUNC_STATIC

TreeView_AddItem(hTreeView, hSubNode2, NULL, "FuncKind = Static")

CASE FUNC_DISPATCH

TreeView_AddItem(hTreeView, hSubNode2, NULL, "FuncKind = Dispatch")

END SELECT

' // Invoke kind

SELECT CASE pFuncDesc->invkind

CASE INVOKE_FUNC

TreeView_AddItem(hTreeView, hSubNode2, NULL, "InvokeKind = Function")

CASE INVOKE_PROPERTYGET

TreeView_AddItem(hTreeView, hSubNode2, NULL, "InvokeKind = Get property")

CASE INVOKE_PROPERTYPUT

TreeView_AddItem(hTreeView, hSubNode2, NULL, "InvokeKind = Put property")

CASE INVOKE_PROPERTYPUTREF

TreeView_AddItem(hTreeView, hSubNode2, NULL, "InvokeKind = PutRef property")

END SELECT

' // Calling convention

SELECT CASE pFuncDesc->callconv

CASE CC_FASTCALL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = FASTCALL")

CASE CC_CDECL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = CDECL")

CASE CC_MACPASCAL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = MACPASCAL")

CASE CC_STDCALL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = STDCALL")

CASE CC_FPFASTCALL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = FPFASTCALL")

CASE CC_SYSCALL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = SYSCALL")

CASE CC_MPWCDECL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = MPWCDECL")

CASE CC_MPWPASCAL

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Calling convention = MPWPASCAL")

END SELECT

' // More general information

IF pFuncDesc->cParamsOpt THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Number of optional variant parameters = " & WSTR(pFuncDesc->cParamsOpt))

IF pFuncDesc->cScodes THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Count of permitted Return values = " & WSTR(pFuncDesc->cScodes))

IF pFuncDesc->wFuncFlags THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Attributes = " & WSTR(pFuncDesc->wFuncFlags)& " [&h" & HEX(pFuncDesc->wFuncFlags, 8) & "]" & TLB_FuncFlagsToStr(pFuncDesc->wFuncFlags))

' // Return type

ReturnTypeKind = -1 ' // Because the TYPEKIND enum starts at 0

IF pFuncDesc->elemdescFunc.tdesc.vt = VT_USERDEFINED THEN

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

hr = pTypeInfo->GetRefTypeInfo(pFuncDesc->elemdescFunc.tdesc.hreftype, @pRefTypeInfo)

IF hr = S_OK AND pRefTypeInfo <> NULL THEN

cbstrType.Clear

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

hr = pRefTypeInfo->GetTypeAttr(@pReturnTypeAttr)

IF hr = S_OK AND pReturnTypeAttr <> NULL THEN

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Return type typeKind = " & TLB_TypeKindToStr(pReturnTypeAttr->typekind))

ReturnTypeKind = pReturnTypeAttr->typekind

pRefTypeInfo->ReleaseTypeAttr(pReturnTypeAttr)

pReturnTypeAttr = NULL

END IF

IF pRefTypeInfo THEN pRefTypeInfo->Release

END IF

ELSEIF pFuncDesc->elemdescFunc.tdesc.vt = VT_PTR THEN

' // Pointer to a TYPEDESC structure

ptdesc = pFuncDesc->elemdescFunc.tdesc.lptdesc

SELECT CASE ptdesc->vt

' // If it is a pointer, do it again

CASE VT_PTR

ptdesc = ptdesc->lptdesc

CASE VT_USERDEFINED

' // Retrieve the name of the user defined type

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

IF hr = S_OK AND pRefTypeInfo <> NULL THEN

cbstrType.Clear

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

hr = pRefTypeInfo->GetTypeAttr(@pReturnTypeAttr)

IF hr = S_OK AND pReturnTypeAttr <> NULL THEN

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Return type typeKind = " & TLB_TypeKindToStr(pReturnTypeAttr->typekind))

ReturnTypeKind = pReturnTypeAttr->typekind

pRefTypeInfo->ReleaseTypeAttr(pReturnTypeAttr)

pReturnTypeAttr = NULL

END IF

IF pRefTypeInfo THEN pRefTypeInfo->Release

END IF

EXIT DO

CASE ELSE

' // Get the equivalent type

cbstrType = TLB_VarTypeToConstant(ptdesc->vt)

EXIT DO

END SELECT

LOOP

ELSE

' // Get the equivalent type

cbstrType = TLB_VarTypeToConstant(pFuncDesc->elemdescFunc.tdesc.vt)

END IF

' // Return type

TreeView_AddItem(hTreeView, hSubNode2, NULL, "Return type = " & cbstrType)

DIM strReturn AS STRING = ""

IF bVTableView = FALSE THEN

IF ReturnTypeKind = TKIND_INTERFACE OR ReturnTypeKind = TKIND_DISPATCH THEN

strReturn = "BYVAL rhs AS " & cbstrType & " PTR PTR"

ELSEIF ReturnTypeKind = TKIND_ENUM THEN

strReturn = "BYVAL rhs AS " & cbstrType & " PTR"

ELSEIF ReturnTypeKind = TKIND_ALIAS THEN

strReturn = "BYVAL rhs AS " & cbstrType & " PTR"

ELSEIF pFuncDesc->elemdescFunc.tdesc.vt = VT_VOID THEN

' // With Automation view, VT_VOID means no return type

strReturn = ""

ELSEIF pFuncDesc->invkind <> INVOKE_PROPERTYGET AND pFuncDesc->cParams = 0 THEN

' // With Automation view, if it is not a get property and it has not

' // parameters, then it has not an OUT Return value but returns the value

' // directly as the result of the method, e.g. AddRef and Release.

strReturn = ""

ELSE

' // Returns the value as an OUT parameter

strReturn = "BYVAL rhs AS " & TLB_VarTypeToKeyword(pFuncDesc->elemdescFunc.tdesc.vt) & " PTR"

END IF

IF LEN(strReturn) THEN TreeView_AddItem(hTreeView, hSubNode2, NULL, "Return type FB syntax = " & strReturn)

END IF

' // Parameters

IF pFuncDesc->cParams THEN this.GetParameters(pTypeInfo, pFuncDesc, hTreeView, hSubNode2, bVTableView)

' // Expand the nodes

' TreeView_Expand(hTreeView, hSubNode2, TVE_EXPAND)

TreeView_Expand(hTreeView, hSubNode, TVE_EXPAND)

' // Release the FUNCDESC structure

pTypeInfo->ReleaseFuncDesc(pFuncDesc)

pFuncDesc = NULL

ReturnTypeKind = -1

IF pFuncDesc THEN pTypeInfo->ReleaseFuncDesc(pFuncDesc)

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

FUNCTION = hr

END FUNCTION

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