• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 800
  • Last Modified:

[COM+] Get and Set methods for a property...

Okay, annoying problem... I have defined a COM+ component with a property and get/set methods. Here's (part of) the interface and Dispatch interface:

type
  ISettingsObj = interface(IDispatch)
    ['{E764B8F7-597B-4493-A885-45E398A7335A}']
    function Get_ValueAsString(const aSetting: WideString): WideString; safecall;
    procedure Set_ValueAsString(const aSetting: WideString; const Value: WideString); safecall;
    property ValueAsString[const aSetting: WideString]: WideString read Get_ValueAsString write Set_ValueAsString;
  end;
  ISettingsObjDisp = dispinterface
    ['{E764B8F7-597B-4493-A885-45E398A7335A}']
    property ValueAsString[const aSetting: WideString]: WideString dispid 2;
  end;

Now in my application I must get and set the roles for the get/set methods. One role can only get the values while another role can get and set these values. Should not be too difficult, either by using the COM+ Component services or by writing my own code. I open the Component services, browse to my application, to the right component, to the right interface, to the method and?
I see two methods called "ValueAsString"...

AAARGGLLLLL!!!
Now the question remains. Which one is the get method and which one the set method? Oh, well... I enumerate the methods to see if the properties tell me more and here's the result:
  ValueAsString
    Index = 12
    Name = ValueAsString
    CLSID = {21E0C8EA-AAA7-4D8A-80FD-94E66C4FBA18}
    IID = {BDCC143A-11A9-4831-8FE4-825820D59070}
    Description =
    AutoComplete = False
  ValueAsString
    Index = 13
    Name = ValueAsString
    CLSID = {21E0C8EA-AAA7-4D8A-80FD-94E66C4FBA18}
    IID = {BDCC143A-11A9-4831-8FE4-825820D59070}
    Description =
    AutoComplete = False

Okay... Except for the index they are both identical. I hoped the index would tell me a bit more so I look at the DispID in the Dispinterface and of course these values are different...
At this moment I'm glad I left my baseball bat at home or else I would need a new computer... Of course I could assume the first method is always the get method and the second one is the set method but unfortunately I miust be 100% sure about this.
Perhaps I should just open the associated type library and get the method at position [Index] or whatever but I don't have any clue about this right now...
0
Wim ten Brink
Asked:
Wim ten Brink
  • 3
  • 2
1 Solution
 
Russell LibbySoftware Engineer, Advisory Commented:

Not sure how COM+ is coming up with the indexs for the property function calls (IDispatch contains 7 calls, yours would make 8 and 9...)???... but, you should still be able to rely upon the order they are stored in the type library.

Example below. Please note that I am including an update to tlbutil which overloads the constructor to allow creating from an interface id. There are also a few other enhancements as well (like FindInterface, etc..)


Not sure if this helps or not,
Russell

var  tlLocate:   TTypeLibrary;
     tiLocate:   TInterface;
     dwIndex:    Integer;
     szProp:     String;
     szGuid:     String;
begin

  szGuid:='{BDCC143A-11A9-4831-8FE4-825820D59070}';
  szProp:='ValueAsString';

  tlLocate:=nil;
  try
     // Create interface using interface ID. This relies upon type
     // library information being available for the interface
     tlLocate:=TTypeLibrary.Create(StringToGuid(szGuid));
     // Locate the desired interface
     tiLocate:=tlLocate.FindInterface(StringToGuid(szGuid));
     // Make sure it was found
     if Assigned(tiLocate) then
     begin
        // Walk the properties
        for dwIndex:=0 to Pred(tiLocate.PropertyCount) do
        begin
           // Check for name of property
           if (CompareText(szProp, tiLocate.Properties[dwIndex].Name) = 0) then
           begin
              // Determine if getter or setter comes first
              if tiLocate.Properties[dwIndex].CanWrite then
                 ShowMessage('Setter comes first')
              else
                 ShowMessage('Getter comes first');
              // Break loop
              break;
           end;
        end;
     end;
  finally
     tlLocate.Free;
  end;

end;

----

unit tlbutil;
////////////////////////////////////////////////////////////////////////////////
//
//   TTypeLibrary
//      |
//      |_ TCoClass (TTypeClass)
//      |  |_ TCoMember (Interfaces)
//      |_ TInterface (TTypeClass)
//      |  |_ TMember (Properties and Functions)
//      |     |_ TComDataType (Params and result Value)
//      |_ TEnum (TTypeClass)
//      |  |_ TComDataType (Values)
//      |_ TRecord (TTypeClass)
//      |  |_ TComDataType (Fields)
//      |_ TAlias (TTypeClass)
//      |  |_ TComDataType (AliasType)
//      |_ TModules (TTypeClass)
//         |_ TMember (Functions)
//            |_ TComDataType (Params and result Value)
//
////////////////////////////////////////////////////////////////////////////////
interface

uses
  Windows, SysUtils, Classes, Contnrs, ActiveX, ComObj;

// Data type names
const
  DATA_TYPE_NAMES:  Array [0..31] of String =
                    ('',        '',         'SmallInt', 'Integer',  'Single',   'Double',   'Currency', 'Date',
                     'String',  'IDispatch','Integer',  'Boolean',  'Variant',  'IUnknown', 'Decimal',   '',
                     'Char',    'Byte',     'Word',     'LongWord', 'Int64',    'Int64',    'Integer',  'LongWord',
                     'Void',    'HResult',  'Pointer',  'Array',    'Array',    'Type',     'PChar',    'PWideChar');

// Array bound type
type
  PArrayBound       =  ^TArrayBound;
  TArrayBound       =  packed record
     lBound:        Integer;
     uBound:        Integer;
  end;

// Com data type class
type
  TComDataType      =  class(TObject)
  private
     // Private declarations
     FVT:           Integer;
     FIsOptional:   Boolean;
     FConstValue:   Integer;
     FName:         String;
     FIsUserDefined:Boolean;
     FIsArray:      Boolean;
     FBounds:       TList;
     FGuid:         TGUID;
  protected
     // Protected declarations
     function       GetDataTypeName: String;
     function       GetBoundsCount: Integer;
     function       GetBounds(Index: Integer): TArrayBound;
     procedure      SetName(Value: String);
     procedure      SetVT(Value: Integer);
     procedure      SetIsUserDefined(Value: Boolean);
     procedure      SetIsArray(Value: Boolean);
     procedure      AddBound(LowBound, HiBound: Integer);
  public
     // Public declarations
     constructor    Create;
     destructor     Destroy; override;
     property       Name: String read FName;
     property       DataType: Integer read FVT;
     property       DataTypeName: String read GetDataTypeName;
     property       IsArray: Boolean read FIsArray;
     property       IsUserDefined: Boolean read FIsUserDefined;
     property       IsOptional: Boolean read FIsOptional;
     property       BoundsCount: Integer read GetBoundsCount;
     property       Bounds[Index: Integer]: TArrayBound read GetBounds;
     property       UserDefinedRef: TGUID read FGuid;
     property       ConstValue: Integer read FConstValue;
  end;

