【问题标题】:Delphi OpenTools API: How to get target exe name?Delphi OpenTools API:如何获取目标 exe 名称?
【发布时间】: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

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

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

【问题讨论】:

    标签: delphi delphi-5 opentools


    【解决方案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:与其要求我创建一个帐户,不要要求我创建一个帐户。但这无关紧要。关键是用于回答此问题的代码位于需要注册的封闭站点上。在此处复制粘贴代码,以便人们使用。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-01-12
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多