检索参数

One of the members of the FUNDESC structure, cParams, contains the number of parameters of each function or method. Parameters can be of any kind of data type and be passed by value or by reference. And so the fun continues!

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

' Retrieve information about the parameters

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

FUNCTION CParseTypeLib.GetParameters (BYVAL pTypeInfo AS Afx_ITypeInfo PTR, BYVAL pFuncDesc AS FUNCDESC PTR, _

BYVAL hTreeView AS HWND, BYVAL hSubNode2 AS HTREEITEM, BYVAL bVTableView AS BOOLEAN) AS HRESULT

DIM hr AS HRESULT ' // HRESULT

DIM y AS LONG ' // Loop counter

DIM hParamsNode AS HTREEITEM ' // Parameters node

DIM hParamNameNode AS HTREEITEM ' // Parameter name node

DIM cNames AS DWORD ' // Number of names returned by ITypeInfo.GetNames

DIM pParam AS ELEMDESC PTR ' // Pointer to an array of parameters

DIM wFlags AS WORD ' // Parameter flags

DIM cbstrParamName AS CBSTR ' // Parameter name

DIM pParamTypeAttr AS TYPEATTR PTR ' // Referenced TYPEATTR structure

DIM pReturnTypeAttr AS TYPEATTR PTR ' // Referenced TYPEATTR structure

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 ptdesc AS TYPEDESC PTR ' // Pointer to a TYPEDESC structure

hParamsNode = TreeView_AddItem(hTreeView, hSubNode2, NULL, "Number of parameters = " & WSTR(pFuncDesc->cParams))

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

' Gets the name of all the parameters.

' The first one is the name of the function.

' If the member ID identifies a property that is implemented with property functions,

' the property name is returned. For property get functions, the names of the function

' and its parameters are always returned.

' For property put and put reference functions, the right side of the assignment is

' unnamed. If cMaxNames is less than is required to return all of the names of the

' parameters of a function, then only the names of the first cMaxNames-1 parameters

' are returned. The names of the parameters are returned in the array in the same

' order that they appear elsewhere in the interface (for example, the same order in

' the parameter array associated with the FUNCDESC enumeration).

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

REDIM rgbstrNames(pFuncDesc->cParams) AS AFX_BSTR

hr = pTypeInfo->GetNames(pFuncDesc->memid, @rgbstrNames(0), pFuncDesc->cParams + 1, @cNames)

IF hr = S_OK THEN

' // Pointer to an ELEMDESC structure

pParam = pFuncDesc->lprgelemdescParam

' // Retrieves information about the parameters

FOR y = 0 TO pFuncDesc->cParams - 1

cbstrVarType.Clear : cbstrTypeKind.Clear : cbstrFBKeyword.Clear

' // Attributes

wFlags = pParam[y].paramdesc.wParamFlags

' // When using the automation view, it does not return a name for the return type

cbstrParamName.Clear

cbstrParamName = rgbstrNames(y + 1)

IF LEN(cbstrParamName) = 0 THEN

IF y = pFuncDesc->cParams - 1 THEN

cbstrParamName = "rhs"

ELSE

cbstrParamName = "prm" & WSTR(y + 1)

END IF

hParamNameNode = TreeView_AddItem(hTreeView, hParamsNode, NULL, cbstrParamName)

TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Attributes = " & WSTR(wFlags) & " [&h" & HEX(wFlags, 8) & "] " & TLB_ParamflagsToStr(wFlags))

wIndirectionLevel = 0

IF pParam[y].tdesc.vt = VT_USERDEFINED THEN

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

hr = pTypeInfo->GetRefTypeInfo(pParam[y].tdesc.hreftype, @pRefTypeInfo)

IF hr = S_OK AND pRefTypeInfo <> NULL THEN

cbstrVarType.Clear

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

hr = pRefTypeInfo->GetTypeAttr(@pParamTypeAttr)

IF hr = S_OK AND pParamTypeAttr <> NULL THEN

IF pParamTypeAttr->typekind = TKIND_ALIAS THEN

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

ELSE

cbstrTypeKind = TLB_TypeKindToStr(pParamTypeAttr->typekind)

END IF

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

pRefTypeInfo->ReleaseTypeAttr(pParamTypeAttr)

pParamTypeAttr = NULL

END IF

IF pRefTypeInfo THEN pRefTypeInfo->Release

END IF

ELSEIF pParam[y].tdesc.vt = VT_PTR THEN

' // Pointer to a TYPEDESC structure

ptdesc = pParam[y].tdesc.lptdesc

wIndirectionLevel = 1

SELECT CASE ptdesc->vt

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

CASE VT_PTR

wIndirectionLevel += 1

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

cbstrVarType.Clear

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

hr = pRefTypeInfo->GetTypeAttr(@pParamTypeAttr)

IF hr = S_OK AND pParamTypeAttr <> NULL THEN

IF pParamTypeAttr->typekind = TKIND_ALIAS THEN

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

ELSE