// Base class for all type information based objects
type
  TTypeClass        =  class(TObject)
  private
     // Private declarations
     FLoaded:       Boolean;
     FGuid:         TGUID;
     FName:         String;
     FTypeInfo:     ITypeInfo;
  protected
     // Protected declarations
     procedure      LoadBaseInfo;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; virtual;
     property       Loaded: Boolean read FLoaded;
     property       Guid: TGUID read FGuid;
     property       Name: String read FName;
  end;

// Alias type info object
type
  TAlias            =  class(TTypeClass)
  private
     // Private declarations
     FAliasType:   TComDataType;
  protected
     // Protected declarations
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; override;
     property       AliasType: TComDataType read FAliasType;
  end;

// Record type info object
type
  TRecord           =  class(TTypeClass)
  private
     // Private declarations
     FFields:       TObjectList;
  protected
     // Protected declarations
     function       GetFields(Index: Integer): TComDataType;
     function       GetFieldCount: Integer;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; override;
     property       Fields[Index: Integer]: TComDataType read GetFields;
     property       FieldCount: Integer read GetFieldCount;
  end;

// Enumeration type info object
type
  TEnum             =  class(TTypeClass)
  private
     // Private declarations
     FValues:       TObjectList;
  protected
     // Protected declarations
     function       GetValues(Index: Integer): TComDataType;
     function       GetValueCount: Integer;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; override;
     property       Values[Index: Integer]: TComDataType read GetValues;
     property       ValueCount: Integer read GetValueCount;
  end;

// Member type class for interface functions and properties
type
  TMember           =  class(TObject)
  private
     // Private declarations
     FID:           Integer;
     FIsDispatch:   Boolean;
     FIsHidden:     Boolean;
     FName:         String;
     FParams:       TObjectList;
     FValue:        TComDataType;
     FCanRead:      Boolean;
     FCanWrite:     Boolean;
  protected
     // Protected declarations
     procedure      Load(TypeInfo: ITypeInfo; VarDesc: PVarDesc; Index: Integer); overload;
     procedure      Load(TypeInfo: ITypeInfo; FuncDesc: PFuncDesc; Index: Integer); overload;
     function       GetParam(Index: Integer): TComDataType;
     function       GetParamCount: Integer;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo; FuncDesc: PFuncDesc; Index: Integer); overload;
     constructor    Create(TypeInfo: ITypeInfo; VarDesc: PVarDesc; Index: Integer); overload;
     destructor     Destroy; override;
     property       ID: Integer read FID;
     property       IsDispatch: Boolean read FIsDispatch;
     property       IsHidden: Boolean read FIsHidden;
     property       Name: String read FName;
     property       Params[Index: Integer]: TComDataType read GetParam;
     property       ParamCount: Integer read GetParamCount;
     property       CanRead: Boolean read FCanRead;
     property       CanWrite: Boolean read FCanWrite;
     property       Value: TComDataType read FValue;
  end;

// Interface type info object
type
  TInterface        =  class(TTypeClass)
  private
     // Private declarations
     FIsDispatch:   Boolean;
     FProperties:   TObjectList;
     FFunctions:    TObjectList;
  protected
     // Protected declarations
     procedure      LoadVariables;
     procedure      LoadMembers;
     function       GetProperty(Index: Integer): TMember;
     function       GetFunction(Index: Integer): TMember;
     function       GetPropertyCount: Integer;
     function       GetFunctionCount: Integer;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; override;
     property       IsDispatch: Boolean read FIsDispatch;
     property       Properties[Index: Integer]: TMember read GetProperty;
     property       PropertyCount: Integer read GetPropertyCount;
     property       Functions[Index: Integer]: TMember read GetFunction;
     property       FunctionCount: Integer read GetFunctionCount;
  end;

// CoClass member type class
type
  TCoMember           =  class(TObject)
  private
     // Private declarations
     FGuid:         TGUID;
     FName:         String;
     FIsDispatch:   Boolean;
     FIsDefault:    Boolean;
     FIsSource:     Boolean;
     FCanCreate:    Boolean;
  protected
     // Protected declarations
  public
     // Public declarations
     constructor    Create;
     destructor     Destroy; override;
     property       Guid: TGUID read FGuid;
     property       IsDispatch: Boolean read FIsDispatch;
     property       IsDefault: Boolean read FIsDefault;
     property       IsSource: Boolean read FIsSource;
     property       CanCreate: Boolean read FCanCreate;
     property       Name: String read FName;
  end;

// CoClass type info object
type
  TCoClass          =  class(TTypeClass)
  private
     // Private declarations
     FInterfaces:   TObjectList;
  protected
     // Protected declarations
     function       GetInterface(Index: Integer): TCoMember;
     function       GetInterfaceCount: Integer;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; override;
     property       Interfaces[Index: Integer]: TCoMember read GetInterface;
     property       InterfaceCount: Integer read GetInterfaceCount;
  end;

// TModule type info object
type
  TModule           =  class(TTypeClass)
  private
     // Private declarations
     FFunctions:    TObjectList;
  protected
     // Protected declarations
     function       GetFunction(Index: Integer): TMember;
     function       GetFunctionCount: Integer;
  public
     // Public declarations
     constructor    Create(TypeInfo: ITypeInfo);
     destructor     Destroy; override;
     procedure      Load; override;
  end;

// Type library wrapper object
type
  TTypeLibrary      =  class(TObject)
  private
     // Private declarations
     FTypeLib:      ITypeLib;
     FGuid:         TGUID;
     FName:         String;
     FDescription:  String;
     FModules:      TObjectList;
     FCoClasses:    TObjectList;
     FInterfaces:   TObjectList;
     FRecords:      TObjectList;
     FAliases:      TObjectList;
     FEnums:        TObjectList;
  protected
     // Protected declarations
     function       GetModule(Index: Integer): TModule;
     function       GetCoClass(Index: Integer): TCoClass;
     function       GetInterface(Index: Integer): TInterface;
     function       GetRecord(Index: Integer): TRecord;
     function       GetEnum(Index: Integer): TEnum;
     function       GetAlias(Index: Integer): TAlias;
     function       GetCoClassCount: Integer;
     function       GetInterfaceCount: Integer;
     function       GetRecordCount: Integer;
     function       GetEnumCount: Integer;
     function       GetAliasCount: Integer;
     function       GetModuleCount: Integer;
     procedure      LoadTypeLibrary;
     procedure      Load(TypeLibrary: String); overload;
     procedure      Load(IID: TGUID); overload;
  public
     // Public declarations
     constructor    Create(TypeLibrary: String); overload;
     constructor    Create(IID: TGUID); overload;
     destructor     Destroy; override;
     function       FindInterface(Guid: TGUID): TInterface;
     property       Name: String read FName;
     property       Description: String read FDescription;
     property       Guid: TGUID read FGuid;
     property       CoClasses[Index: Integer]: TCoClass read GetCoClass;
     property       CoClassCount: Integer read GetCoClassCount;
     property       Interfaces[Index: Integer]: TInterface read GetInterface;
     property       InterfaceCount: Integer read GetInterfaceCount;
     property       Records[Index: Integer]: TRecord read GetRecord;
     property       RecordCount: Integer read GetRecordCount;
     property       Enums[Index: Integer]: TEnum read GetEnum;
     property       EnumCount: Integer read GetEnumCount;
     property       Aliases[Index: Integer]: TAlias read GetAlias;
     property       AliasCount: Integer read GetAliasCount;
     property       Modules[Index: Integer]: TModule read GetModule;
     property       ModuleCount: Integer read GetModuleCount;
  end;

