compile.pas

East make Tray Icon in delphi

function TJVCLCompiler.GeneratePackages(const Group, Targets, PackagesPath: string): Boolean;
var
  ErrMsg: string;
  List, TargetList: TStrings;
begin
  Result := False;

  FAborted := False;
  CaptureLine(RsGeneratePackages, FAborted);
  if FAborted then
  begin
    AbortReason := RsAbortedByUser;
    Exit;
  end;

  try
    if not LoadConfig(Data.JVCLDir + '\' + sPackageGeneratorFile, Group, ErrMsg) then
    begin
      CaptureLine(ErrMsg, FAborted);
      AbortReason := RsErrorLoadingPackageGeneratorConfigFile;
      Exit;
    end;
  except
    on E: Exception do
    begin
      AbortReason := RsErrorLoadingPackageGeneratorConfigFile + #10#10 + E.Message;
      Exit;
    end;
  end;

  List := TStringList.Create;
  TargetList := TStringList.Create;
  try
    TargetList.CommaText := Targets;
    ExpandTargetsNoPerso(TargetList);
    EnumeratePackages(PackagesPath, List);
    if not Generate(List, TargetList, WriteMsg, Data.JVCLDir + '\' + sPackageGeneratorFile,
                    Group, ErrMsg, PackagesPath, '', '', Data.JVCLDir + '\common\jvcl%t.inc') then
    begin
      CaptureLine(ErrMsg, FAborted);
      AbortReason := Format(RsErrorGeneratingPackages, [TargetList.CommaText]);
      Exit;
    end;
  finally
    List.Free;
    TargetList.Free;
  end;
  Result := True;
end;

/// <summary>
/// PrepareJCL compiles the .dcp files for C++Builder targets where the JVCL
/// should be installed.
/// </summary>
function TJVCLCompiler.PrepareJCL(TargetConfig: ITargetConfig; Force: Boolean): Boolean;
var
  Args: string;
  TargetPkgDir, TargetXmlDir, S: string;
begin
  Result := False;
  TargetPkgDir := Format('%s\packages\c%d',
                         [TargetConfig.JCLDir, TargetConfig.Target.Version]);
  TargetXmlDir := Format('%s\packages\xml', [TargetConfig.JCLDir]);

  // Are the .dcp files newer than the .lib files? If so we have nothing to do.
  with TargetConfig do
  begin
    if Target.Version = 5 then S := '50' else S := '';
    if (not Force) and (not Build) and
       FileExists(Format('%s\CJcl%s.dcp', [BplDir, S])) and
       FileExists(Format('%s\CJclVcl%s.dcp', [BplDir, S])) then
    begin
       if (CompareFileAge('%s\CJcl%s.dcp', [BplDir, S],
                          '%s\CJcl.lib', [DcpDir]) > 0) and
          (CompareFileAge('%s\CJclVcl%s.dcp', [BplDir, S],
                          '%s\CJclVcl.lib', [DcpDir]) > 0) then
       begin
         Result := True;
         Exit; // nothing to do
       end;
    end;

    // let the compiler rebuild the dcp files
    DeleteFile(Format('%s\CJcl%s.dcp', [BplDir, S]));
    DeleteFile(Format('%s\CJclVcl%s.dcp', [BplDir, S]));
    DeleteFile(Format('%s\CJclVClx%s.dcp', [BplDir, S]));

    // sometimes the files are in the wrong directory
    DeleteFile(Format('%s\CJcl%s.dcp', [DcpDir, S]));
    DeleteFile(Format('%s\CJclVcl%s.dcp', [DcpDir, S]));
    DeleteFile(Format('%s\CJclVClx%s.dcp', [DcpDir, S]));
  end;

  // redirect DCPDir to the BPLDir
  SetEnvironmentVariable('DCPDIR', PChar(TargetConfig.BplDir));
  SetEnvironmentVariable('JCLROOT', PChar(string(Core.PackageInstaller.Installer.GetJCLDir)));
  try
    Args := '-f MakeJCLDcp4BCB.mak';

    DoPackageProgress(nil, RsCompilingJCL, 0, 3);
    try
     // copy template for PackageGenerator
      if Make(TargetConfig, Args + FQuiet + ' Templates', CaptureLine,
        Data.JVCLPackagesDir + '\bin') <> 0 then
      begin
        AbortReason := RsErrorGeneratingTemplates;
        Exit;
      end;
      DoPackageProgress(nil, RsCompilingJCL, 1, 3);

      // generate packages
      Result := GeneratePackages('JCL', 'c' + IntToStr(TargetConfig.Target.Version),
        TargetConfig.JCLDir + '\packages');
      DoPackageProgress(nil, RsCompilingJCL, 2, 3);

      // compile dcp files
      if Make(TargetConfig, Args + FQuiet, CaptureLine,
        Data.JVCLPackagesDir + '\bin') <> 0 then
      begin
        AbortReason := RsErrorCompilingJclDcpFiles;
        Exit;
      end;
    finally
      // clean
      Make(TargetConfig, Args + FQuiet + ' Clean', CaptureLineClean,
        Data.JVCLPackagesDir + '\bin');
    end;
  finally
    // restore
    SetEnvironmentVariable('DCPDIR', Pointer(TargetConfig.DcpDir));
  end;

  DoPackageProgress(nil, '', 0, 100);

  Result := True;
end;

/// <summary>
/// GenerateAllPackages generates all JVCL packages
/// </summary>
function TJVCLCompiler.GenerateAllPackages: Boolean;
begin
  Result := GeneratePackages('JVCL', 'all', Data.JVCLPackagesDir);
end;

function TJVCLCompiler.Compile(Force: Boolean = False): Boolean;
var
  i, Index: Integer;
  Frameworks, Count: Integer;
  TargetConfigs: array of TTargetConfig;
  SysInfo: string;
begin
  Result := True;
  if Data.Verbose then
    FQuiet := ''
  else
    FQuiet := ' -s';

  SysInfo := '';
  case Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        case Win32MinorVersion of
          0..9: SysInfo := 'Windows 95';
          10..89: SysInfo := 'Windows 98';
          90: SysInfo := 'Windows ME';
        end;
      end;
    VER_PLATFORM_WIN32_NT:
      begin
        case Win32MajorVersion of
          4: SysInfo := 'Windows NT4';
          5:
            begin
              case Win32MinorVersion of
                0: SysInfo := 'Windows 2000';
                1: SysInfo := 'Windows XP';
              end;
            end;
        end;
      end;
  end;

  if SysInfo <> '' then
  begin
    SysInfo := #1 + SysInfo + Format(' %s (%d.%d.%d)',
      [Win32CSDVersion, Win32MajorVersion, Win32MinorVersion, Win32BuildNumber]);

    CaptureLine(SysInfo, FAborted);
    CaptureLine('', FAborted);
  end;

  AbortReason := '';
  // read target configs that should be compiled
  Count := 0;
  Frameworks := 0;
  SetLength(TargetConfigs, Data.Targets.Count);
  for i := 0 to High(TargetConfigs) do
  begin
    if Data.TargetConfig[i].InstallJVCL then
    begin
      with Data.TargetConfig[i] do
      begin
        if not Target.IsBCB then
        begin
          // Delphi requires .bpl files
          if not FileExists(Format('%s\DJcl%d0.bpl', [BplDir, Target.Version])) and
             not FileExists(Format('%s\DJcl%d0.bpl', [Target.BplDir, Target.Version])) then
            Continue; // do not install JVCL when no JCL is installed
        end;
      end;
      TargetConfigs[Count] := Data.TargetConfig[i];
      Inc(Count);
      if pkVCL in Data.TargetConfig[i].InstallMode then
        Inc(Frameworks);
      if pkCLX in Data.TargetConfig[i].InstallMode then
        Inc(Frameworks);
    end;
  end;
  SetLength(TargetConfigs, Count);

  // compile all targets
  Index := 0;
  for i := 0 to Count - 1 do
  begin
    DoTargetProgress(TargetConfigs[i], Index, Frameworks);
    if pkVCL in TargetConfigs[i].InstallMode then
    begin
      Result := CompileTarget(TargetConfigs[i], Force, {CLX:=}False);
      if not Result then
        Break;
      Inc(Index);
    end;
    DoTargetProgress(TargetConfigs[i], Index, Frameworks);
    if pkClx in TargetConfigs[i].InstallMode then
    begin
      Result := CompileTarget(TargetConfigs[i], Force, {CLX:=}True);
      if not Result then
        Break;
      Inc(Index);
    end;
    DoTargetProgress(TargetConfigs[i], Index, Frameworks);
  end;
