Delphi OpenTools API：如何获取目标 exe 名称？

Posted 2023-02-16

【中文标题】Delphi OpenTools API：如何获取目标 exe 名称？

【英文标题】：Delphi OpenTools API: How to get target exe name?

【发布时间】：2011-11-01 20:20:58

【问题描述】：

如果给定IOTAProject，我如何获取目标可执行文件的名称？

来自GExpert's OpenTools API FAQ：

如何确定二进制/exe/dll/bpl/ocx/etc 的文件名。由编译或构建生成？ - 对于 Delphi 8 或更高版本，请使用 IOTAProjectOptions.TargetName。 - 对于早期版本，该方法实现起来要复杂得多，因为它可能涉及扫描指定项目可执行文件扩展名的 $E 指令，然后在"OptputDir" 项目选项指定的路径，或项目目录（如果该选项为空）（在许多其他可能性和复杂性中）。实现此类工具的最佳方式可能是从CodeGear CodeCentral sample ID 19823 中的示例代码开始。

就我而言，我适合后者。给定一个IOTAProject 接口，它的核心是什么：

function GetTargetName(Project: IOTAProject): TFilename;
begin
   //todo
end;

---

如果是 Delphi 8 或更高版本，（未经测试的）答案是：

$I compilers.inc

function GetTargetName(Project: IOTAProject): TFilename;
begin
$IFDEF COMPILER_8_UP
   Result := Project.ProjectOptions.TargetName;
$ELSE
   raise Exception.Create('Not yet implemented');
$ENDIF
end;

但更难的是复杂的 pre-Delphi 8。

Jedi JCL 在内部TJclOTAExpert 中有十几种方法，它们一起可以用来模拟：

Project.ProjectOptions.TargetName

我将努力完成该代码。几周后，我希望能够发布我自己问题的答案。

但与此同时，我会打开它，让其他人因能够回答我的问题而获得声誉。

【参考方案1】：

据我所知，您提到的 link 在 Delphi 8 之前的版本中运行良好。您只需复制GetTargetFileName 函数和它使用的一些函数。

编辑：感谢Premature Optimization 我现在知道在源代码中使用Delphi 6+ $LibPrefix 和相关指令时，此函数会遗漏/忽略。不过，这在 Delphi 5 中应该不会造成任何问题。

该函数执行以下操作：

根据项目类型及其项目选项确定当前项目的输出目录 通过评估注册表和系统环境中的变量来翻译 $(...) 变量引用（如果有） 确定目标文件名（基于项目类型、扩展覆盖指令、前缀和后缀项目选项，如果有）

代码应该为您提供在 Delphi 5 到 7 中为项目获取正确目标文件名所需的一切。

编辑：这里是代码（从link复制+粘贴）：

$IFDEF VER130
  $DEFINE DELPHI_5_UP
$ENDIF
$IFDEF VER140
  $DEFINE DELPHI_5_UP
  $DEFINE DELPHI_6_UP
$ENDIF

$IFDEF VER150
  $DEFINE DELPHI_5_UP
  $DEFINE DELPHI_6_UP
  $DEFINE DELPHI_7_UP
$ENDIF

$IFNDEF DELPHI_5_UP
  Delphi 5 or higher required.
$ENDIF

$IFNDEF DELPHI_6_UP
function ExcludeTrailingPathDelimiter(const S: string): string; forward;
function IncludeTrailingPathDelimiter(const S: string): string; forward;
$ENDIF

// get Delphi root directory

function GetDelphiRootDirectory: string;
$IFNDEF DELPHI_7_UP
var
  Registry: TRegistry;
$ENDIF
begin
  $IFDEF DELPHI_7_UP
    Result := (BorlandIDEServices as IOTAServices).GetRootDirectory;
  $ELSE
    Registry := TRegistry.Create(KEY_READ);
    try
      if Registry.OpenKeyReadOnly((BorlandIDEServices as IOTAServices).GetBaseRegistryKey) then
        Result := Registry.ReadString('RootDir');
    finally
      Registry.Free;
    end;
  $ENDIF
end;

// get Delphi environment variables (name-value pairs) from the registry

procedure GetEnvVars(Strings: TStrings);
var
  Registry: TRegistry;
  I: Integer;
begin
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    if Registry.OpenKeyReadOnly((BorlandIDEServices as IOTAServices).GetBaseRegistryKey + '\Environment Variables') then
    begin
      Registry.GetValueNames(Strings);
      for I := 0 to Strings.Count - 1 do
        Strings[I] := Strings[I] + '=' + Registry.ReadString(Strings[I]);
    end;
  finally
    Registry.Free;
  end;
end;

// get output directory of a project

