jclinstall.pas

East make Tray Icon in delphi

  JclChmHelpFile    = 'help' + PathSeparator + 'JCLHelp.chm';
  JclHlpHelpFile    = 'help' + PathSeparator + 'JCLHelp.hlp';
  JclHelpTitle      = 'JCL %d.%d Help';
  JclHelpIndexName  = 'Jedi Code Library Reference';
  HHFileName        = 'HH.EXE';

resourcestring
  RsStatusMessage   = 'Installing %s...';
  RsStatusDetailMessage = 'Installing %s for %s...';
  RsUninstallMessage = 'Removing %s...';
  RsInstallFailed   = 'Installation of %s failed, see %s for details.';
  RsInvalidBplPath  = LineBreak + 'Invalid BPL path "%s"';
  RsInvalidDcpPath  = LineBreak + 'Invalid DCP path "%s"';
  RsLibDescriptor   = '%s library %sunits for %s';
  {$IFDEF VisualCLX}
  RsReadmeFileName  = 'Readme.html';
  {$ELSE}
  RsReadmeFileName  = 'Readme.txt';
  {$ENDIF}
  RsIniFileName = 'JCL-install.ini';

function CreateJclInstall: IJediInstall;
begin
  Result := TJclDistribution.Create as IJediInstall;
end;

function CopyFiles(Files: TStrings; const TargetDir: string; Overwrite: Boolean = True): Boolean;
var
  I: Integer;
  FileName: string;
begin
  Result := True;
  for I := 0 to Files.Count - 1 do
  begin
    FileName := Files[I];
    Result := Result and FileCopy(FileName, PathAddSeparator(TargetDir) + ExtractFileName(FileName), Overwrite);
  end;
end;

procedure CopyResFiles(TargetDir: string);
var
  FileList: TStringList;
begin
  FileList := TStringList.Create;
  try
    if BuildFileList('*.res', faAnyFile, FileList) then
      CopyFiles(FileList, TargetDir);
  finally
    FileList.Free;
  end;
end;

function CopyHppFiles(Units: TStrings; const TargetDir: string): Boolean;
var
  I: Integer;
  FileName: string;
begin
  Result := True;
  for I := 0 to Units.Count - 1 do
  begin
    FileName := Units[I] + '.hpp';
    Result := Result and FileCopy(FileName, TargetDir + FileName, True);
  end;
end;

function FullPackageFileName(Target: TJclBorRADToolInstallation; const BaseName: string): string;
const
  S = 'packages' + VersionDir + PathSeparator + '%s%s';
var
  Prefix: string;
begin
  with Target do
  begin
    Prefix := Prefixes[RADToolKind];
    if DCC.SupportsLibSuffix then
      Result := Format(S + '%s', [{$IFNDEF KYLIX}AnsiLowerCase(Prefix), {$ENDIF}VersionNumber, Prefix, BaseName, PackageSourceFileExtension])
    else
      Result := Format(S + '%1:d0%4:s', [AnsiLowerCase(Prefix), VersionNumber, Prefix, BaseName, PackageSourceFileExtension]);
  end;
end;

function LogFileName(Target: TJclBorRADToolInstallation): string;
begin
  with Target do
    Result := Format('%s%s%d.log', [PathAddSeparator(ExtractFileDir(ParamStr(0))), RADToolName, VersionNumber]);
end;

{ TJclInstallation }

constructor TJclInstallation.Create(JclDistribution: TJclDistribution;
  InstallTarget: TJclBorRADToolInstallation);
begin
  inherited Create;
  FDistribution := JclDistribution;
  FTarget := InstallTarget;
  InstallTarget.DCC.OutputCallback := WriteLog;
  InstallTarget.Make.OutputCallback := WriteLog;
  if InstallTarget is TJclBCBInstallation then
    TJclBCBInstallation(InstallTarget).Bpr2Mak.OutputCallback := WriteLog;
  FDebugDcuDir := MakePath(Distribution.FLibDebugDirMask);
  FLibDir := MakePath(Distribution.FLibDirMask);
  FLibObjDir := MakePath(Distribution.FLibObjDirMask);
  FDefines := TStringList.Create;
  FUnits := TStringList.Create;