// Type utils exception type
type
  ETypeUtilException=  class(Exception);

// Resource strings
resourcestring
  resTypeInfoNil    =  'TypeInfo must be a non-nil interface pointer';
  resRegInfoFail    =  'Failed to load the required information from the registry';

// Utility functions
procedure  LoadDataType(TypeInfo: ITypeInfo; Description: TTypeDesc; DataType: TComDataType); overload;
procedure  LoadDataType(TypeInfo: ITypeInfo; Description: TElemDesc; DataType: TComDataType); overload;

////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////

// TModule
procedure TModule.Load;
var  ptAttr:     PTypeAttr;
     pfDesc:     PFuncDesc;
     dwCount:    Integer;
begin

  // Check loaded state
  if FLoaded then exit;

  // Get type info attributes
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Add properties and methods
     for dwCount:=0 to Pred(ptAttr^.cFuncs) do
     begin
        // Get the function description
        if (FTypeInfo.GetFuncDesc(dwCount, pfDesc) = S_OK) then
        begin
           // The member will load itself
           FFunctions.Add(TMember.Create(FTypeInfo, pfDesc, dwCount));
           // Release the function description
           FTypeInfo.ReleaseFuncDesc(pfDesc);
        end;
     end;
     // Release the type attributes
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

  // Perform inherited (sets the loaded state)
  inherited Load;

end;

function TModule.GetFunction(Index: Integer): TMember;
begin

  // Return the object
  result:=TMember(FFunctions[Index]);

end;

function TModule.GetFunctionCount: Integer;
begin

  // Return the count
  result:=FFunctions.Count;

end;

constructor TModule.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create(TypeInfo);

  // Set starting defaults
  FFunctions:=TObjectList.Create;
  FFunctions.OwnsObjects:=True;

end;

destructor TModule.Destroy;
begin

  // Free the function list
  FFunctions.Free;

  // Perform inherited
  inherited Destroy;

end;

// TCoClass
procedure TCoClass.Load;
var  ptAttr1:    PTypeAttr;
     ptAttr2:    PTypeAttr;
     ptInfo:     ITypeInfo;
     pwName:     PWideChar;
     cmbrInt:    TCoMember;
     hrType:     HRefType;
     dwFlags:    Integer;
     dwCount:    Integer;
begin

  // Check loaded state
  if FLoaded then exit;

  // Load the CoClass default and source interfaces
  if (FTypeInfo.GetTypeAttr(ptAttr1) = S_OK) then
  begin
     // Iterate the vars of the enumeration
     for dwCount:=0 to Pred(ptAttr1^.cImplTypes) do
     begin
        // Get the reference type via the index
        if (FTypeInfo.GetRefTypeOfImplType(dwCount, hrType) = S_OK) then
        begin
           // Get implemented type for this interface
           if (FTypeInfo.GetImplTypeFlags(dwCount, dwFlags) = S_OK) then
           begin
              // Get the type info so we can get the name
              if (FTypeInfo.GetRefTypeInfo(hrType, ptInfo) = S_OK) then
              begin
                 // Get the attributes
                 if (ptInfo.GetTypeAttr(ptAttr2) = S_OK) then
                 begin
                    // Create the coclass member
                    cmbrInt:=TCoMember.Create;
                    cmbrInt.FGuid:=ptAttr2^.guid;
                    // Get the name
                    if (ptInfo.GetDocumentation(MEMBERID_NIL, @pwName, nil, nil, nil) = S_OK) then
                    begin
                       // Name
                       if Assigned(pwName) then
                       begin
                          cmbrInt.FName:=OleStrToString(pwName);
                          SysFreeString(pwName);
                       end;
                    end;
                    // Get the kind
                    cmbrInt.FIsDispatch:=(ptAttr2^.typekind = TKIND_DISPATCH);
                    // Get default and source flags
                    cmbrInt.FIsDefault:=((dwFlags and IMPLTYPEFLAG_FDEFAULT) > 0);
                    cmbrInt.FIsSource:=((dwFlags and IMPLTYPEFLAG_FSOURCE) > 0);
                    cmbrInt.FCanCreate:=((ptAttr2^.wTypeFlags and TYPEFLAG_FCANCREATE) > 0);
                    // Add to interface member list
                    FInterfaces.Add(cmbrInt);
                    // Release the type info attributes
                    ptInfo.ReleaseTypeAttr(ptAttr2);
                 end;
                 // Release the type info
                 ptInfo:=nil;
              end;
           end;
        end;
     end;
     // Release the type attr
     FTypeInfo.ReleaseTypeAttr(ptAttr1);
  end;

  // Perform inherited (sets the loaded state)
  inherited Load;

end;

function TCoClass.GetInterface(Index: Integer): TCoMember;
begin

  // Return the object
  result:=TCoMember(FInterfaces[Index]);

end;

function TCoClass.GetInterfaceCount: Integer;
begin

  // Return the count
  result:=FInterfaces.Count;

end;

constructor TCoClass.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create(TypeInfo);

  // Create member list
  FInterfaces:=TObjectList.Create;
  FInterfaces.OwnsObjects:=True;

end;

destructor TCoClass.Destroy;
begin

  // Free the member list
  FInterfaces.Free;

  // Perform inherited
  inherited Destroy;

end;

// TCoMember
constructor TCoMember.Create;
begin

  // Perform inherited
  inherited Create;

  // Set starting defaults
  FGuid:=GUID_NULL;
  FName:='';
  FIsDispatch:=False;
  FIsDefault:=False;
  FIsSource:=False;
  FCanCreate:=False;

end;

destructor TCoMember.Destroy;
begin

  // Perform inherited
  inherited Destroy;

end;

