jclborlandtools.pas

East make Tray Icon in delphi

    property LatestUpdatePack: Integer read GetLatestUpdatePack;
    property LibrarySearchPath: TJclBorRADToolPath read GetLibrarySearchPath write SetLibrarySearchPath;
    property LibraryBrowsingPath: TJclBorRADToolPath read GetLibraryBrowsingPath write SetLibraryBrowsingPath;
    {$IFDEF MSWINDOWS}
    property OpenHelp: TJclBorlandOpenHelp read FOpenHelp;
    {$ENDIF MSWINDOWS}
    property ConfigData: TCustomIniFile read FConfigData;
    property Globals: TStrings read GetGlobals;
    property Make: IJclCommandLineTool read FMake;
    property Name: string read GetName;
    property Palette: TJclBorRADToolPalette read GetPalette;
    property Repository: TJclBorRADToolRepository read GetRepository;
    property RootDir: string read FRootDir;
    property UpdateNeeded: Boolean read GetUpdateNeeded;
    property Valid: Boolean read GetValid;
    property IDEVersionNumber: Integer read FIDEVersionNumber;
    property VersionNumber: Integer read FVersionNumber;
    property VersionNumberStr: string read FVersionNumberStr;
  end;

  TJclBCBInstallation = class(TJclBorRADToolInstallation)
  private
    FBpr2Mak: TJclBpr2Mak;
  protected
    constructor Create(const AConfigDataLocation: string); override;
    function GetVclIncludeDir: string;
  public
    destructor Destroy; override;
    class function PackageSourceFileExtension: string; override;
    class function RadToolName: string; override;
    class function GetLatestUpdatePackForVersion(Version: Integer): Integer; override;
    {$IFDEF KYLIX}
    function ConfigFileName(const Extension: string): string; override;
    {$ENDIF KYLIX}
    function InstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; override;
    property Bpr2Mak: TJclBpr2Mak read FBpr2Mak;
    property VclIncludeDir: string read GetVclIncludeDir;
  end;

  TJclDelphiInstallation = class(TJclBorRADToolInstallation)
  public
    class function GetLatestUpdatePackForVersion(Version: Integer): Integer; override;
    class function PackageSourceFileExtension: string; override;
    class function RadToolName: string; override;
    {$IFDEF KYLIX}
    function ConfigFileName(const Extension: string): string; override;
    {$ENDIF KYLIX}
  end;

  TTraverseMethod = function (Installation: TJclBorRADToolInstallation): Boolean of object;

  TJclBorRADToolInstallations = class(TObject)
  private
    FList: TObjectList;
    function GetCount: Integer;
    function GetInstallations(Index: Integer): TJclBorRADToolInstallation;
    function GetBCBVersionInstalled(VersionNumber: Integer): Boolean;
    function GetDelphiVersionInstalled(VersionNumber: Integer): Boolean;
    function GetBCBInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation;
    function GetDelphiInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation;
  protected
    procedure ReadInstallations;
  public
    constructor Create;
    destructor Destroy; override;
    function AnyInstanceRunning: Boolean;
    function AnyUpdatePackNeeded(var Text: string): Boolean;
    function Iterate(TraverseMethod: TTraverseMethod): Boolean;
    property Count: Integer read GetCount;
    property Installations[Index: Integer]: TJclBorRADToolInstallation read GetInstallations; default;
    property BCBInstallationFromVersion[VersionNumber: Integer]: TJclBorRADToolInstallation read GetBCBInstallationFromVersion;
    property DelphiInstallationFromVersion[VersionNumber: Integer]: TJclBorRADToolInstallation read GetDelphiInstallationFromVersion;
    property BCBVersionInstalled[VersionNumber: Integer]: Boolean read GetBCBVersionInstalled;
    property DelphiVersionInstalled[VersionNumber: Integer]: Boolean read GetDelphiVersionInstalled;
  end;

function BPLFileName(const BPLPath, DPKFileName: string): string;
function IsDelphiPackage(const FileName: string): Boolean;

implementation

uses
  SysConst,
  {$IFDEF MSWINDOWS}
  Registry,
  JclRegistry,
  {$ENDIF MSWINDOWS}
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  JclFileUtils, JclLogic, JclResources, JclStrings, JclSysInfo;

// Internal

type
  TUpdatePack = record
    Version: Byte;
    LatestUpdatePack: Integer;
  end;
  {$IFDEF KYLIX}
  TKylixVersion = 1..3;
  {$ENDIF KYLIX}

  {$IFDEF MSWINDOWS}
  TBDSVersionInfo = record
    Name: string;
    VersionStr: string;
    Version: Integer;
    CoreIdeVersion: string;
    ProjectsDirResId: Integer;
    Supported: Boolean;
  end;
  {$ENDIF MSWINDOWS}

