Unit1.dfm
Kod: Tümünü seç
object Form1: TForm1
Left = 96
Top = 107
Width = 521
Height = 457
Caption = 'Package Information'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object TreeView1: TTreeView
Left = 0
Top = 0
Width = 513
Height = 430
Align = alClient
Indent = 19
TabOrder = 0
end
object DBEdit1: TDBEdit
Left = 368
Top = 16
Width = 121
Height = 21
TabOrder = 1
Visible = False
end
object Chart1: TChart
Left = 400
Top = 0
Width = 89
Height = 58
BackWall.Brush.Color = clWhite
BackWall.Brush.Style = bsClear
Title.Text.Strings = (
'TChart')
TabOrder = 2
Visible = False
end
end
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, TeeProcs, TeEngine, Chart, Mask,
DBCtrls;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
DBEdit1: TDBEdit;
Chart1: TChart;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
ContNode, ReqNode: TTreeNode;
procedure ShowInfoProc (const Name: string;
NameType: TNameType; Flags: Byte; Param: Pointer);
var
FlagStr: string;
begin
FlagStr := ' ';
if Flags and ufMainUnit <> 0 then
FlagStr := FlagStr + 'Main Unit ';
if Flags and ufPackageUnit <> 0 then
FlagStr := FlagStr + 'Package Unit ';
if Flags and ufWeakUnit <> 0 then
FlagStr := FlagStr + 'Weak Unit ';
if FlagStr <> ' ' then
FlagStr := ' (' + FlagStr + ')';
with Form1.TreeView1.Items do
case NameType of
ntContainsUnit:
AddChild (ContNode, Name + FlagStr);
ntRequiresPackage:
AddChild (ReqNode, Name);
end;
end;
function ForEachModule (HInstance: Longint;
Data: Pointer): Boolean;
var
Flags: Integer;
ModuleName, ModuleDesc: string;
ModuleNode: TTreeNode;
begin
with Form1.TreeView1.Items do
begin
SetLength (ModuleName, 200);
GetModuleFileName (HInstance,
PChar (ModuleName), Length (ModuleName));
ModuleName := PChar (ModuleName); // fixup
ModuleNode := Add (nil, ModuleName);
// get description and add fixed nodes
ModuleDesc := GetPackageDescription (PChar (ModuleName));
ContNode := AddChild (ModuleNode, 'Contains');
ReqNode := AddChild (ModuleNode, 'Requires');
// add information if the module is a package
GetPackageInfo (HInstance, nil,
Flags, ShowInfoProc);
if ModuleDesc <> '' then
begin
AddChild (ModuleNode,
'Description: ' + ModuleDesc);
if Flags and pfDesignOnly = pfDesignOnly then
AddChild (ModuleNode, 'Design Only');
if Flags and pfRunOnly = pfRunOnly then
AddChild (ModuleNode, 'Run Only');
end;
end;
Result := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EnumModules(ForEachModule, nil);
end;
end.
Kod: Tümünü seç
C:\Program Files\Borland\Delphi7\Projects\bplinfo\Project2.exe
C:\WINDOWS\System32\vcldb70.bpl
C:\WINDOWS\System32\dbrtl70.bpl
C:\WINDOWS\System32\tee70.bpl
C:\WINDOWS\System32\vcl70.bpl
C:\WINDOWS\System32\rtl70.bpl
CurrentGroup variable
Keeps track of which objects are associated with which packages.
EnumModules procedure
Executes a callback for all the modules in an application.
EnumResourceModules procedure
Executes a callback for all resource modules in an application.
FinalizePackage procedure
Finalizes the specified package (.bpl file).
GetPackageDescription function
Returns the description resource from a package.
GetPackageInfo procedure
Enumerates all the units and required packages for a package.
InitializePackage procedure
Validates and initializes a given package.
LibModuleList variable
Lists module records for enumeration procedures.
LoadPackage function
Loads a specified package.
SafeLoadLibrary function
Safe and simple library loading.
UnloadPackage procedure
Unloads a package.
http://www.marcocantu.com/code/md6htm/PackInfo.htm
