Mega Code Archive
How to develop a TLB Browser
<![CDATA[
Title: How to develop a TLB Browser?
Question: How to see the interfaces and methods supported by a COM Dll?
Answer:
{************************************************************************}
{ }
{ TLB Viewer }
{ Author: Tomy Chacko }
{ }
{************************************************************************}
// Here's the sample code as it is... No optimization is done on this
// code.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ActiveX, ComCtrls;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
tvObjectBrowser: TTreeView;
lvParams: TListView;
procedure tvObjectBrowserChange(Sender: TObject; Node: TTreeNode);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
TypeLib: ITypeLib;
TypeInfo: ITypeInfo;
m_sTLBFileName: WideString;
slFunc_Params: TStringList;
procedure LoadTLBDetails;
procedure LoadFuncParams;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.LoadTLBDetails;
var
iCtr, iOutNames: Integer;
iFuncCnt, iParamCnt: Integer;
sName, sDocStr, sHelpFile: WideString;
iHelpCont: LongInt;
wType: DWord;
trServer, trObject, trMethod: TTreeNode;
sFileName: WideString;
strNames: TBStrList;
strParamType, strDefVal: String;
sObjName, sFuncName: String;
ptrFuncDesc: PFuncDesc;
ptrVarDesc: PVarDesc;
ptrTypeAttr: PTypeAttr;
function GetDLLFile: String;
var
dlgOpen: TOpenDialog;
begin
try
dlgOpen := TOpenDialog.Create(Self);
dlgOpen.Filter := 'Type Library|*.DLL';
dlgOpen.InitialDir := 'C:\Tomy';
if dlgOpen.Execute then
Result := dlgOpen.FileName;
finally
FreeAndNil(dlgOpen);
end;
end;
begin
try
try
tvObjectBrowser.OnChange := nil;
tvObjectBrowser.Items.Clear;
m_sTLBFileName := GetDLLFile;
sFileName := ExtractFileName(m_sTLBFileName);
sFileName := Copy(sFileName, 1, Pos('.', sFileName) - 1);
LoadTypeLibEx(PWideChar(m_sTLBFileName), REGKIND_REGISTER, TypeLib);
trServer := tvObjectBrowser.Items.AddChild(nil, sFileName);
trServer.ImageIndex := 0;
trServer.SelectedIndex := 0;
for iCtr := 0 to TypeLib.GetTypeInfoCount - 1 do
begin
TypeLib.GetTypeInfoType(iCtr, wType);
TypeLib.GetDocumentation(iCtr, @sName, @sDocStr, @iHelpCont, @sHelpFile);
TypeLib.GetTypeInfo(iCtr, TypeInfo);
TypeInfo.GetTypeAttr(ptrTypeAttr);
trObject := tvObjectBrowser.Items.AddChild(trServer, sName);
sObjName := sName;
if wType = TKIND_DISPATCH then
begin
trObject.ImageIndex := 1;
trObject.SelectedIndex := 1;
end
else if wType = TKIND_COCLASS then
begin
trObject.ImageIndex := 2;
trObject.SelectedIndex := 2;
end
else if wType = TKIND_RECORD then
begin
trObject.ImageIndex := 3;
trObject.SelectedIndex := 3;
end
else if wType = TKIND_ENUM then
begin
trObject.ImageIndex := 21;
trObject.SelectedIndex := 21;
end;
if wType = TKIND_RECORD then
begin
for iFuncCnt := 0 to ptrTypeAttr.cVars - 1 do
begin
TypeInfo.GetVarDesc(iFuncCnt, ptrVarDesc);
TypeInfo.GetDocumentation(ptrVarDesc.memid, @sName, @sDocStr, @iHelpCont, @sHelpFile);
sFuncName := sName;
trMethod := tvObjectBrowser.Items.AddChild(trObject, sFuncName);
trMethod.ImageIndex := 17;
trMethod.SelectedIndex := 17;
end;
end;
if wType = TKIND_ENUM then
begin
for iFuncCnt := 0 to ptrTypeAttr.cVars - 1 do
begin
TypeInfo.GetVarDesc(iFuncCnt, ptrVarDesc);
TypeInfo.GetDocumentation(ptrVarDesc.memid, @sName, @sDocStr, @iHelpCont, @sHelpFile);
sFuncName := sName;
trMethod := tvObjectBrowser.Items.AddChild(trObject, sFuncName);
trMethod.ImageIndex := 17;
trMethod.SelectedIndex := 17;
end;
end;
if wType = TKIND_DISPATCH then
begin
for iFuncCnt := 0 to ptrTypeAttr.cFuncs - 1 do
begin
TypeInfo.GetFuncDesc(iFuncCnt, ptrFuncDesc);
TypeInfo.GetDocumentation(ptrFuncDesc.memid, @sName, @sDocStr, @iHelpCont, @sHelpFile);
sFuncName := sName;
trMethod := tvObjectBrowser.Items.AddChild(trObject, sFuncName);
trMethod.ImageIndex := 7;
trMethod.SelectedIndex := 8;
if ptrFuncDesc.wFuncFlags = FUNC_VIRTUAL then
begin
TypeInfo.GetNames(ptrFuncDesc.memid, @strNames, ptrFuncDesc.cParams + 1, iOutNames);
sFuncName := strNames[0];
for iParamCnt := 0 to ptrFuncDesc.cParams + 1 do
begin
sName := strNames[iParamCnt];
if (iParamCnt 0) and (iParamCnt begin
slFunc_Params.Add(Format('%-50s%-50s%-50s%-25s%-25s', [sObjName, sFuncName, sName, strParamType, strDefVal]));
end
else if iParamCnt ptrFuncDesc.cParams then
begin
slFunc_Params.Add(Format('%-50s%-50s%-50s%-25s', [sObjName, sFuncName, 'Result', strParamType]));
end;
strNames[iParamCnt] := nil;
end;
end;
TypeInfo.ReleaseFuncDesc(ptrFuncDesc);
end;
end;
TypeInfo.ReleaseTypeAttr(ptrTypeAttr);
end;
tvObjectBrowser.OnChange := tvObjectBrowserChange;
finally
end;
except
on E: Exception do
begin
Showmessage(E.Message);
end;
end;
end;
procedure TForm1.tvObjectBrowserChange(Sender: TObject; Node: TTreeNode);
begin
LoadFuncParams;
end;
procedure TForm1.LoadFuncParams;
var
iCtr: Integer;
sObjName, sFuncName: String;
sObjName1, sFuncName1: String;
begin
lvParams.Items.Clear;
if tvObjectBrowser.Selected.HasChildren then
Exit;
sObjName := tvObjectBrowser.Selected.Parent.Text;
sFuncName := tvObjectBrowser.Selected.Text;
for iCtr := 0 to slFunc_Params.Count - 1 do
begin
sObjName1 := Trim(Copy(slFunc_Params.Strings[iCtr], 1, 50));
sFuncName1 := Trim(Copy(slFunc_Params.Strings[iCtr], 51, 50));
if (sObjName = sObjName1) and (sFuncName = sFuncName1) then
begin
lvParams.Items.Add;
lvParams.Items[lvParams.Items.Count - 1].Caption := Trim(Copy(slFunc_Params.Strings[iCtr], 101, 50));
lvParams.Items[lvParams.Items.Count - 1].SubItems.Add(Trim(Copy(slFunc_Params.Strings[iCtr], 151, 25)));
lvParams.Items[lvParams.Items.Count - 1].SubItems.Add(Trim(Copy(slFunc_Params.Strings[iCtr], 176, 25)));
end;
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
LoadTLBDetails;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
slFunc_Params := TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(slFunc_Params) then
FreeAndNil(slFunc_Params);
end;
end.
]]>