14

我希望能够确定一个特定的单元是否已被编译到 Delphi 程序中，例如单元 SomeUnitName 是我的一些程序的一部分，但不是其他程序的一部分。我想要一个功能

function IsSomeUnitNameInProgram: boolean;

（当然没有在 SomeUnitName 中声明，因为在这种情况下它总是被包含在内）如果单元已编译到程序中，则在运行时返回 true，否则返回 false。

到目前为止，我的想法一直是使用 jcl 调试信息（从详细的映射文件编译而来），我基本上将其添加到所有程序中以确定此信息，但如果不需要 jcl，我更喜欢它。

向 SomeUnitName 添加代码不是一种选择。

这目前适用于 Delphi 2007，但最好也适用于 Delphi XE2。

有什么想法吗？

自从@DavidHeffernan 问起这方面的一些背景：

这不仅适用于一个程序，而且适用于 100 多个不同的程序。其中大部分在内部使用，但也有一些交付给客户。由于我们使用了很多库，有些人在各种开源许可证下购买了其他库，我希望能够在 about 框中添加一个“credits”选项卡，该选项卡仅显示那些实际编译到程序中的库，而不是所有库。多亏了 TOndrej 的回答，这现在完全按照我的意愿工作了：如果程序使用了一个库，代码会检查一个总是链接的单元，如果它在那里，它会添加库名称、版权和一个链接到关于框。

4

2 回答 2

20

单元名称被编译到“PACKAGEINFO”资源中，您可以在其中查找它：

uses
  SysUtils;

type
  PUnitInfo = ^TUnitInfo;
  TUnitInfo = record
    UnitName: string;
    Found: PBoolean;
  end;

procedure HasUnitProc(const Name: string; NameType: TNameType; Flags: Byte; Param: Pointer);
begin
  case NameType of
    ntContainsUnit:
      with PUnitInfo(Param)^ do
        if SameText(Name, UnitName) then
          Found^ := True;
  end;
end;

function IsUnitCompiledIn(Module: HMODULE; const UnitName: string): Boolean;
var
  Info: TUnitInfo;
  Flags: Integer;
begin
  Result := False;
  Info.UnitName := UnitName;
  Info.Found := @Result;
  GetPackageInfo(Module, @Info, Flags, HasUnitProc);
end;

要为当前可执行文件执行此操作，请传递它HInstance：

HasActiveX := IsUnitCompiledIn(HInstance, 'ActiveX');

（GetPackageInfo枚举对于具有许多单元的可执行文件可能效率低下的所有单元，在这种情况下，您可以剖析 SysUtils 中的实现并编写您自己的版本，当找到该单元时停止枚举。）

于 2012-08-24T08:22:58.887 回答
5

此函数将返回应用程序中包含的单元名称列表。适用于 Delphi 2010。未针对其他编译器进行验证。

function UnitNames: TStrings;
var
  Lib: PLibModule;
  DeDupedLibs: TList<cardinal>;
  TypeInfo: PPackageTypeInfo;
  PInfo: GetPackageInfoTable;
  LibInst: Cardinal;
  u: Integer;
  s: string;
  s8: UTF8String;
  len: Integer;
  P: PByte;
begin
result := TStringList.Create;
DeDupedLibs := TList<cardinal>.Create;
Lib := LibModuleList;
try
  while assigned( Lib) do
    begin
    LibInst := Lib^.Instance;
    Typeinfo := Lib^.TypeInfo;
    if not assigned( TypeInfo) then
      begin
      PInfo := GetProcAddress( LibInst, '@GetPackageInfoTable');
      if assigned( PInfo) then
        TypeInfo := @PInfo^.TypeInfo;
      end;
    if (not assigned( TypeInfo)) or (DeDupedLibs.IndexOf( LibInst) <> -1) then continue;
    DeDupedLibs.Add( LibInst);
    P := Pointer( TypeInfo^.UnitNames);
    for u := 0 to TypeInfo^.UnitCount - 1 do
      begin
      len := P^;
      SetLength( s8, len);
      if len = 0 then Break;
      Inc( P, 1);
      Move( P^, s8[1], len);
      Inc( P, len);
      s := UTF8ToString( s8);
      if Result.IndexOf( s) = -1 then
        Result.Add( s)
      end
    end
finally
  DeDupedLibs.Free
  end
end;

问题中建议使用的示例...

function IsSomeUnitNameInProgram: boolean;
var
  UnitNamesStrs: TStrings;
begin
UnitNamesStrs := UnitNames;
result := UnitNamesStrs.IndexOf('MyUnitName') <> -1;
UnitNamesStrs.Free
end;
于 2012-08-24T09:31:53.243 回答