cbstrTypeKind = TLB_TypeKindToStr(pParamTypeAttr->typekind)

END IF

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

pRefTypeInfo->ReleaseTypeAttr(pParamTypeAttr)

pParamTypeAttr = NULL

END IF

IF pRefTypeInfo THEN pRefTypeInfo->Release

END IF

EXIT DO

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(pParam[y].tdesc.vt)

cbstrFBKeyword = TLB_VarTypeToKeyword(pParam[y].tdesc.vt)

' // Increment indirection level to pointers

IF cbstrTypeKind = "TKIND_INTERFACE" OR cbstrTypeKind = "TKIND_DISPATCH" OR cbstrTypeKind = "TKIND_COCLASS" THEN wIndirectionLevel += 1

IF cbstrVarType = "VT_SAFEARRAY" THEN wIndirectionLevel += 1

END IF

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

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

' // Add a prefix to structures that begin with an underscore

' IF LEFT$(cbstrVarType, 1) = "_" THEN

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

' END IF

' // Parameter name, type and indirection

' // TODO: IF bVTableView = TRUE then use CBSTR and CVARIANT

SELECT CASE **cbstrTypeKind

CASE "TKIND_INTERFACE", "TKIND_DISPATCH", "TKIND_COCLASS"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR"

END IF

CASE "TKIND_RECORD", "TKIND_UNION", "TKIND_ENUM"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType

END IF

CASE ELSE

IF LEFT(**cbstrTypeKind, 11) = "TKIND_ALIAS" THEN

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType

END IF

ELSE

SELECT CASE **cbstrVarType

CASE "VT_UNKNOWN"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

IF ((wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT) OR ((wFlags AND PARAMFLAG_FRETVAL) = PARAMFLAG_FRETVAL) THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR"

END IF

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR"

END IF

CASE "VT_DISPATCH"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

IF ((wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT) OR ((wFlags AND PARAMFLAG_FRETVAL) = PARAMFLAG_FRETVAL) THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR"

END IF

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR"

END IF

CASE "VT_VOID"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

IF ((wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT) OR ((wFlags AND PARAMFLAG_FRETVAL) = PARAMFLAG_FRETVAL) THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR"

END IF

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR"

END IF

CASE "VT_LPSTR"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ZSTRING PTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ZSTRING PTR"

END IF

CASE "VT_LPWSTR"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS WSTRING PTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS WSTRING PTR"

END IF

CASE "VT_BSTR"

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS BSTR PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS BSTR PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS BSTR"

END IF

CASE ELSE

IF wIndirectionLevel = 2 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrFBKeyword & " PTR PTR"

ELSEIF wIndirectionLevel = 1 THEN

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrFBKeyword & " PTR"

ELSE

cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrFBKeyword

END IF

END SELECT

END IF

END SELECT

' // See of it is an optional parameter without a default value

IF (pParam[y].paramdesc.wParamFlags AND PARAMFLAG_FOPT) = PARAMFLAG_FOPT AND _

(pParam[y].paramdesc.wParamFlags AND PARAMFLAG_FHASDEFAULT) <> PARAMFLAG_FHASDEFAULT THEN

IF RIGHT(**cbstrFBSyntax, 4) = " PTR" THEN cbstrFBSyntax += " = NULL"

IF RIGHT(**cbstrFBSyntax, 11) = " AS VARIANT" THEN cbstrFBSyntax += " = TYPE(VT_ERROR,0,0,0,DISP_E_PARAMNOTFOUND)"

END IF

' // See if it has a default value

IF (pParam[y].paramdesc.wParamFlags AND PARAMFLAG_FHASDEFAULT) = PARAMFLAG_FHASDEFAULT THEN

DIM pex AS PARAMDESCEX PTR = pParam[y].paramdesc.pparamdescex

DIM cbsDefaultValue AS CBSTR = AfxVarToBstr(@pex->vardefaultvalue)

IF pex->vardefaultvalue.vt = VT_BSTR THEN

TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Default value = " & CHR(34) & **cbsDefaultValue & CHR(34))

' cbstrFBSyntax += " = " & CHR(34) & **cbsDefaultValue & CHR(34)

ELSE

TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Default value = " & cbsDefaultValue)

' // Some typelibs have unprintable default values, e.g. wbemdisp.tlb,

' // that has unprintable IDispatch PTR values.

IF LEN(cbsDefaultValue) THEN cbstrFBSyntax += " = " & cbsDefaultValue

END IF

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

TreeView_Expand(hTreeView, hParamNameNode, TVE_EXPAND)

END IF

' // Exand the parameters node

' TreeView_Expand(hTreeView, hParamsNode, TVE_EXPAND)

' // DO NOT free the BSTRs; they are owned by the callee

' // Free the BSTRs of the array

' FOR i AS LONG = LBOUND(rgbstrNames) TO UBOUND(rgbstrNames)

' IF rgbstrNames(i) THEN SysFreeString(rgbstrNames(i))

' NEXT

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

RETURN hr

END FUNCTION

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