Reading Info From a Package Part III

This week became package week. I posed part I here and part II here for reading the information contained within a package. Today I'll continue to grow the program and add the ability to read the remaining information contained in the Flags which is is what language built the package and which language the package is designed for. So there you have it, a small utility that can read the information contained in a package.

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;

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

var
  Module: HMODULE;
  Flags: Longint;
  Producer: TPackageProducer;
  Consumer: TPackageConsumer;
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');

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

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

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

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

      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.