// TMember
procedure TMember.Load(TypeInfo: ITypeInfo; VarDesc: PVarDesc; Index: Integer);
var  pwName:     PWideChar;
begin

  // Set the ID (for dispatch based items)
  FIsDispatch:=(VarDesc^.varkind = VAR_DISPATCH);
  if FIsDispatch then
     FID:=VarDesc^.memid
  else
     FID:=0;

  // Get the name
  if (TypeInfo.GetDocumentation(VarDesc^.memid, @pwName, nil, nil, nil) = S_OK) then
  begin
     // Name
     if Assigned(pwName) then
     begin
        FName:=OleStrToString(pwName);
        SysFreeString(pwName);
     end;
  end;

  // Is this read only, or read write
  FCanWrite:=((VarDesc^.wVarFlags and VARFLAG_FREADONLY) = 0);

  // Load the data type info
  LoadDataType(TypeInfo, VarDesc^.elemdescVar, FValue);

  // Determine if member is hidden
  FIsHidden:=((VarDesc^.wVarFlags and VARFLAG_FHIDDEN) > 0);

end;

procedure TMember.Load(TypeInfo: ITypeInfo; FuncDesc: PFuncDesc; Index: Integer);
var  pwName:     PWideChar;
     pwNames:    PBStrList;
     cdtParam:   TComDataType;
     dwNames:    Integer;
     dwParams:   Integer;
     dwCount:    Integer;
begin

  // Set the ID (for dispatch based items)
  FIsDispatch:=(FuncDesc^.funckind = FUNC_DISPATCH);
  if FIsDispatch then
     FID:=FuncDesc^.memid
  else
     FID:=0;

  // Get the name
  if (TypeInfo.GetDocumentation(FuncDesc^.memid, @pwName, nil, nil, nil) = S_OK) then
  begin
     // Name
     if Assigned(pwName) then
     begin
        FName:=OleStrToString(pwName);
        SysFreeString(pwName);
     end;
  end;

  // Is this read only, or read write
  case FuncDesc^.invkind  of
     INVOKE_FUNC           :
     begin
        // Doesnt make sense for functions
        FCanRead:=False;
        FCanWrite:=False;
     end;
     INVOKE_PROPERTYGET    : FCanWrite:=False;
     INVOKE_PROPERTYPUT    : FCanRead:=False;
     INVOKE_PROPERTYPUTREF : FCanRead:=False;
  end;

  // Load the params for the functions
  dwParams:=FuncDesc^.cParams;
  Inc(dwParams);
  if (dwParams > 1) and (FuncDesc^.invkind in [INVOKE_PROPERTYPUT, INVOKE_PROPERTYPUTREF]) then Dec(dwParams);

  // Allocate string array large enough for the names
  pwNames:=AllocMem(dwParams * SizeOf(POleStr));

  // Get the names
  dwNames:=0;
  if (TypeInfo.GetNames(FuncDesc^.memid, pwNames, Succ(FuncDesc^.cParams), dwNames) = S_OK) then
  begin
     // Make sure all name entries are allocated (even if we have to do it ourselves)
     for dwCount:=dwNames to Pred(dwParams) do pwNames[dwCount]:=StringToOleStr(Format('Param%d', [dwCount]));
     // Need to decrease the cParams by 2. One is to account for the fact that we
     // got the member name in the string array, the other is to account for the
     // fact that the list is zero based
     Dec(dwParams, 2);
     // Build up the parameter list
     for dwCount:=0 to dwParams do
     begin
        // Create the parameter
        cdtParam:=TComDataType.Create;
        // Set the name
        cdtParam.FName:=OleStrToString(pwNames[Succ(dwCount)]);
        // Load the data type
        LoadDataType(TypeInfo, FuncDesc^.lprgelemdescParam[dwCount], cdtParam);
        // Determine if optional
        cdtParam.FIsOptional:=((FuncDesc^.lprgelemdescParam[dwCount].paramdesc.wParamFlags and PARAMFLAG_FOPT) > 0);
        // Add to the parameter list
        FParams.Add(cdtParam);
     end;
  end;

  // Free the strings
  for dwCount:=0 to Succ(dwParams) do SysFreeString(pwNames[dwCount]);

  // Free the string array
  FreeMem(pwNames);

  // Set the return type for the function/property
  case FuncDesc^.invkind  of
     INVOKE_FUNC          :  LoadDataType(TypeInfo, FuncDesc^.elemdescFunc, FValue);
     INVOKE_PROPERTYGET   :
     begin
        if not(FIsDispatch) and (FuncDesc^.cParams > 0) then
           LoadDataType(TypeInfo, FuncDesc^.lprgelemdescParam[Pred(FuncDesc^.cParams)], FValue)
        else
           LoadDataType(TypeInfo, FuncDesc^.elemdescFunc, FValue);
     end;
     INVOKE_PROPERTYPUT,
     INVOKE_PROPERTYPUTREF:
     begin
        // cParams MUST be at least one
        LoadDataType(TypeInfo, FuncDesc^.lprgelemdescParam[Pred(FuncDesc^.cParams)], FValue);
     end
  end;

end;

function TMember.GetParam(Index: Integer): TComDataType;
begin

  // Return the object
  result:=TComDataType(FParams[Index]);

end;

function TMember.GetParamCount: Integer;
begin

  // Return the count
  result:=FParams.Count;

end;

constructor TMember.Create(TypeInfo: ITypeInfo; VarDesc: PVarDesc; Index: Integer);
begin

  // Perform inherited
  inherited Create;

  // Create the object list
  FID:=0;
  FName:='';
  FParams:=TObjectList.Create;
  FParams.OwnsObjects:=true;
  FValue:=TComDataType.Create;
  FCanRead:=True;
  FCanWrite:=True;
  FIsDispatch:=False;
  FIsHidden:=False;

  // Load the member information
  Load(TypeInfo, VarDesc, Index);

end;

constructor TMember.Create(TypeInfo: ITypeInfo; FuncDesc: PFuncDesc; Index: Integer);
begin

  // Perform inherited
  inherited Create;

  // Create the object list
  FID:=0;
  FName:='';
  FParams:=TObjectList.Create;
  FParams.OwnsObjects:=true;
  FValue:=TComDataType.Create;
  FCanRead:=True;
  FCanWrite:=True;
  FIsDispatch:=False;
  FIsHidden:=False;

  // Load the member information
  Load(TypeInfo, FuncDesc, Index);

end;

destructor TMember.Destroy;
begin

  // Free the parameter list
  FParams.Free;

  // Free the value type
  FValue.Free;

  // Perform inherited
  inherited Destroy;

end;

// TInterface
procedure TInterface.LoadMembers;
var  ptAttr:     PTypeAttr;
     pfDesc:     PFuncDesc;
     dwCount:    Integer;