const
  {$IFDEF MSWINDOWS}
  {$IFNDEF RTL140_UP}
  PathSep = ';';
  {$ENDIF ~RTL140_UP}

  MSHelpSystemKeyName = 'SOFTWARE\Microsoft\Windows\Help';

  BCBKeyName          = 'SOFTWARE\Borland\C++Builder';
  BDSKeyName          = 'SOFTWARE\Borland\BDS';
  DelphiKeyName       = 'SOFTWARE\Borland\Delphi';

  BDSVersions: array [1..3] of TBDSVersionInfo = (
    (
      Name: 'C#Builder';
      VersionStr: '1.0';
      Version: 1;
      CoreIdeVersion: '71';
      ProjectsDirResId: 64507;
      Supported: False),
    (
      Name: 'Delphi';
      VersionStr: '8';
      Version: 8;
      CoreIdeVersion: '71';
      ProjectsDirResId: 64460;
      Supported: False),
    (
      Name: 'Delphi';
      VersionStr: '2005';
      Version: 9;
      CoreIdeVersion: '90';
      ProjectsDirResId: 64431;
      Supported: True)
  );
  {$ENDIF MSWINDOWS}

  {$IFDEF KYLIX}
  RootDirValueName           = 'DelphiRoot';
  {$ELSE}
  RootDirValueName           = 'RootDir';
  {$ENDIF KYLIX}

  EditionValueName           = 'Edition';
  VersionValueName           = 'Version';

  DebuggingKeyName           = 'Debugging';
  DebugDCUPathValueName      = 'Debug DCUs Path';

  GlobalsKeyName             = 'Globals';

  LibraryKeyName             = 'Library';
  LibrarySearchPathValueName = 'Search Path';
  LibraryBrowsingPathValueName = 'Browsing Path';
  LibraryBPLOutputValueName  = 'Package DPL Output';
  LibraryDCPOutputValueName  = 'Package DCP Output';

  TransferKeyName            = 'Transfer';
  TransferCountValueName     = 'Count';
  TransferPathValueName      = 'Path%d';
  TransferParamsValueName    = 'Params%d';
  TransferTitleValueName     = 'Title%d';
  TransferWorkDirValueName   = 'WorkingDir%d';

  DisabledPackagesKeyName    = 'Disabled Packages';
  EnvVariablesKeyName        = 'Environment Variables';
  KnownPackagesKeyName       = 'Known Packages';

  PaletteKeyName             = 'Palette';
  PaletteHiddenTag           = '.Hidden';

  {$IFDEF MSWINDOWS}
  MakeExeName                = 'make.exe';
  Bpr2MakExeName             = 'bpr2mak.exe';
  DCCExeName                 = 'dcc32.exe';
  DelphiOptionsFileExtension = '.dof';
  BorRADToolRepositoryFileName = 'delphi32.dro';
  HelpContentFileName        = '%s\Help\%s%d.ohc';
  HelpIndexFileName          = '%s\Help\%s%d.ohi';
  HelpLinkFileName           = '%s\Help\%s%d.ohl';
  HelpProjectFileName        = '%s\Help\%s%d.ohp';
  HelpGidFileName            = '%s\Help\%s%d.gid';
  {$ENDIF MSWINDOWS}

  {$IFDEF KYLIX}
  IDs: array [TKylixVersion] of Integer = (60, 65, 69);
  LibSuffixes: array [TKylixVersion] of string[3] = ('6.0', '6.5', '6.9');

  DelphiIdeExeName           = 'delphi';
  BCBIdeExeName              = 'bcblin';
  MakeExeName                = 'make';
  Bpr2MakExeName             = 'bpr2mak';
  DelphiOptionsFileExtension = '.kof';

  DCCExeName                 = 'dcc';
  KylixHelpNamePart          = 'k%d';
  {$ENDIF KYLIX}

procedure GetDPKFileInfo(const DPKFileName: string; out RunOnly: Boolean;
  const LibSuffix: PString = nil; const Description: PString = nil);
const
  DescriptionOption     = '{$DESCRIPTION ''';
  LibSuffixOption       = '{$LIBSUFFIX ''';
  RunOnlyOption         = '{$RUNONLY}';
var
  I: Integer;
  S: string;
  DPKFile: TStringList;
begin
  DPKFile := TStringList.Create;
  try
    DPKFile.LoadFromFile(DPKFileName);
    if Assigned(Description) then
      Description^ := '';
    if Assigned(LibSuffix) then
      LibSuffix^ := '';
    RunOnly := False;
    for I := 0 to DPKFile.Count - 1 do
    begin
      S := TrimRight(DPKFile[I]);
      if Assigned(Description) and (Pos(DescriptionOption, S) = 1) then
        Description^ := Copy(S, Length(DescriptionOption), Length(S) - Length(DescriptionOption))
      else
      if Assigned(LibSuffix) and (Pos(LibSuffixOption, S) = 1) then
        LibSuffix^ := StrTrimQuotes(Copy(S, Length(LibSuffixOption), Length(S) - Length(LibSuffixOption)))
      else
      if Pos(RunOnlyOption, S) = 1 then
        RunOnly := True;
    end;
  finally
    DPKFile.Free;
  end;
