unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ComCtrls, ExtCtrls, ActiveX;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
treeTI: TTreeView;
StatusBar1: TStatusBar;
FileMenu: TMenuItem;
FileExit1: TMenuItem;
FileOpen1: TMenuItem;
OpenDialog1: TOpenDialog;
procedure FileExit1Click(Sender: TObject);
procedure FileOpen1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FLib: ITypeLib;
FEnumRoot: TTreeNode;
FDispatchRoot: TTreeNode;
FInterfaceRoot: TTreeNode;
FCoClassRoot: TTreeNode;
FUnknownRoot: TTreeNode;
procedure LoadTypeLibrary;
procedure LoadEnum(TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr);
procedure LoadInterface(TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr);
procedure LoadCoClass(TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
ComObj;
{$R *.DFM}
procedure TForm1.FileExit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.LoadEnum(TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr);
var
TypeLibNode: TTreeNode;
AName: WideString;
ADocString: WideString;
AHelpContext: LongInt;
ValuesNode: TTreeNode;
ValueNode: TTreeNode;
ValueIndex: Integer;
VarDesc: PVarDesc;
begin
TypeInfo.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
nil);
TypeLibNode := treeTI.Items.AddChild(FEnumRoot, AName);
treeTI.Items.AddChild(TypeLibNode, 'Version ' +
IntToStr(TypeAttr.wMajorVerNum) + '.' +
IntToStr(TypeAttr.wMinorVerNum));
if ADocString <> '' then
treeTI.Items.AddChild(TypeLibNode, 'Help string: ' + ADocString);
if AHelpContext <> 0 then
treeTI.Items.AddChild(TypeLibNode, 'Help context: ' +
IntToStr(AHelpContext));
ValuesNode := treeTI.Items.AddChild(TypeLibNode, 'Values');
for ValueIndex := 0 to TypeAttr.cVars - 1do
begin
TypeInfo.GetVarDesc(ValueIndex, VarDesc);
try
TypeInfo.GetDocumentation(VarDesc.memid, @AName, @ADocString,
@AHelpContext, nil);
ValueNode := treeTI.Items.AddChild(ValuesNode, AName);
if ADocString <> '' then
treeTI.Items.AddChild(ValueNode, 'Help string: ' +
ADocString);
if AHelpContext <> 0 then
treeTI.Items.AddChild(ValueNode, 'Help context: ' +
IntToStr(AHelpContext));
finally
TypeInfo.ReleaseVarDesc(VarDesc);
end;
end;
end;
procedure TForm1.LoadInterface(TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr);
var
TypeLibNode: TTreeNode;
AName: WideString;
ADocString: WideString;
AHelpContext: LongInt;
FunctionsNode: TTreeNode;
FunctionNode: TTreeNode;
FuncIndex: Integer;
FuncDesc: PFuncDesc;
ParametersNode: TTreeNode;
ParamIndex: Integer;
Names: PBStrList;
cNames: Integer;
begin
TypeInfo.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
nil);
if TypeAttr.typeKind = TKIND_DISPATCH then
TypeLibNode := treeTI.Items.AddChild(FDispatchRoot, AName)
else
TypeLibNode := treeTI.Items.AddChild(FInterfaceRoot, AName);
treeTI.Items.AddChild(TypeLibNode, GUIDToString(TypeAttr.GUID));
treeTI.Items.AddChild(TypeLibNode, 'Version ' +
IntToStr(TypeAttr.wMajorVerNum) + '.' +
IntToStr(TypeAttr.wMinorVerNum));
if ADocString <> '' then
treeTI.Items.AddChild(TypeLibNode, 'Help string: ' + ADocString);
if AHelpContext <> 0 then
treeTI.Items.AddChild(TypeLibNode, 'Help context: ' +
IntToStr(AHelpContext));
New(Names);
try
// load functions
FunctionsNode := treeTI.Items.AddChild(TypeLibNode, 'Functions');
for FuncIndex := 0 to TypeAttr.cFuncs - 1do
begin
TypeInfo.GetFuncDesc(FuncIndex, FuncDesc);
try
TypeInfo.GetDocumentation(FuncDesc.memid, @AName,
@ADocString, @AHelpContext, nil);
FunctionNode := treeTI.Items.AddChild(FunctionsNode, AName);
if ADocString <> '' then
treeTI.Items.AddChild(FunctionNode, 'Help string: ' +
ADocString);
if AHelpContext <> 0 then
treeTI.Items.AddChild(FunctionNode, 'Help context: ' +
IntToStr(AHelpContext));
if FuncDesc.cParams > 0 then
begin
// load parameters
ParametersNode := treeTI.Items.AddChild(FunctionNode,
'Parameters');
TypeInfo.GetNames(FuncDesc.memid, Names, sizeof(TBStrList),
cNames);
// Skip Names[0] - it's the function name
for ParamIndex := 1 to FuncDesc.cParamsdo
treeTI.Items.AddChild(ParametersNode, Names[ParamIndex]);
end;
finally
TypeInfo.ReleaseFuncDesc(FuncDesc);
end;
end;
finally
Dispose(Names);
end;
end;
procedure TForm1.LoadCoClass(TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr);
var
TypeLibNode: TTreeNode;
AName: WideString;
ADocString: WideString;
AHelpContext: LongInt;
FunctionsNode: TTreeNode;
FuncIndex: Integer;
RefType: Cardinal;
TypeInfo2: ITypeInfo;
begin
TypeInfo.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
nil);
TypeLibNode := treeTI.Items.AddChild(FCoClassRoot, AName);
treeTI.Items.AddChild(TypeLibNode, GUIDToString(TypeAttr.GUID));
if ADocString <> '' then
treeTI.Items.AddChild(TypeLibNode, 'Help string: ' + ADocString);
if AHelpContext <> 0 then
treeTI.Items.AddChild(TypeLibNode, 'Help context: ' +
IntToStr(AHelpContext));
FunctionsNode := treeTI.Items.AddChild(TypeLibNode, 'Implements');
for FuncIndex := 0 to TypeAttr.cImplTypes - 1do
begin
TypeInfo.GetRefTypeOfImplType(FuncIndex, RefType);
TypeInfo.GetRefTypeInfo(RefType, TypeInfo2);
TypeInfo2.GetDocumentation(-1, @AName, nil, nil, nil);
treeTI.Items.AddChild(FunctionsNode, AName);
end;
end;
procedure TForm1.LoadTypeLibrary;
var
LibAttr: PTLibAttr;
TypeInfo: ITypeInfo;
TypeLibIndex: Integer;
AName: WideString;
ADocString: WideString;
AHelpContext: LongInt;
AHelpFile: WideString;
TypeAttr: PTypeAttr;
RootNode: TTreeNode;
begin
Screen.Cursor := crHourglass;
try
treeTI.Items.begin
Update;
try
treeTI.Items.Clear;
FLib.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
@AHelpFile);
// Load help information
RootNode := treeTI.Items.AddChild(nil, AName);
// GUID, version, LCID
OleCheck(FLib.GetLibAttr(LibAttr));
try
treeTI.Items.AddChild(RootNode, GUIDToString(LibAttr.GUID));
treeTI.Items.AddChild(RootNode, 'Version ' +
IntToStr(LibAttr.wMajorVerNum) + '.' +
IntToStr(LibAttr.wMinorVerNum));
treeTI.Items.AddChild(RootNode, 'LCID: ' +
IntToStr(LibAttr.lcid));
finally
FLib.ReleaseTLibAttr(LibAttr);
end;
// Help information
if ADocString <> '' then
treeTI.Items.AddChild(RootNode, 'Help string: ' + ADocString);
if AHelpContext <> 0 then
treeTI.Items.AddChild(RootNode, 'Help context: ' +
IntToStr(AHelpContext));
if AHelpFile <> '' then
treeTI.Items.AddChild(RootNode, 'Help file: ' + AHelpFile);
// Set no nodes for various types
FEnumRoot := treeTI.Items.AddChild(RootNode, 'Enum');
FDispatchRoot := treeTI.Items.AddChild(RootNode, 'Dispatch');
FInterfaceRoot := treeTI.Items.AddChild(RootNode, 'Interface');
FCoClassRoot := treeTI.Items.AddChild(RootNode, 'CoClass');
FUnknownRoot := treeTI.Items.AddChild(RootNode, 'Unknown');
for TypeLibIndex := 0 to FLib.GetTypeInfoCount - 1do
begin
FLib.GetTypeInfo(TypeLibIndex, TypeInfo);
OleCheck(TypeInfo.GetTypeAttr(TypeAttr));
try
case TypeAttr.typeKind of
TKIND_ENUM:
LoadEnum(TypeInfo, TypeAttr);
TKIND_DISPATCH,
TKIND_INTERFACE:
LoadInterface(TypeInfo, TypeAttr);
TKIND_COCLASS:
LoadCoClass(TypeInfo, TypeAttr);
else
treeTI.Items.AddChild(FUnknownRoot,
'Unrecognized type: ' + IntToStr(TypeAttr.typeKind));
end;
finally
TypeInfo.ReleaseTypeAttr(TypeAttr);
end;
end;
RootNode.Expand(False);
finally
treeTI.Items.EndUpdate;
end;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.FileOpen1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
OleCheck(LoadTypeLib(PWideChar(WideString(OpenDialog1.FileName)),
FLib));
LoadTypeLibrary;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if ParamCount = 1 then
begin
try
OleCheck(LoadTypeLib(PWideChar(WideString(ParamStr(1))),
FLib));
LoadTypeLibrary;
except
on E: Exceptiondo
begin
ShowMessage(E.Message);
Application.Terminate;
end;
end;
end;
end;
end.
------------------
object Form1: TForm1
Left = 247
Top = 87
Width = 362
Height = 385
Caption = 'Type Information Viewer'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object treeTI: TTreeView
Left = 0
Top = 0
Width = 354
Height = 320
Align = alClient
Indent = 19
TabOrder = 0
end
object StatusBar1: TStatusBar
Left = 0
Top = 320
Width = 354
Height = 19
Panels = <>
SimplePanel = False
end
object MainMenu1: TMainMenu
Left = 312
Top = 8
object FileMenu: TMenuItem
Caption = '&File'
object FileOpen1: TMenuItem
Caption = '&Open...'
ShortCut = 16463
OnClick = FileOpen1Click
end
object FileExit1: TMenuItem
Caption = 'E&xit'
OnClick = FileExit1Click
end
end
end
object OpenDialog1: TOpenDialog
DefaultExt = 'exe'
Filter =
'Executable files (*.exe)|*.exe|Dynamic link libraries (*.dll)|*.' +
'dll|Type libraries (*.tlb;*.olb)|*.tlb;*.olb'
Options = [ofHideReadOnly, ofNoChangeDir, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Left = 272
Top = 8
end
end
