• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

_IMsoDispObj

Started by Frederick J. Harris, December 30, 2011, 08:11:55 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

James C. Fuller

Fred,
  In my opinion I don't think the effort is worth it for obvious MS deviations from  it's own rules.
José has said for years that Excel is a complete mess.
I don't really see a c++ target user for include files for these type of com servers??
What I want are c++ header files for com servers I create with PowerBASIC for use with MinGW c++.

James

Frederick J. Harris

Another example of this is something I mentioned last week - DataObject, which is a CoClass in MSFlexGridLib....


[uuid(2334D2B2-713E-11CF-8AE5-00AA00C00905), noncreatable] coclass DataObject
{
[default] interface IVBDataObject;
};


Here is the dispinterface from OLEView.  Note the last two OLEGragDrop methods return a pointer to a CoClass!


[uuid(609602E0-531B-11CF-91F6-C2863C385E30), helpstring("Event interface for Microsoft FlexGrid Control"), helpcontext(0x00059620), hidden] dispinterface DMSFlexGridEvents
{
properties:
methods:
[id(0xfffffda8), helpstring("Fired when the user presses and releases the mouse button over the control."), helpcontext(0x000591d1)] void Click();
[id(0xfffffda6), helpstring("Fired when the user pushes a key."), helpcontext(0x000591d2)] void KeyDown(short* KeyCode, short Shift);
[id(0xfffffda7), helpstring("Fired when the user double-clicks the mouse over the control."), helpcontext(0x000591d3)] void DblClick();
[id(0xfffffda5), helpstring("Fired when the user presses a key."), helpcontext(0x000591d4)] void KeyPress(short* KeyAscii);
[id(0xfffffda4), helpstring("Fired when the user releases a key."), helpcontext(0x000591d5)] void KeyUp(short* KeyCode, short Shift);
[id(0xfffffda3), helpstring("Fired when the user presses a mouse button over the control."), helpcontext(0x000591d6)] void MouseDown(short Button, short Shift, OLE_XPOS_PIXELS x, OLE_YPOS_PIXELS y);
[id(0xfffffda2), helpstring("Fired when the user moves the mouse over the control."), helpcontext(0x000591d7)] void MouseMove(short Button, short Shift, OLE_XPOS_PIXELS x, OLE_YPOS_PIXELS y);
[id(0xfffffda1), helpstring("Fired when the user releases a mouse button over the control."), helpcontext(0x000591d8)] void MouseUp(short Button, short Shift, OLE_XPOS_PIXELS x, OLE_YPOS_PIXELS y);
[id(0x00000045), helpstring("Fired when the selected range of cells changes."), helpcontext(0x0005920e)] void SelChange();
[id(0x00000046), helpstring("Fired when the current cell changes."), helpcontext(0x0005920a)] void RowColChange();
[id(0x00000047), helpstring("Fired before the cursor enters a cell."), helpcontext(0x000591f7)] void EnterCell();
[id(0x00000048), helpstring("Fired after the cursor leaves a cell."), helpcontext(0x00059201)] void LeaveCell();
[id(0x00000049), helpstring("Fired when the TopRow or LeftCol properties change."), helpcontext(0x0005920d)] void Scroll();
[id(0x0000004a), helpstring("Fired during custom sorts to compare two rows."), helpcontext(0x000591f6)] void Compare(long Row1, long Row2, short* Cmp);
[id(0x0000060e), helpstring("OLEStartDrag event"), helpcontext(0x00057e8b)] void OLEStartDrag([in, out] DataObject** Data, [in, out] long* AllowedEffects);
[id(0x0000060f), helpstring("OLEGiveFeedback event"), helpcontext(0x00057e8c)] void OLEGiveFeedback([in, out] long* Effect, [in, out] VARIANT_BOOL* DefaultCursors);
[id(0x00000610), helpstring("OLESetData event"), helpcontext(0x00057e8d)] void OLESetData([in, out] DataObject** Data, [in, out] short* DataFormat);
[id(0x00000611), helpstring("OLECompleteDrag event"), helpcontext(0x00057e8e)] void OLECompleteDrag([in, out] long* Effect);
[id(0x00000612), helpstring("OLEDragOver event"), helpcontext(0x00057e8f)] void OLEDragOver([in, out] DataObject** Data, [in, out] long* Effect, [in, out] short* Button, [in, out] short* Shift, [in, out] single* x, [in, out] single* y, [in, out] short* State);
[id(0x00000613), helpstring("OLEDragDrop event"), helpcontext(0x00057e90)] void OLEDragDrop([in, out] DataObject** Data, [in, out] long* Effect, [in, out] short* Button, [in, out] short* Shift, [in, out] single* x, [in, out] single* y);
};