end;

destructor TJclInstallation.Destroy;
var
  I: Integer;
begin
  for I := 0 to FUnits.Count - 1 do
    FUnits.Objects[I].Free;
  FDefines.Free;
  inherited Destroy;
end;

procedure TJclInstallation.AddDialogToRepository(const DialogName: string;
  const DialogFileName: string; const DialogIconFileName: string; const Designer: string;
  const Ancestor: string = '');
begin
  WriteLog(Format(LineBreak + 'Installing %s...', [DialogName]));
  with Target.Repository do
    AddObject(
      DialogFileName,
      BorRADToolRepositoryFormTemplate,
      FindPage(DialogPage, 1),
      DialogName,
      DialogIconFileName,
      DialogDescription,
      DialogAuthor,
      BorRADToolRepositoryDesignerDfm);
  WriteLog(Format('-> %s' + LineBreak + '-> %s' + LineBreak +
    '...done.', [DialogFileName, DialogIconFileName]));
end;

{$IFDEF MSWINDOWS}
procedure TJclInstallation.AddHelpToIdeTools;
var
  ToolsIndex: Integer;
  HelpTitle: string;
begin
  HelpTitle := Format(JclHelpTitle, [JclVersionMajor, JclVersionMinor]);
  with Target.IdeTools do
    if IndexOfTitle(HelpTitle) = Invalid then
    begin
      ToolsIndex := Count;
      Count := ToolsIndex + 1;
      Title[ToolsIndex] := HelpTitle;
      Path[ToolsIndex] := HHFileName;
      Parameters[ToolsIndex] := StrDoubleQuote(FDistribution.FJclChmHelpFileName);
      WorkingDir[ToolsIndex] := FDistribution.FJclPath;
    end;
end;

procedure TJclInstallation.AddHelpToOpenHelp;
begin
  if Target.OpenHelp.AddHelpFile(Distribution.FJclHlpHelpFileName, JclHelpIndexName) then
    WriteLog(Format(LineBreak + 'Added %s to %s Online Help', [Distribution.FJclHlpHelpFileName, Target.RADToolName]));
end;
{$ENDIF MSWINDOWS}

function TJclInstallation.BplPath: string;
begin
  Result := Tool.BPLPath[Target];
end;

function TJclInstallation.DcpPath: string;
begin
  Result := Tool.DCPPath[Target];
end;

function TJclInstallation.CheckDirectories: Boolean;
begin
  Result := not OptionSelected(ioJclPackages);
  if not Result then
  begin
    Result := True;
    if not DirectoryExists(BplPath) then
    begin
      WriteLog(Format(RsInvalidBplPath, [BplPath]));
      Result := False;
    end;
    if not DirectoryExists(DcpPath) then
    begin
      WriteLog(Format(RsInvalidDcpPath, [DcpPath]));
      Result := False;
    end;
  end;
end;

procedure TJclInstallation.CleanupRepository;
begin
  if OptionSelected(ioJCL) then
    with Target.Repository do
    begin
      RemoveObjects(DialogsPath, ClxDialogFileName, BorRADToolRepositoryFormTemplate);
      {$IFDEF MSWINDOWS}
      RemoveObjects(DialogsPath, VclDialogFileName, BorRADToolRepositoryFormTemplate);
      RemoveObjects(DialogsPath, VclDlgSndFileName, BorRADToolRepositoryFormTemplate);
      {$ENDIF MSWINDOWS}
    end;
end;