begin

  // Get type info attributes
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Add properties and methods
     for dwCount:=0 to Pred(ptAttr^.cFuncs) do
     begin
        // Get the function description
        if (FTypeInfo.GetFuncDesc(dwCount, pfDesc) = S_OK) then
        begin
           // Check the invokation kind
           if (pfDesc^.invkind = INVOKE_FUNC) then
              // The member will load itself
              FFunctions.Add(TMember.Create(FTypeInfo, pfDesc, dwCount))
           else
              // The member will load itself
              FProperties.Add(TMember.Create(FTypeInfo, pfDesc, dwCount));
           // Release the function description
           FTypeInfo.ReleaseFuncDesc(pfDesc);
        end;
     end;
     // Release the type attributes
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

end;

procedure TInterface.LoadVariables;
var  ptAttr:     PTypeAttr;
     pvDesc:     PVarDesc;
     dwCount:    Integer;
begin

  // Get type info attributes
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Add variables (which are properties)
     for dwCount:=0 to Pred(ptAttr^.cVars) do
     begin
        // Get the var description
        if (FTypeInfo.GetVarDesc(dwCount, pvDesc) = S_OK) then
        begin
           // Create the property member
           FProperties.Add(TMember.Create(FTypeInfo, pvDesc, dwCount));
           // Release the var desc
           FTypeInfo.ReleaseVarDesc(pvDesc);
        end;
     end;
     // Release the type attributes
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

end;

procedure TInterface.Load;
var  ptAttr:     PTypeAttr;
begin

  // Check loaded state
  if FLoaded then exit;

  // Get base information for the interface
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Check the tkind
     FIsDispatch:=(ptAttr^.typekind = TKIND_DISPATCH);
     // Release the type attr
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

  // Load the variables
  LoadVariables;

  // Load the members (functions/properties)
  LoadMembers;

  // Perform inherited (sets the loaded state)
  inherited Load;

end;

function TInterface.GetProperty(Index: Integer): TMember;
begin

  // Return object
  result:=TMember(FProperties[Index]);

end;

function TInterface.GetFunction(Index: Integer): TMember;
begin

  // Return the object
  result:=TMember(FFunctions[Index]);

end;

function TInterface.GetPropertyCount: Integer;
begin

  // Return the count
  result:=FProperties.Count;

end;

function TInterface.GetFunctionCount: Integer;
begin

  // Return the count
  result:=FFunctions.Count;

end;

constructor TInterface.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create(TypeInfo);

  // Set starting defaults
  FIsDispatch:=False;
  FProperties:=TObjectList.Create;
  FProperties.OwnsObjects:=True;
  FFunctions:=TObjectList.Create;
  FFunctions.OwnsObjects:=True;

end;

destructor TInterface.Destroy;
begin

  // Free the object lists
  FProperties.Free;
  FFunctions.Free;

  // Perform inherited
  inherited Destroy;

end;

// TEnum
procedure TEnum.Load;
var  ptAttr:     PTypeAttr;
     pvDesc:     PVarDesc;
     pwName:     PWideChar;
     cdtValue:   TComDataType;
     dwCount:    Integer;
begin

  // Bail if loaded
  if FLoaded then exit;

  // Load the constant values
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Iterate the vars of the record
     for dwCount:=0 to Pred(ptAttr^.cVars) do
     begin
        // Get the var description
        if (FTypeInfo.GetVarDesc(dwCount, pvDesc) = S_OK) then
        begin
           // Create the value data object
           cdtValue:=TComDataType.Create;
           // Get documentation
           if (FTypeInfo.GetDocumentation(pvDesc^.memid, @pwName, nil, nil, nil) = S_OK) then
           begin
              // Name
              if Assigned(pwName) then
              begin
                 cdtValue.FName:=OleStrToString(pwName);
                 SysFreeString(pwName);
              end;
           end;
           // Constant value
           cdtValue.FVT:=pvDesc^.varkind;
           cdtValue.FConstValue:=pvDesc^.lpvarValue^;
           // Add to the value list
           FValues.Add(cdtValue);
           // Release the var desc
           FTypeInfo.ReleaseVarDesc(pvDesc);
        end;
     end;
     // Release the type attr
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

  // Perform inherited (sets the loaded state)
  inherited Load;

end;

function TEnum.GetValues(Index: Integer): TComDataType;
begin

  // Return the value field
  result:=TComDataType(FValues[Index]);

end;

function TEnum.GetValueCount: Integer;
begin

  // Return count
  result:=FValues.Count;

end;

constructor TEnum.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create(TypeInfo);

  // Set starting defaults
  FValues:=TObjectList.Create;
  FValues.OwnsObjects:=True;
 
end;

destructor TEnum.Destroy;
begin

  // Free the value list
  FValues.Free;

  // Perform inherited
  inherited Destroy;

end;

// TRecord
procedure TRecord.Load;
var  ptAttr:     PTypeAttr;
     pvDesc:     PVarDesc;
     pwName:     PWideChar;
     cdtField:   TComDataType;
     dwCount:    Integer;
begin

  // Bail if loaded
  if FLoaded then exit;

  // Load the fields
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Iterate the vars of the record
     for dwCount:=0 to Pred(ptAttr^.cVars) do
     begin
        // Get the var description
        if (FTypeInfo.GetVarDesc(dwCount, pvDesc) = S_OK) then
        begin
           // Create the field data object
           cdtField:=TComDataType.Create;
           // Get documentation
           if (FTypeInfo.GetDocumentation(pvDesc^.memid, @pwName, nil, nil, nil) = S_OK) then
           begin
              // Name
              if Assigned(pwName) then
              begin
                 cdtField.FName:=OleStrToString(pwName);
                 SysFreeString(pwName);
              end;
           end;
           // Load the data type info
           LoadDataType(FTypeInfo, pvDesc^.elemdescVar, cdtField);
           // Add to the field list
           FFields.Add(cdtField);
           // Release the var desc
           FTypeInfo.ReleaseVarDesc(pvDesc);
        end;
     end;
     // Release the type attr
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

  // Perform inherited (sets the loaded state)
  inherited Load;

end;

function TRecord.GetFields(Index: Integer): TComDataType;
begin

  // Return the data field
  result:=TComDataType(FFields[Index]);

end;

function TRecord.GetFieldCount: Integer;
begin

  // Return the count
  result:=FFields.Count;

end;

constructor TRecord.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create(TypeInfo);

  // Set starting defaults
  FFields:=TObjectList.Create;
  FFields.OwnsObjects:=True;

end;

destructor TRecord.Destroy;
begin

  // Free the field list
  FFields.Free;

  // Perform inherited
  inherited Destroy;

end;

