Friday, December 21, 2007

Reading Info From a Package Part IV

Well this week really became package week. I posed part I here, part II here and part III here.

For this version I wrapped up the previous package cracking code into a class for easy consumption by any program. Notice I used the previously unused second parameter on GetPackageInfo which is just passed to PackageInfoProc via the Param parameter. This allows us to pass the Self pointer to remove globals. I also added error checking and removed some hard coded constants readers had commented on.


program pdump;

{$APPTYPE CONSOLE}

uses
SysUtils,
Classes;

type
TPackageProducer = (ppOld, ppUndefined, ppBCB, ppDelphi);
TPackageConsumer = (pcCompat, pcDelphi, pcBCB);

TPackage = class
private
FProducer: TPackageProducer;
FConsumer: TPackageConsumer;
FRequiresList: TStrings;
FImplicitUnits: TStrings;
FContainsList: TStrings;
FNeverBuild: Boolean;
FDesignOnly: Boolean;
FRunOnly: Boolean;
public
constructor Create;
destructor Destroy; override;
function LoadFromFile(const FileName: string): Boolean;

property RequiresList: TStrings read FRequiresList;
property ImplicitUnits: TStrings read FImplicitUnits;
property ContainsList: TStrings read FContainsList;
property Producer: TPackageProducer read FProducer;
property Consumer: TPackageConsumer read FConsumer;
property NeverBuild: Boolean read FNeverBuild;
property DesignOnly: Boolean read FDesignOnly;
property RunOnly: Boolean read FRunOnly;
end;

procedure WriteStrings(Strings: TStrings);
var
Index: Integer;
begin
for Index := 0 to Strings.Count - 1 do
WriteLn(Strings[Index]);
end;

procedure PackageInfoProc(const Name: string;
NameType: TNameType; Flags: Byte;
Param: Pointer);
begin
if NameType = ntContainsUnit then
begin
TPackage(Param).ContainsList.Add(Name);

if (Flags and ufImplicitUnit <> 0) and
(Flags and ufWeakPackageUnit = 0) then
begin
TPackage(Param).ImplicitUnits.Add(Name);
end;
end
else if NameType = ntRequiresPackage then
TPackage(Param).RequiresList.Add(Name);
end;

{ TPackage }

constructor TPackage.Create;
begin
FRequiresList := TStringList.Create;
FImplicitUnits := TStringList.Create;
FContainsList := TStringList.Create;
end;

destructor TPackage.Destroy;
begin
FRequiresList.Free;
FImplicitUnits.Free;
FContainsList.Free;
inherited;
end;

function TPackage.LoadFromFile(const FileName: string): Boolean;
var
Module: HMODULE;
Flags: Longint;
begin
Result := False;
Module := LoadPackage(FileName);

try
if Module <> 0 then
begin
GetPackageInfo(Module, Self, Flags, PackageInfoProc);

FNeverBuild := (Flags and pfNeverBuild) <> 0;
FDesignOnly := (Flags and pfDesignOnly) <> 0;
FRunOnly := (Flags and pfRunOnly) <> 0;

case Flags and pfProducerMask of
pfV3Produced: FProducer := ppOld;
pfProducerUndefined: FProducer := ppUndefined;
pfBCB4Produced: FProducer := ppBCB;
pfDelphi4Produced: FProducer := ppDelphi;
else
FProducer := ppUndefined;
end;

case Flags and pfConsumerMask of
pfConsumerDelphi: FConsumer := pcDelphi;
pfConsumerBCB: FConsumer := pcBCB;
else
if FProducer <> ppBCB then
FConsumer := pcCompat
else
FConsumer := pcBCB;
end;

Result := True;
end;
finally
UnloadPackage(Module);
end;
end;

var
Package: TPackage;
FileName: string;
begin
if ParamCount <> 1 then
begin
WriteLn('Usage: PDUMP [PackageFileName]');
Exit;
end;

FileName := ParamStr(1);

if not FileExists(FileName) then
begin
WriteLn(Format('File %s does not exist.', [FileName]));
Exit;
end;

Package := TPackage.Create;

try
if Package.LoadFromFile(FileName) then
begin
if Package.NeverBuild then
WriteLn('Never Build');

if Package.DesignOnly then
WriteLn('Design Only');

if Package.RunOnly then
WriteLn('Run Only');

case Package.Producer of
ppOld: WriteLn('Old Producer');
ppUndefined: WriteLn('Undefined Producer');
ppBCB: WriteLn('BCB Producer');
ppDelphi: WriteLn('Delphi Producer');
end;

case Package.Consumer of
pcCompat: WriteLn('Compat Consumer');
pcBCB: WriteLn('BCB Consumer');
pcDelphi: WriteLn('Delphi Consumer');
end;

if Package.RequiresList.Count > 0 then
begin
WriteLn(#13#10 + 'Requires List:');
WriteStrings(Package.RequiresList);
end;

if Package.ImplicitUnits.Count > 0 then
begin
WriteLn(#13#10 + 'Implicit Uses:');
WriteStrings(Package.ImplicitUnits);
end;

if Package.ContainsList.Count > 0 then
begin
WriteLn(#13#10 + 'Contains List:');
WriteStrings(Package.ContainsList);
end;
end;
finally
Package.Free;
end;
end.

3 comments:

Anonymous said...

1. Allen wrote:
"This will only work if the package in question can also load all the dependent packages. When that is not the case, it is better to simply call LoadLibraryEx() with the LOAD_LIBRARY_AS_DATAFILE flag. This will load *only* that package and not resolve any dependencies or do any fixups."
2. Good idea - show list of all dependenced packages, for example, needed for deploy...
P.S.: Sorry for bad English

Anonymous said...

OK. Where is "pfProducerMask" declared?

Chris Bensen said...

Iceman,

Take a look in SysUtils.

Post a Comment