See the DataObject** just above.  I finally did more TypeLib magic on it so this is auto-generated by my code (same as Jose's and PB Com Browser)...


interface DMSFlexGridEvents : IDispatch
{
void __stdcall Click(void);
void __stdcall KeyDown(signed short* KeyCode, signed short Shift);
void __stdcall DblClick(void);
void __stdcall KeyPress(signed short* KeyAscii);
void __stdcall KeyUp(signed short* KeyCode, signed short Shift);
void __stdcall MouseDown(signed short Button, signed short Shift, OLE_XPOS_PIXELS x, OLE_YPOS_PIXELS y);
void __stdcall MouseMove(signed short Button, signed short Shift, OLE_XPOS_PIXELS x, OLE_YPOS_PIXELS y);
void __stdcall MouseUp(signed short Button, signed short Shift, OLE_XPOS_PIXELS x, OLE_YPOS_PIXELS y);
void __stdcall SelChange(void);
void __stdcall RowColChange(void);
void __stdcall EnterCell(void);
void __stdcall LeaveCell(void);
void __stdcall Scroll(void);
void __stdcall Compare(LONG Row1, LONG Row2, signed short* Cmp);
void __stdcall OLEStartDrag(IDispatch** Data, LONG* AllowedEffects);
void __stdcall OLEGiveFeedback(LONG* Effect, VARIANT_BOOL* DefaultCursors);
void __stdcall OLESetData(IDispatch** Data, signed short* DataFormat);
void __stdcall OLECompleteDrag(LONG* Effect);
void __stdcall OLEDragOver(IDispatch** Data, LONG* Effect, signed short* Button, signed short* Shift, float* x, float* y, signed short* State);
void __stdcall OLEDragDrop(IDispatch** Data, LONG* Effect, signed short* Button, signed short* Shift, float* x, float* y);
};


Since the DataObject CoClass only has one interface, and I expect the address of the VTable pointer to IVBDataObject would be identical to the address of the CoClass DataObject, I'm thinking a more COM compliant parameter type would be IVBDataObject instead of DataObject. 

Frederick J. Harris

#17
Quote
  In my opinion I don't think the effort is worth it for obvious MS deviations from  it's own rules.
José has said for years that Excel is a complete mess.
I don't really see a c++ target user for include files for these type of com servers??
What I want are c++ header files for com servers I create with PowerBASIC for use with MinGW c++.

Your point is well taken James.  Those complexities we are discussing here would delay my presentation of what I have developed here so far quite a bit - at least several weeks I'm thinking.  I do believe what I have so far would satisfactorily auto-generate C++ headers for the vast majority of typelibs.  And believe it or not, my console program (MinGW but no GUI yet) is only 800 lines of code and compiles to 39k.  Like I mentioned to Jose, about 99.99% of the code generated is reasonably easy to extract out of the typelib.   

That business above with searching the registry out trying to come up with missing dependencies really blew my mind!

Frederick J. Harris

Quote
What I want are c++ header files for com servers I create with PowerBASIC for use with MinGW c++.

Well, at least I have that.  I'll post it shortly.

José Roca

Take a look at vbinterf.inc in my headers. The DataObject class it's not creatable: it is implemented in the Visual Basic runtime. It's often used in OCXs made for Visual Basic. Just use IDispatch to allow compilation.

Dominic Mitchell

It is not uncommon to see parameter and return types named after the CoClass
when the type is the default interface for the CoClass.
I use the same approach when generating the headers.  If the object is present in the
type library, it is in this case, I see no reason to rename DataObject to IDispatch. 
 
This does not require a registry search.
Dominic Mitchell
Phoenix Visual Designer
http://www.phnxthunder.com

Frederick J. Harris

#21
I'm still thinking about this issue of one typelib referencing objects in other typelibs.  When Dominic first mentioned his technique of generating or loading several other typelibs in the Excel case, my first thought was, "Wow!, Good idea!"  But then I right away thought, "How did Dominic know which libs to load?"  That is why I made the comment about Jose's method not requiring a priori knowledge about any particular type lib.  Using Jose's technique one has a missing interface name, so one simply scours the registry searching out the typelib it is found in, then loads that typelib too to get the missing interface definition.  But I eventually realized referenced typelibs are listed right at the top of the idl file.  Here is the very top few lines of the Excel typelib (from OLEVIEW dump), showing importlib statements listing the very typelibs Dominic mentioned...


// Generated .IDL file (by the OLE/COM Object Viewer)
//
// typelib filename: EXCEL9.OLB

[uuid(00020813-0000-0000-C000-000000000046),  version(1.3),  helpstring("Microsoft Excel 9.0 Object Library"),  helpfile("VBAXL9.CHM"),  helpcontext(0x0000ffff)]
library Excel
{
    // TLib :     // TLib : Microsoft Visual Basic for Applications Extensibility 5.3 : {0002E157-0000-0000-C000-000000000046}
    importlib("VBE6EXT.OLB");
    // TLib : Microsoft Office 9.0 Object Library : {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
    importlib("MSO9.DLL");
    // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
    importlib("stdole2.tlb");

    // Forward declare all types defined in this typelib
    interface Adjustments;
    interface CalloutFormat;


But my question is, "How is that information retrieved from the typelib?"  I don't see anything obvious in the ITypeLib or ITypeInfo interfaces.  It seems to me it would be the sort of information one would retrieve through ITypeLib, being as it is info pertaining to the whole library, rather than to any interface.  But nothing obvious is jumping out at me.

Dominic Mitchell

#22
Quote
But my question is, "How is that information retrieved from the typelib?"  I don't see anything obvious
in the ITypeLib or ITypeInfo interfaces.  It seems to me it would be the sort of information one would
retrieve through ITypeLib, being as it is info pertaining to the whole library, rather than to any interface.
But nothing obvious is jumping out at me.

If you understand the format of a type library file, you can try getting the imports from the file directly.
Tony Burcham did work in that area.

http://theircorp.byethost11.com/index.php?vw=TypeLib

But I would not go that route because the information is provided by the ITypeLib and ITypeInfo interfaces.

Given a TYPEDESC, I first determine whether the vartye resolves to VT_UNKNOWN or VT_DISPATCH. If it does,
that means it has a guid associated with it.
By the way, if the vartype is VT_USERDEFINED, then you will have to do some drilling. Working with a TYPEDESC
requires a recursive function. That function will also have to deal with the cases when the TYPEATTR returns
TKIND_ALIAS and TKIND_COCLASS.

Examples of TKIND_ALIAS are IFontDisp and IPictureDisp.

Once I have a guid I test whether the interface is internal or external to the current type library.


FUNCTION IsExternalInterface _
  ( _
  BYVAL pITypeLib AS DWORD, _
        rguid     AS GUID _
  ) AS LONG

  LOCAL pITypeInfo  AS DWORD
  LOCAL hr          AS LONG
  LOCAL lRet        AS LONG

  lRet = %TRUE

  hr = ITypeLib_GetTypeInfoOfGuid(pITypeLib, rguid, pITypeInfo)
  IF hr = %S_OK THEN
    lRet = %FALSE
    ITypeInfo_Release pITypeInfo
  END IF

  FUNCTION = lRet

END FUNCTION
 

If it is external you can do a registry search or let the OS do the walking.
The GetTypeLibFromInterfaceIID function below shows one way to do the registry search.

You can let the OS do the search by using this code


      ' This is an interface - find the type library it belongs to
      ' Note: ITypeInfo::GetContainingTypeLib finds the library the interface belongs to even
      '       if it is not in the current type library.
      hr = ITypeInfo_GetContainingTypeLib(pITypeInfo, pITypeLib, dwIndex)
      IF hr = %S_OK THEN
        hr = ITypeLib_GetLibAttr(pITypeLib, pTLibAttr)
        IF hr = %S_OK THEN
          liid      = @pTLibAttr.rguid
          wMajorVer = @pTLibAttr.wMajorVerNum
          wMinorVer = @pTLibAttr.wMinorVerNum
          dwLCID    = @pTLibAttr.lcid
          ITypeLib_ReleaseTLibAttr pITypeLib, pTLibAttr
        END IF
        ITypeLib_Release pITypeLib
      END IF


The following code manually searches the registry.


'-------------------------------------------------------------------------------
'
' PROCEDURE: GetTypeLibFromIntetrfaceIID
' PURPOSE:   Returns the GUID of the type library that implements a given
'            interface.
' NOTES:     The version and LCID registry keys are in hexadecimal format.
' RETURN:    S_OK if successful, E_FAIL otherwise.
'
'-------------------------------------------------------------------------------

FUNCTION GetTypeLibFromIntetrfaceIID _
  ( _
  szIID     AS ASCIIZ, _  ' [in] interface ID
  szLIBID   AS ASCIIZ, _  ' [out] type library ID
  wMajorVer AS WORD, _    ' [out] major version
  wMinorVer AS WORD, _    ' [out] minor version
  dwLCID    AS DWORD _    ' [out] locale ID
  ) AS LONG

  LOCAL szKey       AS ASCIIZ * %MAX_PATH
  LOCAL szVersion   AS ASCIIZ * %MAX_PATH
  LOCAL szUUID      AS ASCIIZ * 64
  LOCAL tft         AS FILETIME
  LOCAL hKey        AS DWORD
  LOCAL dwIndex     AS DWORD
  LOCAL dwType      AS DWORD
  LOCAL cb          AS DWORD
  LOCAL lPos        AS LONG
  LOCAL hr          AS LONG

  hr = %E_FAIL

  wMajorVer = 0
  wMinorVer = 0

  ' Searches the HKEY_CLASSES_ROOT\Interface\<IID>\Typelib node.
  szKey = "Interface\"
  lstrcat szKey, szIID
  lstrcat szKey, "\TypeLib"
  IF RegOpenKeyEx(%HKEY_CLASSES_ROOT, szKey, 0, %KEY_QUERY_VALUE OR %KEY_ENUMERATE_SUB_KEYS, hKey) = %ERROR_SUCCESS THEN
    ' Retrrieves the Guid of the TypeLib
    szKey  = ""
    cb = SIZEOF(szUUID)
    IF RegQueryValueEx(hKey, szKey, 0, BYVAL VARPTR(dwType), BYVAL VARPTR(szUUID), BYVAL VARPTR(cb)) = %ERROR_SUCCESS THEN
      szLIBID = szUUID
      hr = %S_OK
      dwIndex = 0

      DO
        szKey = ""
        cb = SIZEOF(szKey)
        IF RegEnumValue(hKey, dwIndex, BYVAL VARPTR(szKey), BYVAL VARPTR(cb), BYVAL %NULL, BYVAL VARPTR(dwType), BYVAL VARPTR(szVersion), %MAX_PATH) <> %ERROR_SUCCESS THEN EXIT DO
        IF UCASE$(szKey) = "VERSION" THEN
          lPos = INSTR(szVersion, ".")
          IF ISTRUE lPos THEN
            wMajorVer = VAL("&h" + MID$(szVersion, 1, lPos - 1))
            wMinorVer = VAL("&h" + MID$(szVersion, lPos + 1))
          ELSE
            wMajorVer = VAL("&h" + szVersion)
            wMinorVer = 0
          END IF
          EXIT DO
        END IF
        INCR dwIndex
      LOOP

    END IF
    RegCloseKey hKey
  END IF

  IF hr = %S_OK THEN
    szKey = "TypeLib\"
    lstrcat szKey, szLIBID
    lstrcat szKey, "\"
    lstrcat szKey, szVersion
    IF RegOpenKeyEx(%HKEY_CLASSES_ROOT, szKey, 0, %KEY_QUERY_VALUE OR %KEY_ENUMERATE_SUB_KEYS, hKey) = %ERROR_SUCCESS THEN
      ' Enumerate locale ID, HELPDIR, and FLAGS
      ' and save the locale ID.
      dwIndex = 0

      DO
        cb = SIZEOF(szKey)
        IF RegEnumKeyEx(hKey, dwIndex, szKey, cb, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL, tft) <> %ERROR_SUCCESS THEN EXIT DO

        SELECT CASE UCASE$(szKey)
          CASE "FLAGS", "HELPDIR"
            ' Do nothing

          CASE ELSE
            dwLCID = VAL("&h" + szKey)
            EXIT DO
        END SELECT

        INCR dwIndex
      LOOP

      RegCloseKey hKey
    END IF
  END IF

  FUNCTION = hr

END FUNCTION

Dominic Mitchell
Phoenix Visual Designer
http://www.phnxthunder.com

Frederick J. Harris

Thank you very much Dominic.  That is exactly the information I'm looking for.  Tomorrow I'll be working on that.

Frederick J. Harris

It looks like I just gotta did for it a little more.  Darned typelibs just don't dish it up for you on a silver platter! ;D

Dominic Mitchell

After some sleep I realized that what I wrote on the vartye is confusing.
There is a group of functions(GetParameterType is one of them) in my type library that return a vartype
when passed a TYPEDESC. Given a TYPEDESC, you are not going to see a vartype of VT_UNKNOWN or VT_DISPATCH.
The vt member of the TYPEDESC would be VT_USERDEFINED, which means that you have to obtain a TYPEATTR to determine the TKIND.

Before I tie myself in knots, here are the two functions I use to figure this stuff out.


'----------------------------------------------------------------------
'
' FUNCTION: GetContainingTypeLib
' PURPOSE:  Generates the code for the creation of secondary forms.
'
'----------------------------------------------------------------------

FUNCTION GetContainingTypeLib _
  ( _
  BYVAL pITypeInfo    AS DWORD, _         ' [in]
        riid          AS GUID, _          ' [in]
        liid          AS GUID, _          ' [out]
        wMajorVer     AS WORD, _          ' [out]
        wMinorVer     AS WORD, _          ' [out]
        dwLCID        AS DWORD _          ' [out]
  ) AS LONG

  LOCAL pTLibAttr       AS TLIBATTR PTR
  LOCAL pITypeLib       AS DWORD
  LOCAL dwIndex         AS DWORD
  LOCAL hr              AS LONG

  SELECT CASE riid
    CASE $IID_IFONTDISP, $IID_IPICTUREDISP, $IID_IFONTEVENTSDISP
      liid      = $IID_STDOLE2
      wMajorVer = 2
      wMinorVer = 0
      dwLCID    = 0

    CASE $IID_IENUMVARIANT, $IID_IFONT, $IID_IPICTURE
      liid      = $IID_STDOLE2
      wMajorVer = 2
      wMinorVer = 0
      dwLCID    = 0

    CASE ELSE
      ' This is an interface - find the type library it belongs to
      ' Note: ITypeInfo::GetContainingTypeLib finds the library the interface belongs to even
      '       if it is not in the current type library.
      hr = ITypeInfo_GetContainingTypeLib(pITypeInfo, pITypeLib, dwIndex)
      IF hr = %S_OK THEN
        hr = ITypeLib_GetLibAttr(pITypeLib, pTLibAttr)
        IF hr = %S_OK THEN
          liid      = @pTLibAttr.rguid
          wMajorVer = @pTLibAttr.wMajorVerNum
          wMinorVer = @pTLibAttr.wMinorVerNum
          dwLCID    = @pTLibAttr.lcid
          ITypeLib_ReleaseTLibAttr pITypeLib, pTLibAttr
        END IF
        ITypeLib_Release pITypeLib
      END IF
  END SELECT

END FUNCTION

'----------------------------------------------------------------------
'
' FUNCTION: GetContainingTypeLibEx
' PURPOSE:  Generates the code for the creation of secondary forms.
'
'----------------------------------------------------------------------

FUNCTION GetContainingTypeLibEx _
  ( _
  BYVAL pITypeInfo    AS DWORD, _         ' [in]
  BYVAL ptdesc        AS TYPEDESC PTR, _  ' [in]
        riid          AS GUID, _          ' [out]
        liid          AS GUID, _          ' [out]
        wMajorVer     AS WORD, _          ' [out]
        wMinorVer     AS WORD, _          ' [out]
        dwLCID        AS DWORD _          ' [out]
  ) AS LONG

  LOCAL ptadesc         AS ARRAYDESC PTR
  LOCAL ptsab           AS SAFEARRAYBOUND PTR
  LOCAL pITypeInfoRef   AS DWORD
  LOCAL pTypeAttr       AS TYPEATTR PTR
  LOCAL pVardesc        AS VARDESC PTR
  LOCAL hr              AS LONG
  LOCAL n               AS WORD

  LOCAL pITypeInfo2     AS DWORD
  LOCAL pITypeInfoRef2  AS DWORD
  LOCAL pTypeAttr2      AS TYPEATTR PTR
  LOCAL reftype2        AS DWORD
  LOCAL ImplTypeFlags   AS DWORD
  LOCAL iImpl           AS DWORD
  LOCAL fBreak          AS LONG

  SELECT CASE @ptdesc.vt AND &H0FFF
    CASE %VT_PTR
      ' ptdesc->lptdesc points to a TYPEDESC that specifies the thing pointed to
      GetContainingTypeLibEx pITypeInfo, @ptdesc.tdd.lptdesc, riid, liid, wMajorVer, wMinorVer, dwLCID

    CASE %VT_CARRAY
      ' ptdesc->lpadesc points to an ARRAYDESC
      ptadesc = @ptdesc.tdd.lpadesc
      GetContainingTypeLibEx pITypeInfo, VARPTR(@ptadesc.tdescElem), riid, liid, wMajorVer, wMinorVer, dwLCID

    CASE %VT_SAFEARRAY
'    hr = ITypeInfo_GetRefTypeInfo(pITypeInfo, @ptdesc.tdd.hreftype, pITypeInfoRef)
'    IF hr = %S_OK THEN
'      ITypeInfo_Release pITypeInfoRef
'    END IF

    CASE %VT_USERDEFINED
      ' Use ptdesc->hreftype and pti->GetRefTypeInfo
      hr = ITypeInfo_GetRefTypeInfo(pITypeInfo, @ptdesc.tdd.hreftype, pITypeInfoRef)
      IF hr = %S_OK THEN
        hr = ITypeInfo_GetTypeAttr(pITypeInfoRef, pTypeAttr)
        IF hr = %S_OK THEN

          SELECT CASE @pTypeAttr.typekind
            CASE %TKIND_ALIAS
              ' IFontDisp and IPictureDisp are aliases for the Font and Picture objects respectively
              GetContainingTypeLibEx pITypeInfoRef, VARPTR(@pTypeAttr.tdescAlias), riid, liid, wMajorVer, wMinorVer, dwLCID

            CASE %TKIND_ENUM
              riid = @pTypeAttr.rguid
              GetContainingTypeLib pITypeInfoRef, riid, liid, wMajorVer, wMinorVer, dwLCID

            CASE %TKIND_DISPATCH
              riid = @pTypeAttr.rguid
              GetContainingTypeLib pITypeInfoRef, riid, liid, wMajorVer, wMinorVer, dwLCID

            CASE %TKIND_INTERFACE
              riid = @pTypeAttr.rguid
              GetContainingTypeLib pITypeInfoRef, riid, liid, wMajorVer, wMinorVer, dwLCID

            CASE %TKIND_COCLASS
              fBreak = 0
              ' Get the default interface
              iImpl = 0

              DO
                IF iImpl >= @pTypeAttr.cImplTypes THEN EXIT DO
        hr = ITypeInfo_GetRefTypeOfImplType(pITypeInfoRef, iImpl, reftype2)
        IF hr = %S_OK THEN
                  hr = ITypeInfo_GetRefTypeInfo(pITypeInfoRef, reftype2, pITypeInfoRef2)
        IF hr = %S_OK THEN
                    hr = ITypeInfo_GetTypeAttr(pITypeInfoRef2, pTypeAttr2)
                    IF hr = %S_OK THEN

                      SELECT CASE @pTypeAttr2.typekind
                        CASE %TKIND_DISPATCH
                          hr = ITypeInfo_GetImplTypeFlags(pITypeInfoRef, iImpl, implTypeFlags)
                    IF hr = %S_OK THEN
                            IF ISTRUE (ImplTypeFlags AND %IMPLTYPEFLAG_FDEFAULT) THEN
                              IF ISFALSE  (ImplTypeFlags AND %IMPLTYPEFLAG_FSOURCE) THEN
                                fBreak = -1
                                riid = @pTypeAttr2.rguid
                                GetContainingTypeLib pITypeInfoRef2, riid, liid, wMajorVer, wMinorVer, dwLCID
                              END IF
                            END IF
                          END IF

                        CASE %TKIND_INTERFACE
                          hr = ITypeInfo_GetImplTypeFlags(pITypeInfoRef, iImpl, implTypeFlags)
                    IF hr = %S_OK THEN
                            IF ISTRUE (ImplTypeFlags AND %IMPLTYPEFLAG_FDEFAULT) THEN
                              IF ISFALSE  (ImplTypeFlags AND %IMPLTYPEFLAG_FSOURCE) THEN
                                fBreak = -1
                                riid = @pTypeAttr2.rguid
                                GetContainingTypeLib pITypeInfoRef2, riid, liid, wMajorVer, wMinorVer, dwLCID
                              END IF
                            END IF
                          END IF
                      END SELECT

                      ITypeInfo_ReleaseTypeAttr pITypeInfoRef2, pTypeAttr2
                    END IF
                    ITypeInfo_Release pITypeInfoRef2
                  END IF
                END IF
                IF fBreak THEN EXIT DO
                INCR iImpl
              LOOP

            CASE %TKIND_UNION
              riid = @pTypeAttr.rguid
              GetContainingTypeLib pITypeInfoRef, riid, liid, wMajorVer, wMinorVer, dwLCID

            CASE %TKIND_RECORD
              riid = @pTypeAttr.rguid
              GetContainingTypeLib pITypeInfoRef, riid, liid, wMajorVer, wMinorVer, dwLCID
          END SELECT

          ITypeInfo_ReleaseTypeAttr pITypeInfoRef, pTypeAttr
        END IF
        ITypeInfo_Release pITypeInfoRef
      END IF
  END SELECT

END FUNCTION

Dominic Mitchell
Phoenix Visual Designer
http://www.phnxthunder.com

Dominic Mitchell

By the way, I use the following structure to keep track of what has to be and what
has been generated.


' Used to determine the type libraries for which
' include metastatements should be generated
TYPE WRITETYPELIBRARYEX ' wtlx
  fImported     AS LONG
  fDone         AS LONG
  fNew          AS LONG                   ' TRUE if a new file was added to the project
  uuid          AS GUID                   ' library ID
  dwLCID        AS DWORD
  wMajorVer     AS WORD
  wMinorVer     AS WORD
  szPrefix      AS ASCIIZ * %CBCTRLNAME
  szCLSID       AS ASCIIZ * 40
  fLoadFromFile AS LONG
  szFile        AS ASCIIZ * %MAX_PATH
  pRefId        AS GUID PTR               ' pointer to array(size cRefId) of uuids for type infos
  pRefDone      AS LONG PTR               ' pointer to array(size cRefId) of flags for type infos
  cRefId        AS LONG                   ' count of type infos in library(ITypeLib::GetTypeInfoCount)
END TYPE


Also, the value of the szPrefix member is set by the code generator. The user has no say in the name
of the prefix used for interfaces.
Dominic Mitchell
Phoenix Visual Designer
http://www.phnxthunder.com

Frederick J. Harris

Isn't Tony Burcham the fellow who was/is working on reading biff, i.e., Excel files directly instead of using COM?  I seem to vaguely remember that, as I had been a bit interested in it as I use Excel data quite a bit and Excel is rather slow what with dispinterfaces and all that. 

Anyway, what I am gathering from what you and Jose are telling me is that for virtually every interface parameter type or base class of an interface (_IMsoDispObj was what started all this) I am first going to have to try to determine if its in the present type library being analyzed, for example your IsExternalInterface() function, and if it isn't, call those additional or registry functions to locate the referenced type library?  That seems like the addition of an incredible amount of additional processing overhead for something that should be relatively simple, for example obtaining the couple import libs specified at the top of the idl file.  Just to check this I put a temporary global counter variable in my recursive function which bores through the type descriptions to get the base object type, and for the large MS Excel Type library I ended up with guess how many calls?  36842.  Here is that function...


void PrintVar(ITypeInfo* pTypInfo, TYPEDESC* pTypDesc)
{
switch(pTypDesc->vt)  // For a situation such as Connection**, pTypeDesc won't
{                     // return Connection, but rather VT_PTR, and it'll return
    case VT_PTR:       // this twice; until you call this function enough times
      {                // recursively to burrow through to a 'Connection' UDT.
         TYPEDESC* pTypeDesc=pTypDesc->lptdesc;
         if(pTypeDesc->vt==VT_PTR || pTypeDesc->vt==VT_USERDEFINED)
            PrintVar(pTypInfo, pTypeDesc);       // recursive call
         else
            PrintVarTypeFile(fp,pTypeDesc->vt);  // just output it
         fprintf(fp,"*");
      }
      break;
    case VT_USERDEFINED:
      {
         HRESULT hr;
         ITypeInfo* pRefIntTypInfo=NULL;
         hr=pTypInfo->GetRefTypeInfo(pTypDesc->hreftype,&pRefIntTypInfo);
         if(SUCCEEDED(hr))
         {
            TYPEATTR* pTypeAttr=NULL;
            hr=pRefIntTypInfo->GetTypeAttr(&pTypeAttr);
            if(SUCCEEDED(hr))
            {
               BSTR strName;
               if(pTypeAttr->typekind==TKIND_COCLASS)
               {
                  HREFTYPE pRefType;
                  ITypeInfo* pRefTypeInfo=NULL;
                  hr=pTypInfo->GetRefTypeOfImplType(0,&pRefType);
                  if(SUCCEEDED(hr))
                  {
                     hr=pTypInfo->GetRefTypeInfo(pRefType,&pRefTypeInfo);
                     if(SUCCEEDED(hr))
                     {
                        hr=pRefTypeInfo->GetDocumentation(-1,&strName,NULL,NULL,NULL);
                        fwprintf(fp,L"%s",strName);
                        pRefTypeInfo->Release();
                     }
                  }
               }
               else
               {
                  hr=pRefIntTypInfo->GetDocumentation(MEMBERID_NIL,&strName,NULL,NULL,NULL);
                  if(SUCCEEDED(hr))
                  {
                     fwprintf(fp,L"%s",strName);
                     SysFreeString(strName);
                  }
               }
            }
            pRefIntTypInfo->Release();
         }
      }
      break;
    default:
      PrintVarTypeFile(fp,pTypDesc->vt);
}
}


The idea of having to do all that just for base interfaces, as is the case with _MsoDispObj, is bad enough.  But am I not right that parameter types could also be external objects to the type library?   

Frederick J. Harris

Well, I haven't digested it all yet but I seem to be zeroing in on...


ITypeInfo::GetContainingTypeLib

HRESULT GetContainingTypeLib
(
  ITypeLib FAR* FAR*  ppTLib, 
  unsigned int FAR*  pIndex 
);

Retrieves the containing type library and the index of the type description within that type library.

Parameters

ppTLib      On return, points to the containing type library.
pIndex     On return, points to the index of the type description within the containing type library.


...as being the solution here.  That is, if I don't mind searching the typelib I'm presently doing 39587 times to see if the specific object I just got is in this type lib or not! :)  I don't know how I missed that one.  I needed to have my mind bumped in that direction I guess!  Now that's a funny function.  Both parameters are output parameters.

José Roca

#29
I only search for external interfaces if the interface that I'm parsing does not inherit directly from IUnknown or IDispatch. For PowerBASIC, I need to parse the external interface because I can't do INHERIT <external interface>, but have to include the methods of that external interface inline.

Also, the function must be recursive because that external interface could inherit from another internal or external interface.