Solved

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

Posted on 2003-10-23
5
760 Views
Last Modified: 2013-11-23
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
Comment
Question by:Wim ten Brink
  • 3
  • 2
5 Comments
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility

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
 
LVL 17

Author Comment

by:Wim ten Brink
Comment Utility
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
 
LVL 17

Author Comment

by:Wim ten Brink
Comment Utility
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
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
Comment Utility

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
 
LVL 17

Author Comment

by:Wim ten Brink
Comment Utility
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now