CODEWITHSUNDEEP
delphidelphi-5opentools
Ian Boyd
Ian Boyd

Reputation: 256651

Delphi OpenTools API: How to get target exe name?

How can i get the name of the target executable given an IOTAProject?

From GExpert's OpenTools API FAQ:

How can I determine the filename of the binary/exe/dll/bpl/ocx/etc. generated by a compile or build?
- For Delphi 8 or greater, use IOTAProjectOptions.TargetName.
- For earlier releases, the method is a lot more complex to implement because it involves potentially scanning for the $E directive that specifies the executable file extension for the project, and then looking for the binary file on the path specified by the "OptputDir" project option, or the project directory if that option is blank (among many other possibilities and complexities). The best way to implement such a tool might be to start with the sample code in CodeGear CodeCentral sample ID 19823.

In my case i fit into the latter. Given an IOTAProject interface, what would be the guts of:

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

If it's Delphi 8 or greater, the (untested) answer is:

{$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;

But it's the complicated pre-Delphi 8 that's harder.

The Jedi JCL has a dozen methods in the internal TJclOTAExpert that together can be used to simulate:

Project.ProjectOptions.TargetName

i will be working to slog through that code. In a few weeks i'll hopefully be able to post an answer to my own question.

But in the meantime i'll open it up to let someone else get reputation for being able to answer my question.

Upvotes: 2

Views: 2076

Answers (1)

Ondrej Kelle
Ondrej Kelle

Reputation: 37211

The link you mentioned is, as far as I know, working fine for pre-Delphi 8 versions. You just need to copy the GetTargetFileName function and a few functions it uses.

Edit: Thanks to Premature Optimization I now know that Delphi 6+ $LibPrefix and related directives, when used in the source code, are missed/ignored by this function. This should cause no trouble in Delphi 5, though.

The function does the following:

  • determines the output directory for the current project, based on the type of the project and its project options
  • translates $(...) variable references, if any, by evaluating variables from the registry and from the system environment
  • determines the target file name (based on the type of the project, extension override directive, prefix and suffix project options, if any)

The code should give you everything you need to get the correct target file name for a project in Delphi 5 to 7.

Edit: here is the code (copy+pasted from the 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}

Upvotes: 6

Related Questions