2

给定一个，我如何获得目标可执行文件的名称IOTAProject？

来自GExpert 的 OpenTools API 常见问题解答：

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

但更难的是复杂的预德尔福 8。

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

Project.ProjectOptions.TargetName

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

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

4

1 回答 1

6

据我所知，您提到的链接适用于 Delphi 8 之前的版本。你只需要复制GetTargetFileName函数和它使用的几个函数。

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

该函数执行以下操作：

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

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

编辑：这是代码（从链接复制+粘贴）：

{$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}
于 2011-11-01T22:04:34.357 回答