function GetProjectOutputDir(const Project: IOTAProject): string;
begin
  if Project.ProjectOptions.Values['GenPackage'] then // package project
  begin
    // use project options if specified
    Result := Project.ProjectOptions.Values['PkgDllDir'];
    // otherwise use environment options
    if Result = '' then
      Result := (BorlandIDEServices as IOTAServices).GetEnvironmentOptions.Values['PackageDPLOutput'];
  end
  else // non-package project, use project options
    Result := Project.ProjectOptions.Values['OutputDir'];

  // default is the project's path
  if Result = '' then
    Result := ExtractFilePath(Project.FileName);

  Result := IncludeTrailingPathDelimiter(Result);
end;

// get project source editor

function GetProjectSourceEditor(const Project: IOTAProject): IOTASourceEditor;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Project.GetModuleFileCount - 1 do
    if Supports(Project.GetModuleFileEditor(I), IOTASourceEditor, Result) then
      Break;
end;

// get system environment variables

procedure GetSysVars(Strings: TStrings);
var
  P: PChar;
begin
  P := GetEnvironmentStrings;
  try
    repeat
      Strings.Add(P);
      P := StrEnd(P);
      Inc(P);
    until P^ = #0;
  finally
    FreeEnvironmentStrings(P);
  end;
end;

function GetTargetExtOverride(const Project: IOTAProject): string; overload; forward;

// get target extension

function GetTargetExt(const Project: IOTAProject): string;
begin
  // use $E ... override if specified
  Result := GetTargetExtOverride(Project);
  // otherwise use defaults
  if Result = '' then
  begin
    if Project.ProjectOptions.Values['GenPackage'] then // package
      Result := '.bpl'
    else if Project.ProjectOptions.Values['GenDll'] then // DLL
      Result := '.dll'
    else // application
      Result := '.exe';
  end;
end;

// read $E ... directive from project source