end;

/// <summary>
/// CompileTarget starts CompileProjectGroup for all sub targets of the
/// given target IDE.
/// </summary>
function TJVCLCompiler.CompileTarget(TargetConfig: TTargetConfig;
  ForceJclDcp: Boolean; DoClx: Boolean): Boolean;
var
  ObjFiles: TStrings;
  i: Integer;
  Aborted: Boolean;
begin
  Result := True;
  Aborted := False;
  FOutput.Clear;

  if TargetConfig.Target.IsBCB and TargetConfig.Build then // CLX for BCB is not supported
  begin
    // Delete all .obj and .dcu files because dcc32.exe -JPHNE does not create new .obj
    // files if they already exist. And as a result interface changes in a unit
    // let the bcc32.exe compiler fail.
    ObjFiles := TStringList.Create;
    try
      FindFiles(TargetConfig.UnitOutDir, '*.*', True, ObjFiles, ['.obj', '.dcu']);
      for i := 0 to ObjFiles.Count - 1 do
        DeleteFile(ObjFiles[i]);
    finally
      ObjFiles.Free;
    end;
  end;

  // VCL
  if Result and (pkVCL in TargetConfig.InstallMode) and not DoClx then
  begin
    if not TargetConfig.DeveloperInstall then
    begin
      // debug units
      if (not TargetConfig.Target.IsBCB) and TargetConfig.DebugUnits then
        Result := CompileProjectGroup(
          TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkVCL], True,
            ForceJclDcp);
    end;

    if Result then
      // compile
      Result := CompileProjectGroup(
        TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkVCL], False,
          ForceJclDcp);

    if Result or not CmdOptions.KeepFiles then
      Make(TargetConfig, FQuiet + ' Clean', CaptureLineClean);
    if Result then
      CaptureLine('[Finished JVCL for VCL installation]', Aborted); // do not localize
  end;

  // CLX
  if Result and (pkClx in TargetConfig.InstallMode) and DoClx then
  begin
    if not FileExists(TargetConfig.BplDir + '\clxdesigner.dcp') then
    begin
      // Delphi 7 has no clxdesigner.dcp so we compile it from Delphi's property
      // editor source.
      CaptureExecute(Data.JVCLPackagesDir + '\bin\MakeClxDesigner.bat', '',
        Data.JVCLPackagesDir + '\bin', CaptureLine, nil, False);
    end;

    if not TargetConfig.DeveloperInstall then
    begin
      // debug units
      if (not TargetConfig.Target.IsBCB) and TargetConfig.DebugUnits then
        Result := CompileProjectGroup(
          TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkClx], True,
            ForceJclDcp);
    end;

    if Result then
      // compile
      Result := CompileProjectGroup(
        TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkClx], False,
          ForceJclDcp);

    if Result or not CmdOptions.KeepFiles then
      Make(TargetConfig, FQuiet + ' Clean', CaptureLineClean);
    if Result then
      CaptureLine('[Finished JVCL for CLX installation]', Aborted); // do not localize
  end;
end;

/// <summary>
/// GenerateResources starts the make file for the resource file compilation.
/// </summary>
function TJVCLCompiler.GenerateResources(TargetConfig: ITargetConfig): Boolean;
begin
  Result := False;

  // get number of resources to compile
  FCount := 0;
  if Make(TargetConfig, '-f makefile.mak -n', CaptureLineGetCompileCount, TargetConfig.JVCLDir + '\images') <> 0 then
  begin
    AbortReason := RsErrorCompilingResources;
    Exit;
  end;
  // update FResCount with the number of resources that MAKE will compile
  FResCount := FCount;

  FResIndex := 0;
  if FCount > 0 then
  begin