// TAlias
procedure TAlias.Load;
var  ptAttr:     PTypeAttr;
begin

  // Bail if already loaded
  if FLoaded then exit;

  // Get the type info attributes
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Get the data type that this describes
     LoadDataType(FTypeInfo, ptAttr^.tdescAlias, FAliasType);
     // Release the type info attr
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

  // Perform inherited (sets the loaded state)
  inherited Load;

end;

constructor TAlias.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create(TypeInfo);

  // Set starting defaults
  FAliasType:=TComDataType.Create;

end;

destructor TAlias.Destroy;
begin

  // Free the alias data type
  FAliasType.Free;

  // Perform inherited
  inherited Destroy;

end;

// TTypeClass
procedure TTypeClass.LoadBaseInfo;
var  ptAttr:     PTypeAttr;
     pwName:     PWideChar;
begin

  // Get the class name
  if (FTypeInfo.GetDocumentation(MEMBERID_NIL, @pwName, nil, nil, nil) = S_OK) then
  begin
     // Name
     if Assigned(pwName) then
     begin
        FName:=OleStrToString(pwName);
        SysFreeString(pwName);
     end;
  end;

  // Get the type info attributes
  if (FTypeInfo.GetTypeAttr(ptAttr) = S_OK) then
  begin
     // Set the guid
     FGuid:=ptAttr^.guid;
     // Release the pointer to the attributes
     FTypeInfo.ReleaseTypeAttr(ptAttr);
  end;

end;

procedure TTypeClass.Load;
begin

  // Set the loaded flag
  FLoaded:=True;

end;

constructor TTypeClass.Create(TypeInfo: ITypeInfo);
begin

  // Perform inherited
  inherited Create;

  // Check for nil being passed
  if Assigned(TypeInfo) then
     FTypeInfo:=TypeInfo
  else
     raise ETypeUtilException.CreateRes(@resTypeInfoNil);

  // Set starting defaults
  FLoaded:=False;
  FGuid:=GUID_NULL;
  FName:='';

  // Load the base type information
  LoadBaseInfo;

end;

destructor TTypeClass.Destroy;
begin

  // Release the type info
  FTypeInfo:=nil;

  // Perform inherited
  inherited Destroy;

end;

// TTypeLibrary
function TTypeLibrary.GetModule(Index: Integer): TModule;
begin

  // Return object
  result:=TModule(FModules[Index]);

  // Load the object
  result.Load;

end;

function TTypeLibrary.GetCoClass(Index: Integer): TCoClass;
begin

  // Return object
  result:=TCoClass(FCoClasses[Index]);

  // Load the object
  result.Load;

end;

function TTypeLibrary.GetInterface(Index: Integer): TInterface;
begin

  // Return object
  result:=TInterface(FInterfaces[Index]);

  // Load the object
  result.Load;

end;

function TTypeLibrary.GetRecord(Index: Integer): TRecord;
begin

  // Return object
  result:=TRecord(FRecords[Index]);

  // Load the object
  result.Load;

end;

function TTypeLibrary.GetEnum(Index: Integer): TEnum;
begin

  // Return object
  result:=TEnum(FEnums[Index]);

  // Load the object
  result.Load;

end;

function TTypeLibrary.GetAlias(Index: Integer): TAlias;
begin

  // Return object
  result:=TAlias(FAliases[Index]);

  // Load the object
  result.Load;

end;

function TTypeLibrary.GetCoClassCount: Integer;
begin

  // Return count
  result:=FCoClasses.Count;

end;

function TTypeLibrary.GetModuleCount: Integer;
begin

  // Return count
  result:=FModules.Count;

end;

function TTypeLibrary.GetInterfaceCount: Integer;
begin

  // Return count
  result:=FInterfaces.Count;

end;

function TTypeLibrary.GetRecordCount: Integer;
begin

  // Return count
  result:=FRecords.Count;

end;

function TTypeLibrary.GetEnumCount: Integer;
begin

  // Return count
  result:=FEnums.Count;

end;

function TTypeLibrary.GetAliasCount: Integer;
begin

  // Return count
  result:=FAliases.Count;

end;

function TTypeLibrary.FindInterface(Guid: TGUID): TInterface;
var  dwIndex:    Integer;
begin

  // Attempt to locate the interface, this will not load the interfaces
  // unless we find the one we are after. This works because the parent class
  // for all of the sub objects sets the GUID and Name on creation

  // Default result
  result:=nil;

  // Walk the list
  for dwIndex:=0 to Pred(FInterfaces.Count) do
  begin
     // Check guid's
     if IsEqualGUID(Guid, TInterface(FInterfaces[dwIndex]).Guid) then
     begin
        // Set the result
        result:=TInterface(FInterfaces[dwIndex]);
        // Load the object information
        result.Load;
        // Done
        break;
     end;
  end;

end;

procedure TTypeLibrary.LoadTypeLibrary;
var  pwName:     PWideChar;
     pwDesc:     PWideChar;
     ptlAttr:    PTLibAttr;
     ptAttr:     PTypeAttr;
     ptInfo:     ITypeInfo;
     dwCount:    Integer;
begin

  // Get the type library name
  if (FTypeLib.GetDocumentation(-1, @pwName, @pwDesc, nil, nil) = S_OK) then
  begin
     // Name
     if Assigned(pwName) then
     begin
        FName:=OleStrToString(pwName);
        SysFreeString(pwName);
     end;
     // Description
     if Assigned(pwDesc) then
     begin
        FDescription:=OleStrToString(pwDesc);
        SysFreeString(pwDesc);
     end;
  end;

  // Get the guid
  if (FTypeLib.GetLibAttr(ptlAttr) = S_OK) then
  begin
     FGuid:=ptlAttr^.Guid;
     // Release the library attr
     FTypeLib.ReleaseTLibAttr(ptlAttr);
  end;

  // Get the type info count in the library
  for dwCount:=0 to Pred(FTypeLib.GetTypeInfoCount) do
  begin;
     // Get the type info at the given index
     if (FTypeLib.GetTypeInfo(dwCount, ptInfo) = S_OK) then
     begin
        // Get the type info attribute
        if (ptInfo.GetTypeAttr(ptAttr) = S_OK) then
        begin
           // Create the desired sub object
           case ptAttr.typekind of
              TKIND_ENUM     :  FEnums.Add(TEnum.Create(ptInfo));
              TKIND_RECORD   :  FRecords.Add(TRecord.Create(ptInfo));
              TKIND_MODULE   :  FModules.Add(TModule.Create(ptInfo));
              TKIND_INTERFACE,
              TKIND_DISPATCH :  FInterfaces.Add(TInterface.Create(ptInfo));
              TKIND_COCLASS  :  FCoClasses.Add(TCoClass.Create(ptInfo));
              TKIND_ALIAS    :  FAliases.Add(TAlias.Create(ptInfo));
           end;
           // Release the type attribute
           ptInfo.ReleaseTypeAttr(ptAttr);
        end;
        // Release the type info
        ptInfo:=nil;
     end;
  end;