function TJclInstallation.CompileLibraryUnits(const SubDir: string; Debug: Boolean): Boolean;
var
  UnitList: TStrings;
  UnitType: string;
  LibDescriptor: string;
  SaveDir, UnitOutputDir: string;
  Path: string;

  function CompilationOptions: string;
  begin
    if FTarget.RADToolKind = brCppBuilder then
    begin
      Result := StringsToStr(Target.DCC.Options, ' ') + ' ';
      Result := StringReplace(Result, '$(BCB)', Target.RootDir, [rfReplaceAll]);
    end
    else
      Result := '';
  end;

  function CompileUnits: Boolean;
  {$IFDEF COMPILE_UNITS_SEPARATELY // gives better progress resolution }
  var
    I: Integer;
  begin
    Result := True;
    for I := 0 to UnitList.Count - 1 do
    begin
      Result := Target.DCC.Execute({$IFNDEF KYLIX}CompilationOptions + {$ENDIF}UnitList[I]);
      Progress(1);
      if not Result then
        Break;
    end;
  end;
  {$ELSE}
  begin
    Result := Target.DCC.Execute({$IFNDEF KYLIX}CompilationOptions + {$ENDIF}StringsToStr(UnitList, ' '));
    Progress(UnitList.Count);
  end;
  {$ENDIF}

begin
  if Debug then
    UnitType := 'debug ';
  LibDescriptor := Format(RsLibDescriptor, [SubDir, UnitType, Target.Name]);
  WriteLog(Format(LineBreak + 'Making %s', [LibDescriptor]));
  Tool.UpdateStatus(Format('Compiling %s...', [LibDescriptor]));
  Path := Format('%s' + PathSeparator + '%s', [Distribution.SourceDir, SubDir]);
  UnitList := Units[SubDir];
  with Target.DCC do
  begin
    SetDefaultOptions;
    Options.Add('-D' + StringsToStr(Defines, ';'));
    Options.Add('-M');
    if Target.RADToolKind = brCppBuilder then
    begin
      Options.Add('-D_RTLDLL;NO_STRICT;USEPACKAGES'); // $(SYSDEFINES)
      if Debug then
      begin
        Options.Add('-$Y+');
        Options.Add('-$W');
        Options.Add('-$O-');
        Options.Add('-v');
        UnitOutputDir := MakePath(Distribution.FLibDebugDirMask);
        AddPathOption('N2', MakePath(Distribution.FLibDirMask + PathSeparator + 'obj')); // .obj files
      end
      else
      begin
        Options.Add('-$YD');
        Options.Add('-$W+');
        Options.Add('-$O+');
        UnitOutputDir := MakePath(Distribution.FLibDirMask);
        AddPathOption('N2', UnitOutputDir + PathSeparator + 'obj'); // .obj files
      end;
      Options.Add('-v');
      Options.Add('-JPHNE');
      Options.Add('--BCB');
      {$IFDEF KYLIX}
      //Options.Add('-LUrtl -LUvisualclx');
      {$ELSE ~KYLIX}
      if Target.VersionNumber = 5 then
        Options.Add('-LUvcl50')
      else
        Options.Add('-LUrtl');
      {$ENDIF ~KYLIX}
      AddPathOption('N0', UnitOutputDir); // .dcu files
      AddPathOption('O', Format(BCBIncludePath, [Distribution.SourceDir, Distribution.SourcePath]));
      AddPathOption('U', Format(BCBObjectPath, [Distribution.SourceDir, Distribution.SourcePath]));
    end
    else // Delphi
    begin
      if Debug then
      begin
        Options.Add('-$O-');
        Options.Add('-$W+');
        Options.Add('-$R+');
        Options.Add('-$Q+');
        Options.Add('-$D+');
        Options.Add('-$L+');
        Options.Add('-$Y+');
        UnitOutputDir := MakePath(Distribution.FLibDebugDirMask);
      end
      else
      begin
        Options.Add('-$O+');
        Options.Add('-$R-');
        Options.Add('-$Q-');
        Options.Add('-$C-');
        Options.Add('-$D-');
        UnitOutputDir := MakePath(Distribution.FLibDirMask);
      end;
      AddPathOption('N', UnitOutputDir);
      AddPathOption('U', Distribution.SourcePath);
      AddPathOption('R', Distribution.SourcePath);
    end;
    AddPathOption('I', Distribution.SourceDir);
    SaveDir := GetCurrentDir;
    Result := SetCurrentDir(Path);
    {$IFDEF WIN32}
    Win32Check(Result);
    {$ELSE}
    if Result then
    {$ENDIF}
    try
      WriteLog('');
      WriteLog('Compiling .dcu files...');
      Result := Result and CompileUnits;
      CopyResFiles(UnitOutputDir);
      if OptionSelected(ioJclCopyHppFiles) then
      begin
        Result := Result and CopyHppFiles(UnitList, (Target as TJclBCBInstallation).VclIncludeDir);
        WriteLog('Copying .hpp files...');
      end;
      {$IFDEF KYLIX}
      Options.Add('-P');   // generate position independent code (PIC)
      WriteLog('');
      WriteLog('Compiling dpu files...');
      Result := Result and CompileUnits;
      {$ENDIF KYLIX}
    finally
      SetCurrentDir(SaveDir);
    end;
  end;
  if not Result then
    InstallFailedOn(LibDescriptor);
end;

function TJclInstallation.Description(Option: TJediInstallOption): string;
begin
  Result := InitData[Option].Caption;
  case Option of
    ioTarget:
      Result := Target.Description;
    ioJclCopyHppFiles:
      Result := Format(Result, [(Target as TJclBCBInstallation).VclIncludeDir]);
    ioJclCopyPackagesHppFiles:
      Result := Format(Result, [(Target as TJclBCBInstallation).VclIncludeDir]);
  end;
end;

function TJclDistribution.GetHint(Option: TJediInstallOption): string;
begin
  Result := InitData[Option].Hint;
end;

function TJclInstallation.GetProgressTotal: Integer;
var
  Option: TJediInstallOption;
begin
  Result := 0;
  if OptionSelected(ioJCL) then
    for Option := Succ(ioJCL) to ioJclLast do
      if OptionSelected(Option) then
        Inc(Result, ProgressWeight(Option));
end;

function TJclInstallation.GetTool: IJediInstallTool;
begin
  Result := Distribution.Tool;
end;

procedure TJclInstallation.BuildUnitList(const SubDir: string; Units: TStrings);
var
  I, J: Integer;
  ExcludeList: TStringList;
  ExcludeListFileName: string;
  Editions, UnitName: string;
  FileMask: string;
begin
  FileMask := Format('%s' + PathSeparator + '%s' + PathSeparator + '*.pas', [Distribution.SourceDir, SubDir]);
  BuildFileList(FileMask, faAnyFile, Units);
  // check for units not to compile
  ExcludeListFileName := MakePath(Format('%s' + PathSeparator + '%s.exc', [Distribution.FLibDirMask, SubDir]));
  if FileExists(ExcludeListFileName) then
  begin
    ExcludeList := TStringList.Create;
    try
      ExcludeList.LoadFromFile(ExcludeListFileName);
      for I := 0 to ExcludeList.Count - 1 do
      begin
        UnitName := ExcludeList[I];
        J := Pos('=', UnitName);
        if J > 0 then
          SetLength(UnitName, J - 1);
        J := Units.IndexOf(UnitName);
        if J <> Invalid then
        begin
          Editions := ExcludeList.Values[UnitName];
          if (Editions = '') or (StrIPos(BorRADToolEditionIDs[Target.Edition], Editions) > 0) then
            Units.Delete(J);
        end;
      end;
    finally
      ExcludeList.Free;
    end;
  end;
  for I := 0 to Units.Count -1 do
    Units[I] := Copy(Units[I], 1, Length(Units[I]) - Length('.pas'));
end;

function TJclInstallation.GetUnits(const SourceDir: string): TStrings;
var
  I: Integer;
begin
  I := FUnits.IndexOf(SourceDir);
  if I = Invalid then
  begin