How to list the COM objects of a Library?

[Stephan]

Hello,

From a DLL or OCX file name, how can I browse it to retrieve all the COM
Objects it contains an their GUIDs?

Thanks

[Howard Moon]

Easiest way I know of is to import the type library into Delphi,
generating a file called xxxxx_TLB.PAS, where "xxxxx" is the name of the
server library. This also sets you up for using the library in your apps
later. Be careful, though...I tried importing a type library from some IE
dll, and after failing to complete the import, I found that my WebBrowser_V2
component was trashed.
You might consider looking at the documentation for the object instead of
just trying to see what is there and guessing how to properly use it.
Microsoft publishes very good documentation on its interfaces at
msdn.microsoft.com.
-Howard

[Stephan]

Thanks but what I need is to be able to programatically retrieve all the
information concerning the COM objects contained in the DLL...

Have any suggestions?

[Binh Ly]

Assuming the COM server has a type library, read up on LoadTypeLib,
ITypeLib, and ITypeInfo. The Automation Programmers Reference is a good
resource for this.

--
have fun
Binh Ly
www.techvanguards.com

"Stephan" <zou...@yahoo.com> wrote in message
news:3B1E43C1...@yahoo.com...

[Johan Otto]

Here is an implementation of my own, maybe it is of use...

Basically does the type information thing....

