Mega Code Archive
BPL Analyze
<![CDATA[
Title: BPL Analyze
Question: What in BPL? How many Units in BPL?
Answer:
DFM File(main.dfm):
object MainForm: TMainForm
Left = 301
Top = 163
Width = 696
Height = 480
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 19
object TreeView: TTreeView
Left = 0
Top = 0
Width = 688
Height = 453
Align = alClient
Indent = 19
TabOrder = 0
Items.Data = {
010000001C0000000000000000000000FFFFFFFFFFFFFFFF0000000000000000
0342504C}
end
end
PAS File(main.pas):
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, StrUtils, TypInfo;
type
TMainForm = class(TForm)
TreeView: TTreeView;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
//==============================================================================
//Form.?Unit*****************************************************************
//==============================================================================
procedure EnumPackageInfo(const InfoName: string; NameType: TNameType; Flags: Byte; Param: Pointer);
var Node: TTreeNode;
i: integer;
begin
Node := nil;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
with MainForm.TreeView do
begin
for i:=1 to Selected.Count do
if Selected.Item[i-1].Text=GetEnumName(TypeInfo(TNameType), Ord(NameType))
then Node := Selected.Item[i-1];
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if not Assigned(Node)
then Node := Items.AddChild(Selected, GetEnumName(TypeInfo(TNameType), Ord(NameType)));
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Items.AddChild(Node, InfoName);
end;
end;
//==============================================================================
//Form.*****************************************************************
//==============================================================================
procedure TMainForm.FormCreate(Sender: TObject);
var SystPath: array[0..128] of char;
DosError: Integer;
DirInfo: TSearchRec;
AppName: string;
HPack: HModule;
Flags: Integer;
Desc: string;
begin
GetSystemDirectory(SystPath, 128);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DosError := FindFirst(SystPath+'\*.*', FaAnyfile, DirInfo);
while DosError=0 do
begin
{$IF DEFINED(WIN32) AND DECLARED(UsingVCL)}
if ((DirInfo.Attr and FaDirectory)FaDirectory) and ((DirInfo.Attr and FaVolumeID)FaVolumeID)
{$ELSE}
if ((DirInfo.Attr and FaDirectory)FaDirectory)
{$IFEND}
then if UpperCase(Copy(DirInfo.Name,Pos('.',DirInfo.Name)+1,3))='BPL' then
try
Desc := GetPackageDescription(PChar(DirInfo.Name));
if Desc'' then Desc := '......('+ Desc +')';
TreeView.Items.AddChild(TreeView.Items[0], DirInfo.Name + Desc);
TreeView.Items[0].Item[TreeView.Items[0].Count-1].Selected := True;
HPack := LoadPackage(DirInfo.Name);
GetPackageInfo(HPack, Pointer(@HPack), Flags, EnumPackageInfo);
except
end;
DosError := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
AppName := ExtractFileName(Application.ExeName);
TreeView.SaveToFile(ExtractFilePath(Application.ExeName)+Copy(AppName,1,Pos('.',AppName)-1)+'.txt');
end;
end.
]]>