function GetTargetExtOverride(const ProjectSource: string): string; overload;
var
  P: PChar;

  procedure SkipComment(var P: PChar);
  begin
    case P^ of
      '':
        begin
          while not (P^ in [#0, '']) do
            Inc(P);
          if P^ = '' then
            Inc(P);
        end;
      '/':
        if (P + 1)^ = '/' then
        begin
          while not (P^ in [#0, #10, #13]) do
            Inc(P);
          while (P^ in [#10, #13]) do
            Inc(P);
        end;
      '(':
        if (P + 1)^ = '*' then
          repeat
            Inc(P);
            case P^ of
              #0:
                Break;
              '*':
                if (P + 1)^ = ')' then
                begin
                  Inc(P, 2);
                  Break;
                end;
            end;
          until False;
    end;
  end;

  procedure SkipStringLiteral(var P: PChar);
  begin
    if P^ <> '''' then
      Exit;
    Inc(P);
    repeat
      case P^ of
        #0:
          Break;
        '''':
          begin
            Inc(P);
            if P^ = '''' then
              Inc(P)
            else
              Break;
          end;
        else
          Inc(P);
      end;
    until False;
  end;

  procedure SkipNonDirectives(var P: PChar);
  begin
    repeat
      case P^ of
        #0:
          Break;
        '''':
          SkipStringLiteral(P);
        '/':
          case (P + 1)^ of
            '/':
              SkipComment(P);
            else
              Inc(P);
          end;
        '(':
          case (P + 1)^ of
            '*':
              SkipComment(P);
            else
              Inc(P);
          end;
        '':
          begin
            case (P + 1)^ of
              '$':
                Break;
              else
                SkipComment(P);
            end;
          end;
        else
          Inc(P);
      end;
    until False;
  end;
begin
  P := PChar(ProjectSource);
  repeat
    SkipNonDirectives(P);
    case P^ of
      #0:
        Break;
      '':
        if StrLIComp(P, '$E ', 4) = 0 then
        begin
          Inc(P, 4);
          Result := '.';
          while P^ = ' ' do
            Inc(P);
          while not (P^ in [#0, '']) do
          begin
            if P^ <> ' ' then
              Result := Result + P^;
            Inc(P);
          end;
          Break;
        end
        else
          SkipComment(P);
    end;
  until False;
end;

// read $E ... directive from project source module

function GetTargetExtOverride(const Project: IOTAProject): string; overload;
const
  BufferSize = 1024;
var
  SourceEditor: IOTASourceEditor;
  EditReader: IOTAEditReader;
  Buffer: array[0..BufferSize - 1] of Char;
  Stream: TStringStream;
  ReaderPos, CharsRead: Integer;
begin
  SourceEditor := GetProjectSourceEditor(Project);
  if Assigned(SourceEditor) then
  begin
    EditReader := SourceEditor.CreateReader;
    Stream := TStringStream.Create('');
    try
      ReaderPos := 0;
      repeat
        CharsRead := EditReader.GetText(ReaderPos, Buffer, BufferSize - 1);
        Inc(ReaderPos, CharsRead);
        Buffer[CharsRead] := #0;
        Stream.WriteString(Buffer);
      until CharsRead < BufferSize - 1;
      Result := GetTargetExtOverride(Stream.DataString);
    finally
      Stream.Free;
    end;
  end;
end;

// get project target file name (with path), resolve $(...) macros if used

function GetTargetFileName(const Project: IOTAProject): string;
var
  PStart, PEnd: PChar;
  EnvVar, Value, FileName, Ext, S: string;
  EnvVars, SysVars: TStringList;
  I: Integer;
begin
  EnvVars := nil;
  SysVars := nil;
  try
    Result := GetProjectOutputDir(Project);
    PStart := StrPos(PChar(Result), '$(');
    while PStart <> nil do
    begin
      Value := '';

      PEnd := StrPos(PStart, ')');
      if PEnd = nil then
        Break;
      SetString(EnvVar, PStart + 2, PEnd - PStart - 2);
      if CompareText(EnvVar, 'DELPHI') = 0 then // $(DELPHI) macro is hardcoded
        Value := GetDelphiRootDirectory
      else
      begin
        // try Delphi environment variables from the registry
        if not Assigned(EnvVars) then
        begin
          EnvVars := TStringList.Create;
          GetEnvVars(EnvVars);
        end;

        for I := 0 to EnvVars.Count -1 do
          if CompareText(EnvVar, EnvVars.Names[I]) = 0 then
          begin
            $IFDEF DELPHI_7_UP
            Value := ExcludeTrailingPathDelimiter(EnvVars.ValueFromIndex[I]);
            $ELSE
            Value := ExcludeTrailingPathDelimiter(EnvVars.Values[EnvVars.Names[I]]);
            $ENDIF
            Break;
          end;
        if Value = '' then
        begin
          // try system environment variables
          if not Assigned(SysVars) then
          begin
            SysVars := TStringList.Create;
            GetSysVars(SysVars);
          end;
          for I := 0 to SysVars.Count - 1 do
            if CompareText(EnvVar, SysVars.Names[I]) = 0 then
            begin
              $IFDEF DELPHI_7_UP
              Value := ExcludeTrailingPathDelimiter(SysVars.ValueFromIndex[I]);
              $ELSE
              Value := ExcludeTrailingPathDelimiter(SysVars.Values[SysVars.Names[I]]);
              $ENDIF
              Break;
            end;
        end;
      end;

      I := PStart - PChar(Result) + 1;
      Delete(Result, I, Length(EnvVar) + 3);
      Insert(Value, Result, I);

      PStart := StrPos(PChar(Result), '$(');
    end;
    Ext := GetTargetExt(Project);
    FileName := ChangeFileExt(ExtractFileName(Project.FileName), '');
    // include prefix/suffix/version for DLL and package projects
    if Project.ProjectOptions.Values['GenDll'] then
    begin
      S := Project.ProjectOptions.Values['SOPrefix'];
      if Project.ProjectOptions.Values['SOPrefixDefined'] then
        FileName := S + FileName;
      S := Project.ProjectOptions.Values['SOSuffix'];
      if (S <> '') then
        FileName := FileName + S;
      FileName := FileName + Ext;
      S := Project.ProjectOptions.Values['SOVersion'];
      if S <> '' then
      FileName := FileName + '.' + S;
    end
    else
      FileName := FileName + Ext;
    Result := Result + FileName;
  finally
    EnvVars.Free;
    SysVars.Free;
  end;
end;

$IFNDEF DELPHI_6_UP
function ExcludeTrailingPathDelimiter(const S: string): string;
begin
  Result := ExcludeTrailingBackslash(S);
end;

function IncludeTrailingPathDelimiter(const S: string): string;
begin
  Result := IncludeTrailingBackslash(S);
end;
$ENDIF

【讨论】：

现在只需在此处复制粘贴您的代码，您就会得到一个接受的答案:) 否则我必须注册 另一个 Embargadero 帐户才能查看代码。

@IanBoyd 完成。我很好奇，为什么要注册另一个 Embarcadero 帐户才能下载代码？

作为 Codegaer，他们过去常常发送 not solicited 消息，所以... 无论如何，Ondrej，您在该向导中有几个错误：1) $LibPrefix 等指令被忽略 2) 时间戳应该是一个纪元时间，即 - UTC。

创建和/或对抗 DLL 地狱 LOL！

@RobKennedy 从某人那里获得软件许可并不意味着我必须提供电子邮件地址或创建一个帐户（例如，在我拥有 Windows、Office 之后，MS 没有我的电子邮件地址和 Visual Studio）。我尝试使用 OpenID 登录 CodeGear，但 CG 不支持我用来登录 SO 的 OpenID。我建议codegear：与其要求我创建一个帐户，不要要求我创建一个帐户。但这无关紧要。关键是用于回答此问题的代码位于需要注册的封闭站点上。在此处复制粘贴代码，以便人们使用。