(In this case I only needed to get to the method's parameters), but I think
you'll get the picture from this

unit UabInterfaceInfo;

interface

uses Windows, ActiveX, classes, UabConstants, URds;

type
TabNames = record
case Integer of
1: (ParamNames: TBStrList);
2: (MethodNames: TOleStrList);
end; {TabNames}

TabIntInfo = class(TObject)
private
FTypeLib: ITypeLib;
FTypeInfo: ITypeInfo;
// FFuncDesc: PFuncDesc;
FNames: TabNames;
FInitialized: Boolean;
FDispatchObject: IDispatch;
FTypeAttr: PTypeAttr;
procedure CheckInitialized;
function GetMemberID(AMethodName: WideString): Integer;
public
property TypeLib: ITypeLib read FTypeLib;
property Initialized: Boolean read FInitialized;
function GetMethodID(AMethodName: WideString): Integer;
constructor Create(AIID: string;
AClassID: string; AProgID: string; ARemoteServer: string = '');
destructor Destroy; override;
procedure GetParamNames(const AMethodID: Integer; AParamNames: TStrings;
const AAddTypeInfo: Boolean = False); overload;
procedure GetParamNames(const AMethodName: WideString; AParamNames:
TStrings; const AAddTypeInfo: Boolean = False); overload;
property TypeInfo: ITypeInfo read FTypeInfo;
end;

implementation

uses SysUtils, ComObj, Dialogs, db, UabErrors, ADODB;

function GetComputer: Ansistring;
var dwI: DWord;
{Returns the name string for the current system. Returns empty string ('')
if
function fails.}

begin
dwI:=MAX_PATH;
SetLength(Result,MAX_PATH+1);
if GetComputerName(PChar(Result),dwI) then
SetLength(Result,dwI)
else SetLength(Result,0);
end;

procedure TabIntInfo.CheckInitialized;
begin
if not FInitialized
then raise Exception.Create(MSG_INT_INFO_NOT_INIT);
end;

constructor TabIntInfo.Create(AIID: string;
AClassID: string; AProgID: string; ARemoteServer: string = '');
var LCount: Integer;
begin
inherited Create;
FInitialized := False;
// Load type library
// #ToDo1 - Check if all the parameters is assgned
if (ARemoteServer = '') or (ARemoteServer = GetComputer)
then begin
FDispatchObject := CreateOleObject(AProgID);
end else begin
// #ToDo1 - Test for interface not supported !!
try
FDispatchObject :=
CreateRemoteComObject(ARemoteServer,StringToGUID(AClassID)) as IDispatch;
except
On E: Exception do
E.Message := Format(MSG_INT_NOT_DISPATCH,[E.Message]);
end; {try - except}
end; {else}
if Assigned(FDispatchObject) then begin
Check(FDispatchObject.GetTypeInfo(0,0,FTypeInfo),
[E_NOTIMPL],
[MSG_E_NOTIMPL],'');
FDispatchObject.GetTypeInfoCount(LCount);
Check(FTypeInfo.GetTypeAttr(FTypeAttr));
LCount := 0;
// We are ready to go
FInitialized := True;
end; {then}
end;

destructor TabIntInfo.Destroy;
begin
inherited;
if Assigned(FTypeAttr)
then FTypeInfo.ReleaseTypeAttr(FTypeAttr);
end;

function TabIntInfo.GetMemberID(AMethodName: WideString): Integer;
var i: Integer;
LFuncDesc: PFuncDesc;
Name: WideString;
begin
CheckInitialized;
Result := -1;
for i := 0 to FTypeAttr^.cFuncs-1 do begin
FTypeInfo.GetFuncDesc(i,LFuncDesc);
Check(FTypeInfo.GetDocumentation(LFuncDesc.memid, @Name, nil, nil,
nil));
if AMethodName = Name then begin
result := LFuncDesc.memid;
Break;
end; {then}
end; {for}
end;

function TabIntInfo.GetMethodID(AMethodName: WideString): Integer;
begin
Result := GetMemberID(AMethodName);
end;

procedure TabIntInfo.GetParamNames(const AMethodID: Integer;
AParamNames: TStrings; const AAddTypeInfo: Boolean = False);
var i,ii,iii, LCount: Integer;
LFuncDesc: PFuncDesc;
LParamType: TabParamType;
LValue: Word;
begin
CheckInitialized;
// Check if we have a valid ParamNames to work with
if not Assigned(AParamNames)
then raise Exception.Create(MSG_STRINGS_NOT_INTITIALIZED);
// Here we do a check on invalid method index
FillChar(FNames.ParamNames,SizeOf(TBStrList),0);
Check(FTypeInfo.GetNames(AMethodID,@FNames.ParamNames,512,LCount),

[TYPE_E_ELEMENTNOTFOUND],[MSG_ELEMENT_NOT_FOUND],MSG_FUNCTION_INFORMATION_UN
AVAIL);
// Now get the types etc. MANN WHAT A BEAUTIFULL PIECE OF CODE
AParamNames.Clear;
if not AAddTypeInfo then begin
for i:= 1 to LCount-1 do
AParamNames.Add(FNames.ParamNames[i]);
end {then} else begin
for i := 0 to FTypeAttr.cFuncs-1 do begin
Check(FTypeInfo.GetFuncDesc(i,LFuncDesc));
try
// Now just get the attributes of the selected method
if LFuncDesc.memid = AMethodID then
for ii := 0 to LFuncDesc^.cParams-1 do begin
iii :=
AParamNames.AddObject(FNames.ParamNames[ii+1],TabParamType.Create);
// Get a reference to the added object
LParamType := (AParamNames.Objects[iii] as TabParamType);
LParamType.PointerType := 0;
// Detect the type of parameter
// o If it is a pointer, get the actual reference type of the
pointer and
// set a flag that tells us it's a pointer (usually with var
and out parameters)
LValue := LFuncDesc^.lprgelemdescParam[ii].tdesc.vt;
LParamType.WindowsType := LValue;
LParamType.IsPointer := LValue = VT_PTR;
if LParamType.IsPointer then begin
LValue := LFuncDesc^.lprgelemdescParam[ii].tdesc.ptdesc.vt;
LParamType.PointerType := LValue;
end; {then}
LParamType.ParamType :=
DTS_FIELD_TYPES[LValue];
// Get the direction (without the Optional and default
indicators)
// o We do this by bit maniupulation
LValue :=
LFuncDesc^.lprgelemdescParam[ii].paramdesc.wParamFlags;
LParamType.Direction := DTS_PARAM_FIELD_DIRS[
LValue
- (LValue and PARAMFLAG_FOPT)
- (LValue and PARAMFLAG_FHASDEFAULT)];
end; {for}
finally
FTypeInfo.ReleaseFuncDesc(LFuncDesc);
end; {try - finally}
end; {for}
end; {else}
end;

procedure TabIntInfo.GetParamNames(const AMethodName: WideString;
AParamNames: TStrings; const AAddTypeInfo: Boolean = False);
begin
GetParamNames(GetMethodID(AMethodName),AParamNames,AAddTypeInfo);
end;

end.

"Stephan" <zou...@yahoo.com> wrote in message

news:3B1E9A5A...@yahoo.com...