Wednesday, December 19, 2007

Reading Info From a Package Part II

Yesterday I posted a small program to read some information from a Package. There is more information to get from the package, so here is and updated version with a bit of information you get get from the Flags. Specifically Never Build, Design Only and Run Only.


program pdump;

{$APPTYPE CONSOLE}

uses
SysUtils,
Classes;

var
RequiresList: TStrings;
ImplicitUnits: TStrings;
ContainsList: TStrings;

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

if (Flags and $10 <> 0) and (Flags and $06 = 0) then
ImplicitUnits.Add(Name);
end
else if NameType = ntRequiresPackage then
RequiresList.Add(Name);
end;

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

var
Module: HMODULE;
Flags: Longint;
begin
RequiresList := TStringList.Create;
ImplicitUnits := TStringList.Create;
ContainsList := TStringList.Create;

Module := LoadPackage(ParamStr(1));

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

if (Flags and pfNeverBuild) <> 0 then
WriteLn('Never Build');

if (Flags and pfDesignOnly) <> 0 then
WriteLn('Design Only');

if (Flags and pfRunOnly) <> 0 then
WriteLn('Run Only');

WriteLn('Requires List');
WriteStrings(RequiresList);
WriteLn(#13#10 + 'Implicit Uses');
WriteStrings(ImplicitUnits);
WriteLn(#13#10 + 'Contains List');
WriteStrings(ContainsList);
end;
finally
UnloadPackage(Module);
RequiresList.Free;
ImplicitUnits.Free;
ContainsList.Free;
end;
end.

2 comments:

Larry Hengen said...

Great post, but you might want to consider adding a couple guard clauses to the main routine to prevent a run-time exception when no parameters are supplied or the filename is invalid. Something like:

if Paramcount <> 1 then
begin
 WriteLn('Usage: PDUMP [PackageFileName]');
 Exit;
end;

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


BTW, I have always wondered why CodeGear (and their predecessor) does not put out a package framework so all Delphi developers can leverage the power of packages without necessarily understanding all the intricacies.

AnatoLoy said...

Great, but $10 is ufImplicitUnit $06 is ufWeakPackageUnit :)

Post a Comment