end;

function BPLFileName(const BPLPath, DPKFileName: string): string;
var
  LibSuffix: string;
  RunOnly: Boolean;
begin
  GetDPKFileInfo(DPKFileName, RunOnly, @LibSuffix);
  Result := PathAddSeparator(BPLPath) + PathExtractFileNameNoExt(DPKFileName) + LibSuffix + '.bpl';
end;

function IsDelphiPackage(const FileName: string): Boolean;
begin
  Result := SameText(ExtractFileExt(FileName), TJclDelphiInstallation.PackageSourceFileExtension);
  { TODO : Add some plausibility tests }
  { like
  var
    F: TextFile;
    FirstLine: string;

  if FileExists(FileName) then
  begin
    AssignFile(F, FileName);
    Reset(F);
    ReadLn(F, FirstLine);
    Result := Pos('package ', FirstLine) = 1;
    CloseFile(F);
  end;
  }
end;

{$IFDEF MSWINDOWS}
function RegGetValueNamesAndValues(const RootKey: HKEY; const Key: string; const List: TStrings): Boolean;
var
  I: Integer;
  TempList: TStringList;
  Name: string;
  DataType: DWORD;
begin
  TempList := TStringList.Create;
  try
    Result := RegKeyExists(RootKey, Key) and RegGetValueNames(RootKey, Key, TempList);
    if Result then
    begin
      for I := 0 to TempList.Count - 1 do
      begin
        Name := TempList[I];
        if RegGetDataType(RootKey, Key, Name, DataType) and (DataType = REG_SZ) then
          TempList[I] := Name + '=' + RegReadStringDef(RootKey, Key, Name, '');
      end;
      List.AddStrings(TempList);
    end;
  finally
    TempList.Free;
  end;
end;
{$ENDIF MSWINDOWS}

//=== { TJclBorRADToolInstallationObject } ===================================

constructor TJclBorRADToolInstallationObject.Create(AInstallation: TJclBorRADToolInstallation);
begin
  FInstallation := AInstallation;
end;

//=== { TJclBorlandOpenHelp } ================================================

{$IFDEF MSWINDOWS}

function TJclBorlandOpenHelp.AddHelpFile(const HelpFileName, IndexName: string): Boolean;
var
  CntFileName, HelpName, CntName: string;
  List: TStringList;

  procedure AddToList(const FileName, Text: string);
  var
    I, Attr: Integer;
    Found: Boolean;
  begin
    List.LoadFromFile(FileName);
    Found := False;
    for I := 0 to List.Count - 1 do
      if AnsiSameText(Trim(List[I]), Text) then
      begin
        Found := True;
        Break;
      end;
    if not Found then
    begin
      List.Add(Text);
      Attr := FileGetAttr(FileName);
      FileSetAttr(FileName, faArchive);
      List.SaveToFile(FileName);
      FileSetAttr(FileName, Attr);
    end;
  end;

begin
  CntFileName := ChangeFileExt(HelpFileName, '.cnt');
  Result := FileExists(HelpFileName) and FileExists(CntFileName);
  if Result then
  begin
    HelpName := ExtractFileName(HelpFileName);
    CntName := ExtractFileName(CntFileName);
    RegWriteString(HKEY_LOCAL_MACHINE, MSHelpSystemKeyName, HelpName, ExtractFilePath(HelpFileName));
    RegWriteString(HKEY_LOCAL_MACHINE, MSHelpSystemKeyName, CntName, ExtractFilePath(CntFileName));
    List := TStringList.Create;
    try
      AddToList(ContentFileName, Format(':Include %s', [CntName]));
      AddToList(LinkFileName, Format(':Link %s', [HelpName]));
      AddToList(IndexFileName, Format(':Index %s=%s', [IndexName, HelpName]));
      SetFileLastWrite(ProjectFileName, Now);
      DeleteFile(GidFileName);
    finally
      List.Free;
    end;
  end;
end;

function TJclBorlandOpenHelp.GetContentFileName: string;
begin
  Result := ReadFileName(HelpContentFileName);
end;

function TJclBorlandOpenHelp.GetGidFileName: string;
begin
  Result := ReadFileName(HelpGidFileName);
end;

function TJclBorlandOpenHelp.GetIndexFileName: string;
begin
  Result := ReadFileName(HelpIndexFileName);
end;

function TJclBorlandOpenHelp.GetLinkFileName: string;
begin
  Result := ReadFileName(HelpLinkFileName);
end;

function TJclBorlandOpenHelp.GetProjectFileName: string;
begin
  Result := ReadFileName(HelpProjectFileName);
end;

function TJclBorlandOpenHelp.ReadFileName(const FormatName: string): string;
var
  S: string;
begin
  with Installation do
  begin