ResPACKAGEINFO.dpr

program ResPACKAGEINFO;

{$APPTYPE CONSOLE}

uses
  Windows,
  System.Classes,
  SysUtils,
  System.IOUtils,
  System.Types;


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

function GetUnitFlagInfo(Flags: Byte):string;
begin

  { PackageUnitFlags:
    bit      meaning
    -----------------------------------------------------------------------------------------
    0      | main unit
    1      | package unit (dpk source)
    2      | $WEAKPACKAGEUNIT unit
    3      | original containment of $WEAKPACKAGEUNIT (package into which it was compiled)
    4      | implicitly imported
    5..7   | reserved
  }

  Result:='';
  if (Flags and ufMainUnit<>0) then
  Result:='[Main Unit] ';

  if (Flags and ufPackageUnit<>0) then
  Result:=Result+'[Package Unit] ';

  if (Flags and ufWeakUnit<>0) then
  Result:=Result+'[Weak Unit] ';

  if (Flags and ufImplicitUnit<>0) then
  Result:=Result+'[implicitly imported] ';

  if (Flags and ufWeakPackageUnit<>0) then
  Result:=Result+'[$WEAKPACKAGEUNIT unit] ';

  if (Flags and ufOrgWeakUnit<>0) then
  Result:=Result+'[original containment of $WEAKPACKAGEUNIT]';
end;


procedure GetInfoPackageFlags(Flags:Cardinal);
begin

        { Package flags:
          bit     meaning
          -----------------------------------------------------------------------------------------
          0     | 1: never-build                  0: always build
          1     | 1: design-time only             0: not design-time only      on => bit 2 = off
          2     | 1: run-time only                0: not run-time only         on => bit 1 = off
          3     | 1: do not check for dup units   0: perform normal dup unit check
          4..25 | reserved
          26..27| (producer) 0: pre-V4, 1: undefined, 2: c++, 3: Pascal
          28..29| reserved
          30..31| 0: EXE, 1: Package DLL, 2: Library DLL, 3: undefined
        }


        if  (Flags and pfModuleTypeMask = pfExeModule) then
         Writeln('Type Exe')
        else
        if  (Flags and pfModuleTypeMask = pfPackageModule) then
         Writeln('Type Package')
        else
        if  (Flags and pfModuleTypeMask = pfLibraryModule) then
         Writeln('Type Library');

        if  (Flags and pfNeverBuild = 0) then
         Writeln('Build with runtime packages')
        else
         Writeln('Build without runtime packages');

        if  (Flags and pfIgnoreDupUnits = 0) then
         Writeln('perform normal dup unit check')
        else
         Writeln('Ignore Dup Units');

        if  (Flags and pfProducerMask = pfDelphi4Produced) then
         Writeln('Producer Pascal');

        if  (Flags and pfProducerMask = pfV3Produced) then
         Writeln('Producer pre-V4');

        if  (Flags and pfProducerMask = pfProducerUndefined) then
         Writeln('Producer undefined');

        if  (Flags and pfProducerMask = pfBCB4Produced) then
         Writeln('Producer c++');

        if  (Flags and pfConsumerMask = pfConsumerCompat) then
         Writeln('Consumer Compatible')
        else
        if  (Flags and pfConsumerMask = pfConsumerDelphi) then
         Writeln('Consumer Delphi')
        else
        if  (Flags and pfConsumerMask = pfConsumerBCB) then
         Writeln('Consumer BCB');
end;

procedure PackageInfoCallback(const Name: string; NameType: TNameType; Flags: Byte; Param: Pointer);
begin
    case NameType of
      ntContainsUnit   :  ContainsList.Add(Name);
      ntRequiresPackage:  RequiresList.Add(Name);
    end;
end;


procedure GetPackageResInfo(const FileName:string);
const
 ResPACKAGEINFO='PACKAGEINFO';
var
  FModule    : Cardinal;
  Flags      : Integer;
  S : String;
begin
  FModule := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
  RequiresList.Clear; ImplicitUnits.Clear; ContainsList.Clear;
  try
    SysUtils.GetPackageInfo(FModule, nil, Flags, PackageInfoCallback);
//    GetInfoPackageFlags(Flags);
//    Writeln(GetPackageDescription(PChar(FileName)));
    Writeln(ExtractFileName(FileName)+' requires '+RequiresList.CommaText);
    Writeln(ExtractFileName(FileName)+' contains '+ContainsList.CommaText);
  finally
    FreeLibrary(FModule);
  end;
end;

procedure GetPackagesDirectory(const PathName: String);
var Files: TStringDynArray; FileName: String;
begin
  Files:= TDirectory.GetFiles(PathName, '*.bpl');
  for FileName in Files do
    GetPackageResInfo(FileName);
end;

begin
  RequiresList := TStringList.Create;
  ImplicitUnits := TStringList.Create;
  ContainsList := TStringList.Create;
  try
    try
       if ParamCount > 0 then
         if TFile.Exists(ParamStr(1)) then GetPackageResInfo(ParamStr(1))
         else if TDirectory.Exists(ParamStr(1)) then GetPackagesDirectory(ParamStr(1))
         else Writeln('No valid file or path given!')
       else Writeln(Format('Usage: %s file|path',[ExtractFileName(ParamStr(0))]));
    except
      on E:Exception do
        Writeln(E.Classname, ': ', E.Message);
    end;
  finally
    RequiresList.Free;
    ImplicitUnits.Free;
    ContainsList.Free;
  end;
end.