end;

procedure TTypeLibrary.Load(TypeLibrary: String);
var  pwFileName: PWideChar;
     hrStatus:   HResult;
begin

  // Attempt to load the type library
  pwFileName:=StringToOleStr(TypeLibrary);
  hrStatus:=LoadTypeLib(pwFileName, FTypeLib);
  SysFreeString(pwFileName);

  // Check result
  if (hrStatus <> S_OK) then raise ETypeUtilException.Create(SysErrorMessage(hrStatus));

  // Load the library information
  LoadTypeLibrary;

end;

procedure TTypeLibrary.Load(IID: TGUID);
var  szIIDKey:   String;
     iidLib:     TGUID;
     wMajor:     Word;
     wMinor:     Word;
     lpPos:      PChar;
     lpIID:      Array [0..63] of Char;
     lpVer:      Array [0..31] of Char;
     dwRead:     Integer;
     hrStatus:   HResult;
     phKey:      HKEY;
begin

  // Build the key name
  szIIDKey:=Format('Interface\%s\TypeLib', [GuidToSTring(IID)]);

  // Load the type library using the IID
  if (RegOpenKeyEx(HKEY_CLASSES_ROOT, PChar(szIIDKey), 0, KEY_READ, phKey) = ERROR_SUCCESS) then
  begin
     // Now we need to read the type library guid and version number info
     lpIID[0]:=#0;
     lpVer[0]:=#0;
     dwRead:=SizeOf(lpIID);
     RegQueryValueEx(phKey, nil, nil, nil, @lpIID, @dwRead);
     dwRead:=SizeOf(lpVer);
     RegQueryValueEx(phKey, 'Version', nil, nil, @lpVer, @dwRead);
     // Close the key
     RegCloseKey(phKey);
  end
  else
     // Raise exception
     raise ETypeUtilException.CreateRes(@resRegInfoFail);

  // Convert the strings to guid and major/minor version
  if ((lpIID[0] > #0) and (lpVer[0] > #0)) then
  begin
     // Convert the string to guid
     iidLib:=StringToGuid(lpIID);
     // Parse out the major and minor versions
     wMinor:=0;
     lpPos:=StrScan(lpVer, '.');
     if Assigned(lpPos) then
     begin
        lpPos^:=#0;
        Inc(lpPos);
        wMajor:=StrToIntDef(lpVer, 0);
        wMinor:=StrToIntDef(lpPos, 0);
     end
     else
        wMajor:=StrToIntDef(lpVer, 0);
     // Now attempt to load the library
     hrStatus:=LoadRegTypeLib(iidLib, wMajor, wMinor, LANG_SYSTEM_DEFAULT, FTypeLib);
     if (hrStatus = S_OK) then
        LoadTypeLibrary
     else
        raise ETypeUtilException.Create(SysErrorMessage(hrStatus));
  end
  else
     // Raise exception
     raise ETypeUtilException.CreateRes(@resRegInfoFail);

end;

constructor TTypeLibrary.Create(IID: TGUID);
begin

  // Perform inherited
  inherited Create;

  // Set starting defaults
  FTypeLib:=nil;
  FGuid:=GUID_NULL;
  FName:='';
  FDescription:='';
  FCoClasses:=TObjectList.Create;
  FCoClasses.OwnsObjects:=True;
  FInterfaces:=TObjectList.Create;
  FInterfaces.OwnsObjects:=True;
  FRecords:=TObjectList.Create;
  FRecords.OwnsObjects:=True;
  FAliases:=TObjectList.Create;
  FAliases.OwnsObjects:=True;
  FEnums:=TObjectList.Create;
  FEnums.OwnsObjects:=True;
  FModules:=TObjectList.Create;
  FModules.OwnsObjects:=True;

  // Load the classes
  Load(IID);

end;

constructor TTypeLibrary.Create(TypeLibrary: String);
begin

  // Perform inherited
  inherited Create;

  // Set starting defaults
  FTypeLib:=nil;
  FGuid:=GUID_NULL;
  FName:='';
  FDescription:='';
  FCoClasses:=TObjectList.Create;
  FCoClasses.OwnsObjects:=True;
  FInterfaces:=TObjectList.Create;
  FInterfaces.OwnsObjects:=True;
  FRecords:=TObjectList.Create;
  FRecords.OwnsObjects:=True;
  FAliases:=TObjectList.Create;
  FAliases.OwnsObjects:=True;
  FEnums:=TObjectList.Create;
  FEnums.OwnsObjects:=True;
  FModules:=TObjectList.Create;
  FModules.OwnsObjects:=True;

  // Load the classes
  Load(TypeLibrary);

end;

destructor TTypeLibrary.Destroy;
begin

  // Clear interfaces
  FTypeLib:=nil;

  // Free object lists
  FModules.Free;
  FCoClasses.Free;
  FInterfaces.Free;
  FRecords.Free;
  FAliases.Free;
  FEnums.Free;

  // Perform inherited
  inherited Destroy;

end;

// TComDataType
function TComDataType.GetBoundsCount: Integer;
begin

  // Return count
  result:=FBounds.Count;

end;

function TComDataType.GetDataTypeName;
begin

  // Return the delphi data type name
  result:=DATA_TYPE_NAMES[FVT];

end;

function TComDataType.GetBounds(Index: Integer): TArrayBound;
begin

  // Return the requested bounds
  result:=PArrayBound(FBounds[Index])^;

end;

procedure TComDataType.SetName(Value: String);
begin

  // Callable by "friends"
  FName:=Value;

end;

procedure TComDataType.SetVT(Value: Integer);
begin

  // Callable by "friends"
  FVT:=Value;

end;

procedure TComDataType.SetIsUserDefined(Value: Boolean);
begin

  // Callable by "friends"
  FIsUserDefined:=True;

end;

procedure TComDataType.SetIsArray(Value: Boolean);
begin

  // Callable by "friends"
  FIsArray:=True;

end;

procedure TComDataType.AddBound(LowBound, HiBound: Integer);
var  paBound:    PArrayBound;
begin

  // Allocate memory
  paBound:=AllocMem(SizeOf(TArrayBound));

  // Set bounds
  paBound^.lBound:=LowBound;
  paBound^.uBound:=HiBound;

  // Add to the list
  FBounds.Add(paBound);

end;

constructor TComDataType.Create;
begin

  // Perform inherited
  inherited Create;

  // Set starting values
  FVT:=0;
  FName:='';
  FIsOptional:=False;
  FIsUserDefined:=False;
  FIsArray:=False;
  FConstValue:=0;
  FBounds:=TList.Create;
  FGuid:=GUID_NULL;

end;

destructor TComDataType.Destroy;
var  dwBounds:   Integer;
begin

  // Clear all array bounds
  for dwBounds:=0 to Pred(FBounds.Count) do
  begin
     FreeMem(PArrayBound(FBounds[dwBounds]));
  end;

  // Free the list
  FBounds.Free;

  // Perform inherited
  inherited Destroy;

end;

procedure LoadDataType(TypeInfo: ITypeInfo; Description: TElemDesc; DataType: TComDataType);
var  ptInfo:     ITypeInfo;
     ptAttr:     PTypeAttr;
     udType:     Cardinal;
     dwBounds:   Integer;
begin

  // Get the data type from the type desc
  DataType.FVT:=Description.tdesc.vt;

  // Need to figure out what the actual type is
  udType:=0;
  case DataType.FVT of
     VT_PTR,
     VT_SAFEARRAY   :
     begin
        // Get the data type from the pointer type
        DataType.FVT:=Description.tdesc.ptdesc.vt;
        // If user defined, set the udt reftype
        if (DataType.FVT = VT_USERDEFINED) then udType:=Description.tdesc.padesc.tdescElem.hreftype;
     end;
     // Get the type from the array description
     VT_CARRAY      :
     begin
        // Set array flag
        DataType.FIsArray:=True;
        // Add the bounds
        for dwBounds:=0 to Pred(Description.tdesc.padesc^.cDims) do
        begin
           with Description.tdesc.padesc^ do
           begin
              DataType.AddBound(rgbounds[dwBounds].lLbound, Pred(rgbounds[dwBounds].cElements));
           end;
        end;
        // Set the data type
        DataType.FVT:=Description.tdesc.padesc.tdescElem.vt;
     end;
     // Get the user defined reftype
     VT_USERDEFINED :  udType:=Description.tdesc.hreftype;
  end;

  // Check for user defined type
  if (DataType.FVT = VT_USERDEFINED) then
  begin
     // User defined
     DataType.FIsUserDefined:=True;
     // Try to get the referenced type info
     if (TypeInfo.GetRefTypeInfo(udType, ptInfo) = S_OK) then
     begin
        // Get the attributes so we can get the guid
        if (ptInfo.GetTypeAttr(ptAttr) = S_OK) then
        begin
           DataType.FGuid:=ptAttr^.guid;
           // Release the type attributes
           ptInfo.ReleaseTypeAttr(ptAttr);
        end;
        // Release the type info
        ptInfo:=nil;
     end;
  end;

end;

procedure LoadDataType(TypeInfo: ITypeInfo; Description: TTypeDesc; DataType: TComDataType);
var  ptInfo:     ITypeInfo;
     ptAttr:     PTypeAttr;
     udType:     Cardinal;
     dwBounds:   Integer;
begin

  // Get the data type from the type desc
  DataType.FVT:=Description.vt;

  // Need to figure out what the actual type is
  udType:=0;
  case DataType.FVT of
     VT_PTR,
     VT_SAFEARRAY   :
     begin
        // Get the data type from the pointer type
        DataType.FVT:=Description.ptdesc.vt;
        // If user defined, set the udt reftype
        if (DataType.FVT = VT_USERDEFINED) then udType:=Description.padesc.tdescElem.hreftype;
     end;
     // Get the type from the array description
     VT_CARRAY      :
     begin
        // Set array flag
        DataType.FIsArray:=True;
        // Add the bounds
        for dwBounds:=0 to Pred(Description.padesc^.cDims) do
        begin
           with Description.padesc^ do
           begin
              DataType.AddBound(rgbounds[dwBounds].lLbound, Pred(rgbounds[dwBounds].cElements));
           end;
        end;
        // Set the array data type
        DataType.FVT:=Description.padesc.tdescElem.vt;
     end;
     // Get the user defined reftype
     VT_USERDEFINED :  udType:=Description.hreftype;
  end;

  // Check for user defined type
  if (DataType.FVT = VT_USERDEFINED) then
  begin
     // User defined
     DataType.FIsUserDefined:=True;
     // Try to get the referenced type info
     if (TypeInfo.GetRefTypeInfo(udType, ptInfo) = S_OK) then
     begin
        // Get the attributes so we can get the guid
        if (ptInfo.GetTypeAttr(ptAttr) = S_OK) then
        begin
           DataType.FGuid:=ptAttr^.guid;
           // Release the type attributes
           ptInfo.ReleaseTypeAttr(ptAttr);
        end;
        // Release the type info
        ptInfo:=nil;
     end;
  end;

end;

end.
0
 
Wim ten BrinkSelf-employed developerAuthor Commented:
Hey, I know that piece of code. I already gave 500 points for it! :-)

Well, once you posted the answer to my other question I immediately used it to view the type library of my COM+ component. And I might assume that the COM+ components show the methods in the same order as the type library but unfortunately I must be absolutely sure about this. I could write several tests, of course. Just to make sure you're correct. But my weekend just started so there's a minor delay with this...

Besides, I hoped for a solution that doesn't require reading the type library too because walking through the COM+ library is already quite slow. It already needs to display a progress bar to show how long the user has to wait before it has read everything. Still, this is a test application. The final version could read the information on demand.
0
 
Wim ten BrinkSelf-employed developerAuthor Commented:
Well, your code was quite useful to get information from the associated type library. The COM+ get/set methods both have the same name in the type library because these methods are linked to a property. Quite nasty, really, when you try to make a link of unique strings and suddenly discover you have duplicates... But properties are of type TMember in your code and one has CanRead=true and the other has CanWrite=true. Okay, now I know the difference between the get/set method according to the type library.
Next I check the ID property and... For both methods the ID=2. Different even from the ID in the COM+ library... Now, if I can assume that the COM+ library displays them in the same order as the type library then things are okay. However, if I accidently order them incorrectly then it will be a very difficult bug to spot...
0
 
Russell LibbySoftware Engineer, Advisory Commented:

Yes,
Read/Write properties that are implemented as functions (vs the var kind) will have both a getter and setter implementation. As well, they both have the same dispatch ID. According to the MSDN, the index in COM+ is supposed to be the method dispatch identifier. What this means I have no idea, because it sure isn't the dispatch identifier for the com object. It isnt even the absolute index of the method in the VTable (like I said, IDispatch implements the 3 functions from IUnknown, and 4 on its own). So I really can't say "how" COM+ comes up with the index that it does.

All I can say for sure is that the code I gave you does order the items in the same order they are stored in the type library. If COM+ does the same, then you should be fine. If not, then there will be NO possible way to know for sure, as the properties in COM+ do not give you enough information to determine this (without making assumptions, and/or guessing)

Regards,
Russell

0
 
Wim ten BrinkSelf-employed developerAuthor Commented:
Thanks for confirming that there is no 100% secure method to detect the get and set methods within COM+. You helped me quite a lot in the right direction.
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now