1748 lines
54 KiB
ObjectPascal
1748 lines
54 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JVCLData.pas, released on 2004-03-29.
|
|
|
|
The Initial Developer of the Original Code is Andreas Hausladen
|
|
(Andreas dott Hausladen att gmx dott de)
|
|
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): -
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL
|
|
home page, located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JVCLData.pas 11324 2007-06-17 13:43:09Z obones $
|
|
|
|
unit JVCLData;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Registry, SysUtils, Classes, Contnrs,
|
|
JVCLConfiguration, DelphiData, PackageUtils, Intf, GenerateUtils,
|
|
IniFiles, JCLData, JVCLVer,
|
|
JclDebug;
|
|
|
|
const
|
|
sPackageGeneratorFile = 'devtools\bin\pgEdit.xml';
|
|
sDxgettextRegKey = '\bplfile\Shell\Extract strings\Command';
|
|
sJvclIncFile = '%s\common\jvcl.inc';
|
|
sBCBIncludeDir = '%s\Include\Vcl';
|
|
|
|
const
|
|
CLXSupport = False; { Switch this to True if the Installer should support CLX }
|
|
|
|
type
|
|
TJVCLData = class;
|
|
TTargetConfig = class;
|
|
|
|
TInstallMode = set of TPackageGroupKind;
|
|
|
|
TTargetConfig = class(TComponent, ITargetConfig) // TComponent <-> TInterfacedObject
|
|
private
|
|
FOwner: TJVCLData;
|
|
FTarget: TCompileTarget;
|
|
FInstalledJVCLVersion: Integer;
|
|
FDefaultHppDir: string;
|
|
FDcpDir: string;
|
|
FBplDir: string;
|
|
FHppDir: string;
|
|
|
|
FJclDir: string;
|
|
FJclDcpDir: string;
|
|
FJclBplDir: string;
|
|
FJclVersion: string;
|
|
FMissingJCL: Boolean;
|
|
FOutdatedJcl: Boolean;
|
|
|
|
FJVCLVersion: string;
|
|
FInstallJVCL: Boolean;
|
|
|
|
FDeveloperInstall: Boolean;
|
|
FCleanPalettes: Boolean;
|
|
FBuild: Boolean;
|
|
FCompileOnly: Boolean;
|
|
FDebugUnits: Boolean;
|
|
FAutoDependencies: Boolean;
|
|
FAddBplDirToPath: Boolean;
|
|
|
|
FInstallMode: TInstallMode;
|
|
FFrameworks: TFrameworks;
|
|
FGenerateMapFiles: Boolean;
|
|
FLinkMapFiles: Boolean;
|
|
FCreateJdbgFiles: Boolean;
|
|
FDeleteMapFiles: Boolean;
|
|
FJVCLConfig: TJVCLConfig;
|
|
|
|
procedure SetInstallMode(Value: TInstallMode);
|
|
function GetFrameworkCount: Integer;
|
|
function GetDxgettextDir: string;
|
|
function GetDeveloperInstall: Boolean;
|
|
function GetGenerateMapFiles: Boolean;
|
|
function GetLinkMapFiles: Boolean;
|
|
function GetCreateJdbgFiles: Boolean;
|
|
function GetDeleteMapFiles: Boolean;
|
|
function GetCleanPalettes: Boolean;
|
|
function GetJVCLConfig: TJVCLConfig;
|
|
private
|
|
{ ITargetConfig }
|
|
function GetInstance: TObject;
|
|
function GetJVCLPackagesXmlDir: string;
|
|
function GetJVCLDir: string;
|
|
function GetJVCLPackagesDir: string;
|
|
|
|
function GetTargetSymbol: string;
|
|
function GetAutoDependencies: Boolean;
|
|
function GetBuild: Boolean;
|
|
function GetUnitOutDir: string;
|
|
function GetDebugUnitOutDir: string;
|
|
function GetDebugUnits: Boolean;
|
|
function GetCompileOnly: Boolean;
|
|
function GetAddBplDirToPath: Boolean;
|
|
|
|
function GetTarget: TCompileTarget;
|
|
function GetJclDir: string;
|
|
function GetJclDcpDir: string;
|
|
function GetJclDcuDir: string;
|
|
function GetJclBplDir: string;
|
|
function GetHppDir: string;
|
|
function GetBplDir: string;
|
|
function GetDcpDir: string;
|
|
function GetDebugHppDir: string;
|
|
function GetDebugBplDir: string;
|
|
function GetDebugDcpDir: string;
|
|
protected
|
|
procedure Init; virtual;
|
|
procedure DoCleanPalette(Reg: TRegistry; const Name: string;
|
|
RemoveEmptyPalettes: Boolean);
|
|
procedure ClearPackageCache(const Key: string; const AStartsWith: string);
|
|
function RegisterProjectGroupToIDE(ProjectGroup: TProjectGroup): Boolean;
|
|
|
|
procedure UpdateOptions;
|
|
procedure EnableOption(const Name: string; Enable: Boolean);
|
|
public
|
|
property Target: TCompileTarget read GetTarget;
|
|
property Owner: TJVCLData read FOwner;
|
|
public
|
|
constructor Create(AOwner: TJVCLData; ATarget: TCompileTarget); reintroduce;
|
|
destructor Destroy; override;
|
|
procedure Reinit;
|
|
procedure Load;
|
|
procedure Save;
|
|
procedure CleanJVCLPalette(RemoveEmptyPalettes: Boolean);
|
|
procedure GetPackageBinariesForDeletion(List: TStrings);
|
|
procedure DeinstallJVCL(Progress: TDeinstallProgressEvent;
|
|
DeleteFiles: TDeleteFilesEvent; RealUninstall: Boolean);
|
|
function RegisterToIDE: Boolean;
|
|
procedure RegisterJVCLVersionInfo;
|
|
|
|
function GetOutputDirs(DebugUnits: Boolean): TOutputDirs;
|
|
// GetOutputDirs returns the output directory set dependingg on DebugUnits.
|
|
// If DebugUnits=True the returned directories are all debug output
|
|
// directories. Otherwise the "normal" output directories are returned.
|
|
|
|
function GetPathEnvVar: string;
|
|
// GetPathEnvVar returns a proper PATH environment variable for the target.
|
|
|
|
function CanInstallJVCL: Boolean;
|
|
// CanInstallJVCL returns False when the target is not up to date or
|
|
// no JCL was found.
|
|
|
|
function IsUpToDate: Boolean;
|
|
// IsUpToDate returns False when the (Borland) updates for this target
|
|
// are not installed.
|
|
|
|
function IsOldVersionInstalled: Boolean;
|
|
// IsOldVersionInstalled returns true if an older JVCL version is
|
|
// installed.
|
|
|
|
function GetBpgFilename(Personal: Boolean; Kind: TPackageGroupKind): string;
|
|
// BpgFilename returns the filename of the ProjectGroup that is used
|
|
|
|
procedure ResetPackagesSettings(ProjectGroup: TProjectGroup);
|
|
// ResetPackagesSettings sets the install property for each package target
|
|
// to its registry setting of the current IDE target.
|
|
|
|
procedure SavePackagesSettings(ProjectGroup: TProjectGroup);
|
|
// SavePackagesSettings saves the runtime packages state to an .ini file.
|
|
|
|
function VersionedJclDcp(const Name: string): string;
|
|
// VersionedJclDcp inserts the suffix for JCL .dcp files; wants "Jcl.dcp"
|
|
|
|
function VersionedJclBpl(const Name: string): string;
|
|
// VersionedJclBpl inserts the suffix for JCL .bpl files; wants "Jcl.bpl"
|
|
|
|
function VersionedJVCLXmlDcp(const Name: string): string;
|
|
// VersionedVCLDcp inserts the suffix for JVCL .dcp files; wants "JvPack-R"
|
|
|
|
function VersionedJVCLXmlBpl(const Name: string): string;
|
|
// VersionedVCLBpl inserts the suffix for JVCL .bpl files; wants "JvPack-R"
|
|
|
|
function LinkMapFile(const BinaryFileName, MapFileName: string;
|
|
var MapFileSize, JclDebugDataSize: Integer): Boolean;
|
|
// link the map file in the binary file
|
|
|
|
function CompressMapFileToJdbg(const MapFileName: string): Boolean;
|
|
// compresses the map file to a jdbg file
|
|
|
|
property TargetSymbol: string read GetTargetSymbol;
|
|
// TargetSymbol returns the symbol that is used in the xml files for this
|
|
// target.
|
|
|
|
property UnitOutDir: string read GetUnitOutDir;
|
|
// UnitOutDir specifies the JVCL directory where the .dcu should go.
|
|
property BplDir: string read GetBplDir write FBplDir;
|
|
// BPL directory for this target
|
|
property DcpDir: string read GetDcpDir write FDcpDir;
|
|
// DCP directory for this target
|
|
property HppDir: string read GetHppDir write FHppDir;
|
|
// HppDir: (for BCB installation) specifies where the generated .hpp files
|
|
// should go.
|
|
property DebugUnitOutDir: string read GetDebugUnitOutDir;
|
|
// DebugUnitOutDir specifies the JVCL directory where the .dcu should go.
|
|
property DebugBplDir: string read GetBplDir;
|
|
// Debug BPL directory for this target
|
|
property DebugDcpDir: string read GetDebugDcpDir;
|
|
// Debug DCP directory for this target
|
|
property DebugHppDir: string read GetDebugHppDir;
|
|
// Debbug HppDir: (for BCB installation) specifies where the generated .hpp files
|
|
// should go.
|
|
|
|
property DxgettextDir: string read GetDxgettextDir;
|
|
// Directory where dxgettext is installed or ''. (special handling for Delphi/BCB 5)
|
|
|
|
property InstalledJVCLVersion: Integer read FInstalledJVCLVersion; // major version: 1, 2, 3, 4
|
|
// InstalledJVCLVersion returns the version of the installed JVCL.
|
|
|
|
property JVCLVersion: string read FJVCLVersion;
|
|
// JVCLVersion returns version of the installed JVCL: '3.30';
|
|
|
|
property JclVersion: string read FJclVersion;
|
|
// JclVersion returns version of the installed JCL.
|
|
|
|
property MissingJCL: Boolean read FMissingJCL;
|
|
// MissingJCL is True when no JCL is installed and no JCL directoy was
|
|
// found that could be installed.
|
|
|
|
property OutdatedJcl: Boolean read FOutdatedJcl;
|
|
// OutdatedJcl is True if no jcl\source\common\windows\win32api directory
|
|
// exists which means that the JCL is too old for the JVCL.
|
|
|
|
property Frameworks: TFrameworks read FFrameworks;
|
|
// Frameworks contains all possible package groups.
|
|
|
|
property FrameworkCount: Integer read GetFrameworkCount;
|
|
// FrameworkCount returns the number of available frameworks for this
|
|
// target.
|
|
|
|
property JVCLConfig: TJVCLConfig read GetJVCLConfig;
|
|
// JVCLConfig returns the confiuration
|
|
public
|
|
property InstallJVCL: Boolean read FInstallJVCL write FInstallJVCL;
|
|
// InstallJVCL specifies if the JVCL should be installed on this target.
|
|
|
|
property InstallMode: TInstallMode read FInstallMode write SetInstallMode;
|
|
// InstallMode specifies if the JVCL only, JVCL and JVCLX or JVCLX only
|
|
// should be installed.
|
|
|
|
property DebugUnits: Boolean read GetDebugUnits write FDebugUnits;
|
|
// if DebugUnits is True the units will be compiled in debug mode, too.
|
|
// (Delphi only) [NOT USED IN THE JVCL DUE TO jvcl.inc SETTINGS]
|
|
|
|
property GenerateMapFiles: Boolean read GetGenerateMapFiles write FGenerateMapFiles;
|
|
// if GenerateMapFiles is True the compiler generates .map files for each package
|
|
|
|
property LinkMapFiles: Boolean read GetLinkMapFiles write FLinkMapFiles;
|
|
// if LinkMapFiles is True the the map files are linked as a resource of the binary
|
|
|
|
property CreateJdbgFiles: Boolean read GetCreateJdbgFiles write FCreateJdbgFiles;
|
|
// if CreateJdbgFiles is True the map files will be compressed to jdbg files
|
|
|
|
property DeleteMapFiles: Boolean read GetDeleteMapFiles write FDeleteMapFiles;
|
|
// if DeleteMapFiles is True the the map files are deleted after they
|
|
// were linked in the binaries or compressed to jdbg files
|
|
|
|
property Build: Boolean read GetBuild write FBuild;
|
|
// if Build is True the packages are built instead of make.
|
|
|
|
property CompileOnly: Boolean read GetCompileOnly write FCompileOnly;
|
|
// if CompileOnly is True the desigtime packages are not registered to the
|
|
// IDE.
|
|
|
|
property AutoDependencies: Boolean read GetAutoDependencies write FAutoDependencies;
|
|
// if AutoDependencies it True the make file for the project groups will
|
|
// contain auto dependency information for faster compilation.
|
|
|
|
property AddBplDirToPath: Boolean read GetAddBplDirToPath write FAddBplDirToPath;
|
|
// AddBplDirToPath: adds the BplDir to the Target.EnvPath variable. This
|
|
// allows the IDE to find the runtime packages.
|
|
|
|
property DeveloperInstall: Boolean read GetDeveloperInstall write FDeveloperInstall;
|
|
// DevelopInstall: add the \run directory to the library path.
|
|
|
|
property CleanPalettes: Boolean read GetCleanPalettes write FCleanPalettes;
|
|
// CleanPalettes specifies if the JVCL components should be removed from
|
|
// the component palettes before installation.
|
|
|
|
property JclDir: string read GetJclDir;
|
|
// JclDir specifies the directory where the JCL is.
|
|
|
|
property JclDcpDir: string read GetJclDcpDir;
|
|
// JclDcpDir returns the directory where the Jcl.dcp/JclVcl.dcp files are.
|
|
|
|
property JclDcuDir: string read GetJclDcuDir;
|
|
// JclDcuDir specifies the directory where the JCL .dcu files are, depending on the target.
|
|
|
|
property JclBplDir: string read GetJclBplDir;
|
|
// JclBplDir returns the directory where the JclXx.bpl/JclVclXX.bpl files are.
|
|
end;
|
|
|
|
TJclLinkMapFile = function(ExecutableFileName, MapFileName: PChar;
|
|
var MapFileSize, JclDebugDataSize: Integer): Boolean;
|
|
|
|
TJVCLData = class(TObject)
|
|
private
|
|
FConfigs: array of TTargetConfig;
|
|
FTargets: TCompileTargetList;
|
|
FIsDxgettextInstalled: Boolean;
|
|
FDxgettextDir: string;
|
|
FJVCLDir: string;
|
|
FDeleteFilesOnUninstall: Boolean;
|
|
FVerbose: Boolean;
|
|
FIgnoreMakeErrors: Boolean;
|
|
FJclLibrary: HModule;
|
|
FJclLinkMapFile: TJclLinkMapFile;
|
|
|
|
function GetTargetConfig(Index: Integer): TTargetConfig;
|
|
function GetJVCLDir: string;
|
|
function GetJVCLPackagesDir: string;
|
|
function GetJVCLPackagesXmlDir: string;
|
|
function GetOptionState(Index: Integer): Integer;
|
|
procedure SetOptionState(Index: Integer; const Value: Integer);
|
|
protected
|
|
function JvclIncFilename: string;
|
|
procedure Init; virtual;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
procedure Reinit;
|
|
|
|
procedure SaveTargetConfigs;
|
|
function FindTargetConfig(const TargetSymbol: string): TTargetConfig;
|
|
function IsJVCLInstalledAnywhere(MinVersion: Integer): Boolean;
|
|
function LinkMapFile(const BinaryFileName, MapFileName: string;
|
|
var MapFileSize, JclDebugDataSize: Integer): Boolean;
|
|
function CompressMapFileToJdbg(const MapFileName: string): Boolean;
|
|
|
|
property DxgettextDir: string read FDxgettextDir;
|
|
property IsDxgettextInstalled: Boolean read FIsDxgettextInstalled;
|
|
|
|
property JVCLDir: string read GetJVCLDir;
|
|
property JVCLPackagesDir: string read GetJVCLPackagesDir;
|
|
property JVCLPackagesXmlDir: string read GetJVCLPackagesXmlDir;
|
|
|
|
property DeveloperInstall: Integer index 3 read GetOptionState write SetOptionState;
|
|
property DebugUnits: Integer index 4 read GetOptionState write SetOptionState;
|
|
property CleanPalettes: Integer index 1 read GetOptionState write SetOptionState;
|
|
property Build: Integer index 0 read GetOptionState write SetOptionState;
|
|
property CompileOnly: Integer index 2 read GetOptionState write SetOptionState;
|
|
property GenerateMapFiles: Integer index 5 read GetOptionState write SetOptionState;
|
|
property LinkMapFiles: Integer index 6 read GetOptionState write SetOptionState;
|
|
property CreateJdbgFiles: Integer index 8 read GetOptionState write SetOptionState;
|
|
property DeleteMapFiles: Integer index 7 read GetOptionState write SetOptionState;
|
|
|
|
property DeleteFilesOnUninstall: Boolean read FDeleteFilesOnUninstall write FDeleteFilesOnUninstall default True;
|
|
property Verbose: Boolean read FVerbose write FVerbose default False;
|
|
property IgnoreMakeErrors: Boolean read FIgnoreMakeErrors write FIgnoreMakeErrors default False;
|
|
|
|
property TargetConfig[Index: Integer]: TTargetConfig read GetTargetConfig;
|
|
property Targets: TCompileTargetList read FTargets;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Utils, CmdLineUtils, PackageInformation, JediRegInfo;
|
|
|
|
resourcestring
|
|
RsComponentPalettePrefix = 'TJv';
|
|
RsNoJVCLFound = 'No JVCL directory found. Application terminated.';
|
|
RsJVCLInstaller = 'JVCL Installer';
|
|
|
|
RsCleaningPalette = 'Cleaning Palette...';
|
|
RsCleaningPathLists = 'Cleaning Path lists...';
|
|
RsUnregisteringPackages = 'Unregistering packages...';
|
|
RsDeletingFiles = 'Deleting files...';
|
|
RsComplete = 'Complete.';
|
|
|
|
function ReadRegString(RootKey: HKEY; const Key, Name: string): string;
|
|
var
|
|
Reg: TRegistry;
|
|
begin
|
|
Result := '';
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RootKey;
|
|
if Reg.OpenKeyReadOnly(Key) then
|
|
begin
|
|
if Reg.ValueExists(Name) then
|
|
Result := Reg.ReadString(Name);
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
function FixBackslashBackslash(const Dir: string): string;
|
|
var
|
|
ps: Integer;
|
|
begin
|
|
Result := Dir;
|
|
ps := Pos('\\', Result);
|
|
if ps > 0 then
|
|
Delete(Result, ps, 1);
|
|
end;
|
|
|
|
{ TJVCLData }
|
|
|
|
constructor TJVCLData.Create;
|
|
var
|
|
I: Integer;
|
|
ErrMsg: string;
|
|
begin
|
|
inherited Create;
|
|
FDeleteFilesOnUninstall := True;
|
|
FVerbose := False;
|
|
|
|
ErrMsg := '';
|
|
LoadConfig(JVCLDir + '\' + sPackageGeneratorFile, 'JVCL', ErrMsg);
|
|
|
|
FTargets := TCompileTargetList.Create;
|
|
SetLength(FConfigs, Targets.Count);
|
|
for I := 0 to High(FConfigs) do
|
|
FConfigs[I] := TTargetConfig.Create(Self, Targets[I]);
|
|
|
|
{ Don't fail during startup, because MapFile linking isn't that important that
|
|
it should block the whole JVCL installer. }
|
|
FJclLibrary := Cardinal(-1);
|
|
|
|
Init;
|
|
end;
|
|
|
|
destructor TJVCLData.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FJclLinkMapFile := nil;
|
|
if (FJclLibrary <> 0) and (FJclLibrary <> Cardinal(-1)) then
|
|
FreeLibrary(FJclLibrary);
|
|
|
|
for i := 0 to High(FConfigs) do
|
|
FConfigs[I].Free;
|
|
FTargets.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJVCLData.FindTargetConfig(const TargetSymbol: string): TTargetConfig;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Targets.Count - 1 do
|
|
begin
|
|
Result := TargetConfig[i];
|
|
if CompareText(TargetSymbol, Result.TargetSymbol) = 0 then
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TTargetConfig.GetJVCLConfig: TJVCLConfig;
|
|
begin
|
|
Result := FJVCLConfig;
|
|
end;
|
|
|
|
function TJVCLData.GetJVCLDir: string;
|
|
begin
|
|
if FJVCLDir = '' then
|
|
begin
|
|
FJVCLDir := ExtractFileDir(ParamStr(0));
|
|
while not DirectoryExists(JVCLPackagesDir) do
|
|
begin
|
|
if Length(FJVCLDir) < 4 then
|
|
begin
|
|
MessageBox(0, PChar(RsNoJVCLFound), PChar(RsJVCLInstaller), MB_ICONERROR or MB_OK);
|
|
Halt(1);
|
|
Break;
|
|
end;
|
|
FJVCLDir := ExtractFileDir(JVCLDir);
|
|
end;
|
|
end;
|
|
Result := FJVCLDir;
|
|
end;
|
|
|
|
function TJVCLData.GetJVCLPackagesDir: string;
|
|
begin
|
|
Result := JVCLDir + '\packages';
|
|
end;
|
|
|
|
function TJVCLData.GetJVCLPackagesXmlDir: string;
|
|
begin
|
|
Result := JVCLPackagesDir + '\xml';
|
|
end;
|
|
|
|
function TJVCLData.GetTargetConfig(Index: Integer): TTargetConfig;
|
|
begin
|
|
Result := FConfigs[Index];
|
|
end;
|
|
|
|
procedure TJVCLData.Init;
|
|
var
|
|
i: Integer;
|
|
S: string;
|
|
begin
|
|
// dxgettext detection
|
|
S := ReadRegString(HKEY_CLASSES_ROOT, PChar(sDxgettextRegKey), '');
|
|
FIsDxgettextInstalled := S <> '';
|
|
if FIsDxgettextInstalled then
|
|
begin
|
|
if S[1] = '"' then
|
|
begin
|
|
Delete(S, 1, 1);
|
|
i := 1;
|
|
while (i <= Length(S)) and (S[i] <> '"') do
|
|
Inc(i);
|
|
SetLength(S, i - 1);
|
|
end;
|
|
FDxgettextDir := ExtractFileDir(S);
|
|
if not FileExists(FDxgettextDir + '\msgfmt.exe') then
|
|
begin
|
|
FIsDxgettextInstalled := False;
|
|
FDxgettextDir := '';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJVCLData.IsJVCLInstalledAnywhere(MinVersion: Integer): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to Targets.Count - 1 do
|
|
if TargetConfig[i].InstalledJVCLVersion >= MinVersion then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TJVCLData.JvclIncFilename: string;
|
|
begin
|
|
Result := Format(sJvclIncFile, [JVCLDir]);
|
|
end;
|
|
|
|
function TJVCLData.LinkMapFile(const BinaryFileName, MapFileName: string;
|
|
var MapFileSize, JclDebugDataSize: Integer): Boolean;
|
|
var
|
|
LinkerBugUnit: string;
|
|
begin
|
|
try
|
|
Result := InsertDebugDataIntoExecutableFile(BinaryFileName, MapFileName,
|
|
LinkerBugUnit, MapFileSize, JclDebugDataSize);
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TJVCLData.CompressMapFileToJdbg(const MapFileName: string): Boolean;
|
|
begin
|
|
try
|
|
Result := ConvertMapFileToJdbgFile(MapFileName);
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TJVCLData.Reinit;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Targets.Count - 1 do
|
|
TargetConfig[i].Reinit;
|
|
end;
|
|
|
|
procedure TJVCLData.SaveTargetConfigs;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Targets.Count - 1 do
|
|
TargetConfig[i].Save;
|
|
end;
|
|
|
|
function TJVCLData.GetOptionState(Index: Integer): Integer;
|
|
var
|
|
i: Integer;
|
|
b: Boolean;
|
|
begin
|
|
Result := 0; // false
|
|
for i := 0 to Targets.Count - 1 do
|
|
begin
|
|
if TargetConfig[i].InstallJVCL then
|
|
begin
|
|
case Index of
|
|
0: b := TargetConfig[i].Build;
|
|
1: b := TargetConfig[i].CleanPalettes;
|
|
2: b := TargetConfig[i].CompileOnly;
|
|
3: b := TargetConfig[i].DeveloperInstall;
|
|
4: b := TargetConfig[i].DebugUnits;
|
|
5: b := TargetConfig[i].GenerateMapFiles;
|
|
6: b := TargetConfig[i].LinkMapFiles;
|
|
7: b := TargetConfig[i].DeleteMapFiles;
|
|
8: b := TargetConfig[i].CreateJdbgFiles;
|
|
else
|
|
b := False;
|
|
end;
|
|
if b then
|
|
begin
|
|
if Result = 3 then
|
|
begin
|
|
Result := 2;
|
|
Exit;
|
|
end;
|
|
Result := 1 // true
|
|
end
|
|
else
|
|
begin
|
|
if Result = 1 then
|
|
begin
|
|
Result := 2; // mixed
|
|
Exit;
|
|
end;
|
|
Result := 3;
|
|
end;
|
|
end;
|
|
end;
|
|
if Result = 3 then
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TJVCLData.SetOptionState(Index: Integer; const Value: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Targets.Count - 1 do
|
|
begin
|
|
case Index of
|
|
0: TargetConfig[i].Build := Value <> 0;
|
|
1: TargetConfig[i].CleanPalettes := Value <> 0;
|
|
2: TargetConfig[i].CompileOnly := Value <> 0;
|
|
3: TargetConfig[i].DeveloperInstall := Value <> 0;
|
|
4: TargetConfig[i].DebugUnits := Value <> 0;
|
|
5: TargetConfig[i].GenerateMapFiles := Value <> 0;
|
|
6: TargetConfig[i].LinkMapFiles := Value <> 0;
|
|
7: TargetConfig[i].DeleteMapFiles := Value <> 0;
|
|
8: TargetConfig[i].CreateJdbgFiles := Value <> 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TTargetConfig }
|
|
|
|
constructor TTargetConfig.Create(AOwner: TJVCLData; ATarget: TCompileTarget);
|
|
begin
|
|
inherited Create(nil);
|
|
FOwner := AOwner;
|
|
FTarget := ATarget;
|
|
FBuild := CmdOptions.RebuildPackages;
|
|
|
|
FInstallMode := [pkVcl];
|
|
{if Target.IsBDS then
|
|
FDefaultHppDir := ExtractFilePath(Format(sBCBIncludeDir, [Target.RootDir])) + 'JVCL' // do not localize
|
|
else}
|
|
FDefaultHppDir := Format(sBCBIncludeDir, [Target.RootDir]);
|
|
FHppDir := FDefaultHppDir;
|
|
|
|
FCleanPalettes := True;
|
|
FDeveloperInstall := False;
|
|
FAutoDependencies := True;
|
|
FGenerateMapFiles := True;
|
|
FLinkMapFiles := True;
|
|
FDeleteMapFiles := True;
|
|
|
|
FBplDir := Target.BplDir;
|
|
if Target.IsBDS then
|
|
FDcpDir := GetUnitOutDir
|
|
else
|
|
FDcpDir := Target.DcpDir;
|
|
Init;
|
|
FInstallJVCL := CanInstallJVCL;
|
|
|
|
FFrameworks := TFrameworks.Create(Self);
|
|
FJVCLConfig := TJVCLConfig.Create;
|
|
Load;
|
|
end;
|
|
|
|
destructor TTargetConfig.Destroy;
|
|
begin
|
|
FJVCLConfig.Free;
|
|
FFrameworks.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTargetConfig.Init;
|
|
// Memory allocations must go to the constructor because Init could be called
|
|
// more the once.
|
|
var
|
|
i, FindCount: Integer;
|
|
begin
|
|
FInstallMode := [];
|
|
FOutdatedJcl := False;
|
|
|
|
// identify JVCL version
|
|
FInstalledJVCLVersion := 0;
|
|
if Target.FindPackageEx('JvPack1') <> nil then // do not localize
|
|
FInstalledJVCLVersion := 1
|
|
else if Target.FindPackageEx('jvcl2') <> nil then // do not localize
|
|
FInstalledJVCLVersion := 2
|
|
else if Target.FindPackageEx('JvCore') <> nil then // VCL // do not localize
|
|
begin
|
|
Include(FInstallMode, pkVCL);
|
|
FInstalledJVCLVersion := 3;
|
|
end;
|
|
if Target.FindPackageEx('JvQCore') <> nil then // CLX // do not localize
|
|
begin
|
|
Include(FInstallMode, pkCLX);
|
|
FInstalledJVCLVersion := 3;
|
|
end;
|
|
if not CLXSupport then
|
|
begin
|
|
Exclude(FInstallMode, pkCLX);
|
|
Include(FInstallMode, pkVCL);
|
|
end
|
|
else
|
|
if FInstallMode = [] then // if no VCL and no CLX than it is VCL
|
|
Include(FInstallMode, pkVCL);
|
|
|
|
|
|
// find JCL by looking into the (new) JEDI Registry key
|
|
FOutdatedJcl := False;
|
|
FMissingJCL := True;
|
|
FJclDir := '';
|
|
FJclVersion := '';
|
|
FJclBplDir := '';
|
|
FJclDcpDir := '';
|
|
|
|
with ReadJediRegInformation(Target.RegistryKey, 'JCL') do // do not localize
|
|
begin
|
|
FJclDir := ExcludeTrailingPathDelimiter(Target.ExpandDirMacros(RootDir)); // do not localize
|
|
FJclDcpDir := ExcludeTrailingPathDelimiter(Target.ExpandDirMacros(DcpDir));
|
|
FJclBplDir := ExcludeTrailingPathDelimiter(Target.ExpandDirMacros(BplDir));
|
|
FJclVersion := Version;
|
|
end;
|
|
|
|
FJVCLVersion := ReadJediRegInformation(Target.RegistryKey, 'JVCL').Version;
|
|
if (FInstalledJVCLVersion = 0) and (FJVCLVersion <> '') then
|
|
FInstalledJVCLVersion := ParseVersionNumber(FJVCLVersion) shr 24
|
|
else
|
|
if (FJVCLVersion = '') and (FInstalledJVCLVersion = 3) then
|
|
FJVCLVersion := '3';
|
|
|
|
FMissingJCL := (FJclDir = '') or (FJclVersion = '') or (FJclDcpDir = '');
|
|
if not FMissingJCL then
|
|
begin
|
|
// check version number
|
|
FOutdatedJcl := ParseVersionNumber(FJclVersion) < ParseVersionNumber(JCLMinVersion);
|
|
|
|
if not FOutdatedJcl then
|
|
begin
|
|
// check for the JCL's .dcp files
|
|
FindCount := Length(JCLDcpFiles);
|
|
for i := 0 to High(JCLDcpFiles) do
|
|
begin
|
|
if FileExists(FJclDcpDir + PathDelim + VersionedJclDcp(JCLDcpFiles[i])) then
|
|
begin
|
|
Dec(FindCount);
|
|
Break;
|
|
end;
|
|
end;
|
|
FMissingJCL := FindCount > 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTargetConfig.CanInstallJVCL: Boolean;
|
|
begin
|
|
Result := IsUpToDate and not MissingJCL;
|
|
end;
|
|
|
|
function TTargetConfig.IsUpToDate: Boolean;
|
|
begin
|
|
Result := True;
|
|
|
|
if Target.IsDelphi then
|
|
begin
|
|
if Target.Version = 6 then
|
|
begin
|
|
Result := Target.LatestUpdate >= 2; // Update 2 required
|
|
end;
|
|
end;
|
|
{
|
|
if Target.IsBCB then
|
|
begin
|
|
case Target.Version of
|
|
5: Result := Target.LatestUpdate >= 1;
|
|
6: Result := Target.LatestUpdate >= 1;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case Target.Version of
|
|
5: Result := Target.LatestUpdate >= 1;
|
|
6: Result := Target.LatestUpdate >= 2;
|
|
7: Result := True;
|
|
8: Result := False; // not supported
|
|
end;
|
|
end;}
|
|
|
|
// The IDE is up to date because the JCL Installer garantees this for us.
|
|
// The JVCL requires an installed JCL, so this is no problem.
|
|
// Result := True;
|
|
end;
|
|
|
|
function TTargetConfig.IsOldVersionInstalled: Boolean;
|
|
begin
|
|
Result := InstalledJVCLVersion < 3;
|
|
end;
|
|
|
|
/// <summary>
|
|
/// GetBpgFilename returns the file name of the Borland Package Group (.bpg)
|
|
/// file that is used for this target.
|
|
/// </summary>
|
|
function TTargetConfig.GetBpgFilename(Personal: Boolean; Kind: TPackageGroupKind): string;
|
|
var
|
|
Pers, Clx: string;
|
|
begin
|
|
if Personal then
|
|
begin
|
|
if Target.Version <= 5 then
|
|
Pers := 'Std' // do not localize
|
|
else
|
|
Pers := 'Per'; // do not localize
|
|
end;
|
|
|
|
if Kind = pkClx then
|
|
Clx := 'Clx';
|
|
|
|
if Target.IsBDS then
|
|
Result := Owner.JVCLPackagesDir + Format('\%s%d%s%s Packages.bdsgroup', // do not localize
|
|
[Target.TargetType, Target.Version, Pers, Clx])
|
|
else
|
|
Result := Owner.JVCLPackagesDir + Format('\%s%d%s%s Packages.bpg', // do not localize
|
|
[Target.TargetType, Target.Version, Pers, Clx]);
|
|
end;
|
|
|
|
function TTargetConfig.VersionedJclDcp(const Name: string): string;
|
|
begin
|
|
{ TODO : Keep in sync with JCL naming schema }
|
|
if Target.Version = 5 then
|
|
begin
|
|
Result := ChangeFileExt(Name, '');
|
|
if Target.IsBCB then
|
|
Result := Result + 'c50'
|
|
else
|
|
Result := Result + 'd50';
|
|
Result := ChangeFileExt(Result, ExtractFileExt(Name));
|
|
end
|
|
else
|
|
Result := Name;
|
|
end;
|
|
|
|
function TTargetConfig.VersionedJclBpl(const Name: string): string;
|
|
var
|
|
Suffix: string;
|
|
begin
|
|
{ TODO : Keep in sync with JCL naming schema }
|
|
// Compute the JCL bpl file name
|
|
if Target.Version >= 7 then
|
|
Suffix := Format('%d0', [Target.Version])
|
|
else if Target.IsBCB then
|
|
Suffix := Format('C%d0', [Target.Version])
|
|
else
|
|
Suffix := Format('D%d0', [Target.Version]);
|
|
Result := ChangeFileExt(Name, '') + Suffix + ExtractFileExt(Name);
|
|
end;
|
|
|
|
function TTargetConfig.VersionedJVCLXmlDcp(const Name: string): string;
|
|
var
|
|
Suffix: string;
|
|
begin
|
|
{ TODO : Keep in sync with JVCL naming schema }
|
|
if Target.IsBCB then
|
|
Suffix := Format('C%d', [Target.Version])
|
|
else
|
|
Suffix := Format('D%d', [Target.Version]);
|
|
Result := StringReplace(Name, '-', Suffix, []) + '.dcp';
|
|
end;
|
|
|
|
function TTargetConfig.VersionedJVCLXmlBpl(const Name: string): string;
|
|
var
|
|
Suffix: string;
|
|
begin
|
|
{ TODO : Keep in sync with JVCL naming schema }
|
|
if Target.IsBCB then
|
|
Suffix := Format('C%d', [Target.Version])
|
|
else
|
|
Suffix := Format('D%d', [Target.Version]);
|
|
Result := StringReplace(Name, '-', Suffix, []) + '.bpl';
|
|
end;
|
|
|
|
function TTargetConfig.LinkMapFile(const BinaryFileName, MapFileName: string;
|
|
var MapFileSize, JclDebugDataSize: Integer): Boolean;
|
|
begin
|
|
Result := Owner.LinkMapFile(BinaryFileName, MapFileName, MapFileSize,
|
|
JclDebugDataSize);
|
|
end;
|
|
|
|
function TTargetConfig.CompressMapFileToJdbg(const MapFileName: string): Boolean;
|
|
begin
|
|
Result := Owner.CompressMapFileToJdbg(MapFileName);
|
|
end;
|
|
|
|
procedure TTargetConfig.RegisterJVCLVersionInfo;
|
|
begin
|
|
InstallJediRegInformation(Target.RegistryKey, 'JVCL',
|
|
Format('%d.%d.%d.%d', [JVCLVersionMajor, JVCLVersionMinor, JVCLVersionRelease, JVCLVersionBuild]),
|
|
DcpDir, BplDir, GetJVCLDir);
|
|
end;
|
|
|
|
procedure TTargetConfig.SavePackagesSettings(ProjectGroup: TProjectGroup);
|
|
var
|
|
i: Integer;
|
|
Ini: TMemIniFile;
|
|
IniFileName: string;
|
|
begin
|
|
// save to ini
|
|
IniFileName := ChangeFileExt(ParamStr(0), '.ini'); // do not localize
|
|
FileSetReadOnly(IniFileName, False);
|
|
Ini := TMemIniFile.Create(IniFileName);
|
|
try
|
|
Ini.EraseSection(ProjectGroup.BpgName);
|
|
for i := 0 to ProjectGroup.Count - 1 do
|
|
with ProjectGroup.Packages[i] do
|
|
if not ProjectTypeIsDesign(Info.ProjectType) then
|
|
Ini.WriteBool(ProjectGroup.BpgName, Info.Name, Compile);
|
|
Ini.UpdateFile;
|
|
finally
|
|
Ini.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTargetConfig.ResetPackagesSettings(ProjectGroup: TProjectGroup);
|
|
var
|
|
PkgIndex, i: Integer;
|
|
BplName: string;
|
|
IsInstalled: Boolean;
|
|
Ini: TMemIniFile;
|
|
begin
|
|
// Set Compile to False for each package.
|
|
for PkgIndex := 0 to ProjectGroup.Count - 1 do
|
|
ProjectGroup.Packages[PkgIndex].Compile := False;
|
|
|
|
// read from ini
|
|
Ini := TMemIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')); // do not localize
|
|
try
|
|
for i := 0 to ProjectGroup.Count - 1 do
|
|
if not ProjectTypeIsDesign(ProjectGroup.Packages[i].Info.ProjectType) then
|
|
// Ini read defaults to True, to compile and install newly created packages
|
|
ProjectGroup.Packages[i].Compile := Ini.ReadBool(ProjectGroup.BpgName, ProjectGroup.Packages[i].Info.Name, True);
|
|
finally
|
|
Ini.Free;
|
|
end;
|
|
|
|
IsInstalled := False;
|
|
// Set Install to the registry setting. The dependency check will activate the
|
|
// required (runtime) packages.
|
|
for PkgIndex := 0 to ProjectGroup.Count - 1 do
|
|
begin
|
|
BplName := ProjectGroup.Packages[PkgIndex].Info.BplName;
|
|
|
|
for i := 0 to Target.KnownPackages.Count - 1 do
|
|
if CompareText(Target.KnownPackages[i].Name, BplName) = 0 then
|
|
begin
|
|
ProjectGroup.Packages[PkgIndex].Install := True;
|
|
IsInstalled := True;
|
|
Break;
|
|
end;
|
|
|
|
for i := 0 to Target.DisabledPackages.Count - 1 do
|
|
if CompareText(Target.DisabledPackages[i].Name, BplName) = 0 then
|
|
begin
|
|
// shouldn't the following value be False?
|
|
ProjectGroup.Packages[PkgIndex].Install := True;
|
|
IsInstalled := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not IsInstalled then
|
|
begin
|
|
// No package of the project group is installed, so it must be a new
|
|
// installation.
|
|
for PkgIndex := 0 to ProjectGroup.Count - 1 do
|
|
ProjectGroup.Packages[PkgIndex].Install := True;
|
|
end;
|
|
end;
|
|
|
|
function TTargetConfig.GetTargetSymbol: string;
|
|
var
|
|
Pers: string;
|
|
begin
|
|
if Target.IsPersonal {or (Kind = pkPersonal)} then
|
|
begin
|
|
if Target.Version = 5 then
|
|
Pers := 's' // do not localize
|
|
else
|
|
Pers := 'p'; // do not localize
|
|
end;
|
|
Result := Format('%s%d%s', [Target.TargetType, Target.Version, Pers]); // do not localize
|
|
end;
|
|
|
|
function TTargetConfig.GetUnitOutDir: string;
|
|
begin
|
|
Result := GetJVCLDir + Format('\lib\%s%d', [Target.TargetType, Target.Version]) // do not localize
|
|
end;
|
|
|
|
procedure TTargetConfig.SetInstallMode(Value: TInstallMode);
|
|
begin
|
|
if Value <> FInstallMode then
|
|
begin
|
|
if not CLXSupport then
|
|
Exclude(Value, pkCLX);
|
|
if Value = [] then
|
|
FInstallMode := [pkVcl]
|
|
else
|
|
FInstallMode := Value;
|
|
end;
|
|
end;
|
|
|
|
function TTargetConfig.GetInstance: TObject;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TTargetConfig.GetTarget: TCompileTarget;
|
|
begin
|
|
Result := FTarget;
|
|
end;
|
|
|
|
function TTargetConfig.GetJVCLPackagesXmlDir: string;
|
|
begin
|
|
Result := Owner.JVCLPackagesXmlDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetJVCLDir: string;
|
|
begin
|
|
Result := Owner.JVCLDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetJVCLPackagesDir: string;
|
|
begin
|
|
Result := Owner.JVCLPackagesDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetJclDir: string;
|
|
begin
|
|
Result := FJclDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetJclDcpDir: string;
|
|
begin
|
|
Result := FJclDcpDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetJclDcuDir: string;
|
|
begin
|
|
{ TODO : Keep in sync with JCL naming schema }
|
|
// Note: if the JCL changes its naming convention, a table of equivalences
|
|
// would need to be built. Right now (2006/02/09), this is not necessary
|
|
// as the format is always %type%version.
|
|
Result := JclDir + Format('\lib\%s%d', [Target.TargetType, Target.Version]);
|
|
end;
|
|
|
|
function TTargetConfig.GetJclBplDir: string;
|
|
begin
|
|
Result := FJclBplDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetHppDir: string;
|
|
begin
|
|
Result := FHppDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetDebugUnits: Boolean;
|
|
begin
|
|
Result := FDebugUnits;
|
|
end;
|
|
//----------- Debug directories -------------
|
|
function TTargetConfig.GetDebugUnitOutDir: string;
|
|
begin
|
|
Result := UnitOutDir + PathDelim + 'debug';
|
|
end;
|
|
|
|
function TTargetConfig.GetDebugBplDir: string;
|
|
begin
|
|
Result := UnitOutDir + PathDelim + 'debug';
|
|
end;
|
|
|
|
function TTargetConfig.GetDebugDcpDir: string;
|
|
begin
|
|
Result := UnitOutDir + PathDelim + 'debug';
|
|
end;
|
|
|
|
function TTargetConfig.GetDebugHppDir: string;
|
|
begin
|
|
Result := HppDir;
|
|
end;
|
|
|
|
function TTargetConfig.GetOutputDirs(DebugUnits: Boolean): TOutputDirs;
|
|
begin
|
|
if DebugUnits then
|
|
begin
|
|
Result.UnitOutDir := DebugUnitOutDir;
|
|
Result.BplDir := DebugBplDir;
|
|
Result.DcpDir := DebugDcpDir;
|
|
Result.HppDir := DebugHppDir;
|
|
end
|
|
else
|
|
begin
|
|
Result.UnitOutDir := UnitOutDir;
|
|
Result.BplDir := BplDir;
|
|
Result.DcpDir := DcpDir;
|
|
Result.HppDir := HppDir;
|
|
end;
|
|
end;
|
|
//-------------------------------------------
|
|
function TTargetConfig.GetAutoDependencies: Boolean;
|
|
begin
|
|
Result := FAutoDependencies and not Build;
|
|
end;
|
|
|
|
function TTargetConfig.GetBuild: Boolean;
|
|
begin
|
|
Result := FBuild;
|
|
end;
|
|
|
|
function TTargetConfig.GetCleanPalettes: Boolean;
|
|
begin
|
|
Result := FCleanPalettes;
|
|
end;
|
|
|
|
function TTargetConfig.GetCompileOnly: Boolean;
|
|
begin
|
|
Result := FCompileOnly;
|
|
end;
|
|
|
|
function TTargetConfig.GetAddBplDirToPath: Boolean;
|
|
begin
|
|
Result := FAddBplDirToPath;
|
|
end;
|
|
|
|
function TTargetConfig.GetGenerateMapFiles: Boolean;
|
|
begin
|
|
Result := FGenerateMapFiles;
|
|
end;
|
|
|
|
function TTargetConfig.GetLinkMapFiles: Boolean;
|
|
begin
|
|
Result := FLinkMapFiles;
|
|
end;
|
|
|
|
function TTargetConfig.GetCreateJdbgFiles: Boolean;
|
|
begin
|
|
Result := FCreateJdbgFiles;
|
|
end;
|
|
|
|
function TTargetConfig.GetDeleteMapFiles: Boolean;
|
|
begin
|
|
Result := FDeleteMapFiles;
|
|
end;
|
|
|
|
function TTargetConfig.GetBplDir: string;
|
|
begin
|
|
Result := FBplDir;
|
|
if Result = '' then
|
|
Result := Target.BplDir;
|
|
if Result = '' then
|
|
Result := '.';
|
|
end;
|
|
|
|
function TTargetConfig.GetDcpDir: string;
|
|
begin
|
|
Result := FDcpDir;
|
|
if Result = '' then
|
|
Result := Target.DcpDir;
|
|
if Result = '' then
|
|
Result := '.';
|
|
end;
|
|
|
|
function TTargetConfig.GetFrameworkCount: Integer;
|
|
var
|
|
Kind: TPackageGroupKind;
|
|
begin
|
|
Result := 0;
|
|
for Kind := pkFirst to pkLast do
|
|
begin
|
|
if Frameworks.Items[Target.IsPersonal, Kind] <> nil then
|
|
Inc(Result);
|
|
end;
|
|
end;
|
|
|
|
function TTargetConfig.GetDeveloperInstall: Boolean;
|
|
begin
|
|
Result := FDeveloperInstall;
|
|
end;
|
|
|
|
function TTargetConfig.GetDxgettextDir: string;
|
|
begin
|
|
Result := Owner.DxgettextDir;
|
|
if Result <> '' then
|
|
if Target.Version = 5 then
|
|
Result := Result + '\delphi5'; // do not localize
|
|
end;
|
|
|
|
procedure TTargetConfig.Save;
|
|
var
|
|
Kind: TPackageGroupKind;
|
|
Ini: TMemIniFile;
|
|
IniFileName: string;
|
|
begin
|
|
if JVCLConfig.Modified then
|
|
begin
|
|
FileSetReadOnly(JVCLConfig.Filename, False);
|
|
JVCLConfig.SaveToFile(JVCLConfig.Filename);
|
|
end;
|
|
|
|
for Kind := pkFirst to pkLast do
|
|
begin
|
|
if Frameworks.Items[False, Kind] <> nil then
|
|
SavePackagesSettings(Frameworks.Items[False, Kind]);
|
|
if Frameworks.Items[True, Kind] <> nil then
|
|
SavePackagesSettings(Frameworks.Items[True, Kind]);
|
|
end;
|
|
|
|
IniFileName := ChangeFileExt(ParamStr(0), '.ini'); // do not localize
|
|
FileSetReadOnly(IniFileName, False);
|
|
Ini := TMemIniFile.Create(IniFileName);
|
|
try
|
|
if not Target.SupportsPersonalities([persBCB]) or (HppDir = FDefaultHppDir) then
|
|
Ini.DeleteKey(Target.DisplayName, 'HPPDir') // do not localize
|
|
else
|
|
Ini.WriteString(Target.DisplayName, 'HPPDir', HppDir); // do not localize
|
|
|
|
if BplDir = Target.BplDir then
|
|
Ini.DeleteKey(Target.DisplayName, 'BPLDir') // do not localize
|
|
else
|
|
Ini.WriteString(Target.DisplayName, 'BPLDir', BplDir); // do not localize
|
|
|
|
if DcpDir = Target.DcpDir then
|
|
Ini.DeleteKey(Target.DisplayName, 'DCPDir') // do not localize
|
|
else
|
|
Ini.WriteString(Target.DisplayName, 'DCPDir', DcpDir); // do not localize
|
|
|
|
Ini.WriteBool(Target.DisplayName, 'DeveloperInstall', DeveloperInstall); // do not localize
|
|
Ini.WriteBool(Target.DisplayName, 'CleanPalettes', CleanPalettes); // do not localize
|
|
for Kind := pkFirst to pkLast do
|
|
Ini.WriteBool(Target.DisplayName, 'InstallMode_' + IntToStr(Integer(Kind)), Kind in InstallMode); // do not localize
|
|
Ini.WriteBool(Target.DisplayName, 'AutoDependencies', AutoDependencies); // do not localize
|
|
Ini.WriteBool(Target.DisplayName, 'GenerateMapFiles', GenerateMapFiles); // do not localize
|
|
Ini.WriteBool(Target.DisplayName, 'LinkMapFiles', LinkMapFiles); // do not localize
|
|
Ini.WriteBool(Target.DisplayName, 'DeleteMapFiles', DeleteMapFiles); // do not localize
|
|
Ini.WriteBool(Target.DisplayName, 'DebugUnits', DebugUnits); // do not localize
|
|
|
|
Ini.UpdateFile;
|
|
finally
|
|
Ini.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTargetConfig.Load;
|
|
var
|
|
Kind: TPackageGroupKind;
|
|
Ini: TMemIniFile;
|
|
Mode: TInstallMode;
|
|
Filename: string;
|
|
begin
|
|
for Kind := pkFirst to pkLast do
|
|
begin
|
|
if Frameworks.Items[False, Kind] <> nil then
|
|
ResetPackagesSettings(Frameworks.Items[False, Kind]);
|
|
if Frameworks.Items[True, Kind] <> nil then
|
|
ResetPackagesSettings(Frameworks.Items[True, Kind]);
|
|
end;
|
|
|
|
Ini := TMemIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
|
|
try
|
|
HppDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'HPPDir', HppDir)); // do not localize
|
|
BplDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'BPLDir', BplDir)); // do not localize
|
|
DcpDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'DCPDir', DcpDir)); // do not localize
|
|
DeveloperInstall := Ini.ReadBool(Target.DisplayName, 'DeveloperInstall', DeveloperInstall); // do not localize
|
|
CleanPalettes := Ini.ReadBool(Target.DisplayName, 'CleanPalettes', CleanPalettes); // do not localize
|
|
GenerateMapFiles := Ini.ReadBool(Target.DisplayName, 'GenerateMapFiles', GenerateMapFiles); // do not localize
|
|
LinkMapFiles := Ini.ReadBool(Target.DisplayName, 'LinkMapFiles', LinkMapFiles); // do not localize
|
|
DeleteMapFiles := Ini.ReadBool(Target.DisplayName, 'DeleteMapFiles', DeleteMapFiles); // do not localize
|
|
DebugUnits := Ini.ReadBool(Target.DisplayName, 'DebugUnits', DebugUnits); // do not localize
|
|
Mode := [];
|
|
for Kind := pkFirst to pkLast do
|
|
if Ini.ReadBool(Target.DisplayName, 'InstallMode_' + IntToStr(Integer(Kind)), Kind in InstallMode) then // do not localize
|
|
Include(Mode, Kind);
|
|
|
|
InstallMode := Mode;
|
|
//AutoDependencies := Ini.ReadBool(Target.DisplayName, 'AutoDependencies', AutoDependencies);
|
|
|
|
// fix "Delphi\\Projects" bug
|
|
HppDir := FixBackslashBackslash(HppDir);
|
|
BplDir := FixBackslashBackslash(BplDir);
|
|
DcpDir := FixBackslashBackslash(DcpDir);
|
|
|
|
// Load jvcl%t.inc. Or the jvclbase.inc when no jvcl%t.inc exists
|
|
if Target.IsBDS then
|
|
Filename := GetJVCLDir + '\common\' + Format('jvcl%s%d.inc', // do not localize
|
|
[LowerCase(Target.TargetType), Target.IDEVersion + 6]) // BDS 3 is Delphi 9
|
|
else
|
|
Filename := GetJVCLDir + '\common\' + Format('jvcl%s%d.inc', // do not localize
|
|
[LowerCase(Target.TargetType), Target.Version]);
|
|
if not FileExists(Filename) then
|
|
begin
|
|
JVCLConfig.LoadFromFile(GetJVCLDir + '\common\jvclbase.inc'); // do not localize
|
|
JVCLConfig.Filename := Filename;
|
|
JVCLConfig.Modified := True; // must be stored
|
|
end
|
|
else
|
|
JVCLConfig.LoadFromFile(Filename);
|
|
|
|
// set (hidden) personal edition configuration
|
|
JVCLConfig.Enabled['DelphiPersonalEdition'] := Target.IsPersonal; // do not localize
|
|
|
|
UpdateOptions;
|
|
finally
|
|
Ini.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTargetConfig.EnableOption(const Name: string; Enable: Boolean);
|
|
begin
|
|
if Name <> '' then
|
|
JVCLConfig.Enabled[Name] := Enable and JVCLConfig.Enabled[Name];
|
|
end;
|
|
|
|
procedure TTargetConfig.ClearPackageCache(const Key: string; const AStartsWith: string);
|
|
var
|
|
Reg: TRegistry;
|
|
Names: TStrings;
|
|
i: Integer;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
try
|
|
if Reg.OpenKey(Target.RegistryKey + '\' + Key, False) then
|
|
begin
|
|
Names := TStringList.Create;
|
|
try
|
|
Reg.GetKeyNames(Names);
|
|
Reg.CloseKey;
|
|
for i := 0 to Names.Count - 1 do
|
|
if StartsWith(Names[i], AStartsWith, True) then
|
|
Reg.DeleteKey(Target.RegistryKey + '\' + Key + '\' + Names[i]);
|
|
finally
|
|
Names.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
function TTargetConfig.RegisterProjectGroupToIDE(ProjectGroup: TProjectGroup): Boolean;
|
|
var
|
|
PackageIndex, i: Integer;
|
|
KnownPackages, DisabledPackages: TDelphiPackageList;
|
|
Target: TCompileTarget;
|
|
BplFilename: string;
|
|
begin
|
|
Target := ProjectGroup.Target;
|
|
KnownPackages := Target.KnownPackages;
|
|
DisabledPackages := Target.DisabledPackages;
|
|
|
|
// remove JVCL packages
|
|
for i := DisabledPackages.Count - 1 downto 0 do
|
|
if StartsWith(DisabledPackages.Items[i].Name, 'Jv', True) then // do not localize
|
|
DisabledPackages.Delete(i);
|
|
|
|
for i := KnownPackages.Count - 1 downto 0 do
|
|
if StartsWith(KnownPackages.Items[i].Name, 'Jv', True) then // do not localize
|
|
KnownPackages.Delete(i);
|
|
|
|
if Target.IsBDS then
|
|
ClearPackageCache('Package Cache', 'Jv'); // do not localize
|
|
|
|
for PackageIndex := 0 to ProjectGroup.Count - 1 do
|
|
begin
|
|
BplFilename := ProjectGroup.TargetConfig.BplDir + PathDelim +
|
|
ProjectGroup.Packages[PackageIndex].TargetName;
|
|
if ProjectGroup.Packages[PackageIndex].Install and
|
|
ProjectTypeIsDesign(ProjectGroup.Packages[PackageIndex].Info.ProjectType) and
|
|
FileExists(BplFilename) then
|
|
begin
|
|
KnownPackages.Add(BplFilename, ProjectGroup.Packages[PackageIndex].Info.Description);
|
|
end;
|
|
end;
|
|
|
|
ProjectGroup.Target.SavePaths;
|
|
ProjectGroup.Target.SavePackagesLists;
|
|
Result := True;
|
|
end;
|
|
|
|
function TTargetConfig.RegisterToIDE: Boolean;
|
|
var
|
|
Kind: TPackageGroupKind;
|
|
i: Integer;
|
|
AllPackages, PackageGroup: TProjectGroup;
|
|
begin
|
|
if InstalledJVCLVersion < 3 then
|
|
DeinstallJVCL(nil, nil, True);
|
|
|
|
RegisterJVCLVersionInfo;
|
|
|
|
if AddBplDirToPath then
|
|
begin
|
|
if not Target.IsInEnvPath(BplDir) then
|
|
Target.EnvPath := Target.EnvPath + ';' + BplDir;
|
|
end;
|
|
|
|
// remove old paths
|
|
AddPaths(Target.BrowsingPaths, False, Owner.JVCLDir,
|
|
['common', 'run', 'Resources', 'qcommon', 'qrun']); // do not localize
|
|
AddPaths(Target.SearchPaths, False, Owner.JVCLDir,
|
|
['common', 'run', 'Resources', 'qcommon', 'qrun']); // do not localize
|
|
AddPaths(Target.DebugDcuPaths, {Add:=}False, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(DebugUnitOutDir), DebugUnitOutDir]); // do not localize
|
|
|
|
// update paths
|
|
AddPaths(Target.BrowsingPaths, True, Owner.JVCLDir, // Resources directory must not be in browse-paths
|
|
['common']); // do not localize
|
|
AddPaths(Target.SearchPaths, True, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(UnitOutDir), 'common', 'Resources']); // do not localize
|
|
if DebugUnits and not DeveloperInstall then
|
|
AddPaths(Target.DebugDcuPaths, True, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(DebugUnitOutDir)]); // do not localize
|
|
if Target.SupportsPersonalities([persBCB]) then
|
|
begin
|
|
AddPaths(Target.GlobalIncludePaths, True, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(HppDir)]);
|
|
AddPaths(Target.GlobalCppSearchPaths, True, Owner.JVCLDir,
|
|
['Resources', Target.InsertDirMacros(UnitOutDir)]); // do not localize
|
|
AddPaths(Target.GlobalCppLibraryPaths, True, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(UnitOutDir)]); // do not localize
|
|
end;
|
|
|
|
// add
|
|
if pkVCL in InstallMode then
|
|
begin
|
|
AddPaths(Target.BrowsingPaths, True, Owner.JVCLDir,
|
|
['run']); // do not localize
|
|
AddPaths(Target.SearchPaths, {Add:=}DeveloperInstall, Owner.JVCLDir,
|
|
['run']); // do not localize
|
|
end;
|
|
if pkCLX in InstallMode then
|
|
begin
|
|
AddPaths(Target.BrowsingPaths, True, Owner.JVCLDir,
|
|
['qcommon', 'qrun']); // do not localize
|
|
AddPaths(Target.SearchPaths, {Add:=}DeveloperInstall, Owner.JVCLDir,
|
|
['qcommon', 'qrun']); // do not localize
|
|
end;
|
|
|
|
AllPackages := TProjectGroup.Create(Self, '');
|
|
try
|
|
for Kind := pkFirst to pkLast do
|
|
begin
|
|
if Kind in InstallMode then
|
|
begin
|
|
PackageGroup := Frameworks.Items[Target.IsPersonal, Kind];
|
|
if PackageGroup <> nil then
|
|
begin
|
|
for i := 0 to PackageGroup.Count - 1 do
|
|
if PackageGroup.Packages[i].Install then
|
|
AllPackages.AddPackage(PackageGroup.Packages[i]);
|
|
end;
|
|
end;
|
|
end;
|
|
Result := RegisterProjectGroupToIDE(AllPackages);
|
|
finally
|
|
AllPackages.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTargetConfig.Reinit;
|
|
begin
|
|
Init;
|
|
end;
|
|
|
|
procedure TTargetConfig.DoCleanPalette(Reg: TRegistry; const Name: string;
|
|
RemoveEmptyPalettes: Boolean);
|
|
var
|
|
Entries, S: string;
|
|
List: TStrings;
|
|
i, ps: Integer;
|
|
begin
|
|
Entries := Reg.ReadString(Name);
|
|
List := TStringList.Create;
|
|
try
|
|
ps := 0;
|
|
for i := 1 to Length(Entries) do
|
|
if Entries[i] = ';' then // do not localize
|
|
begin
|
|
List.Add(SubStr(Entries, ps + 1, i - 1));
|
|
ps := i;
|
|
end;
|
|
if ps < Length(Entries) then
|
|
List.Add(SubStr(Entries, ps + 1, Length(Entries)));
|
|
|
|
for i := List.Count - 1 downto 0 do
|
|
begin
|
|
ps := Pos('.', List[i]); // for Delphi 6, 7 and BCB 6
|
|
if Copy(List[i], ps + 1, 3) = RsComponentPalettePrefix then
|
|
List.Delete(i);
|
|
end;
|
|
|
|
S := '';
|
|
for i := 0 to List.Count - 1 do
|
|
S := S + List[i] + ';'; // do not localize
|
|
// last char is ';'
|
|
|
|
if (S <> '') or (not RemoveEmptyPalettes) then
|
|
begin
|
|
if S <> Entries then
|
|
Reg.WriteString(Name, S)
|
|
end
|
|
else
|
|
Reg.DeleteValue(Name);
|
|
|
|
finally
|
|
List.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTargetConfig.CleanJVCLPalette(RemoveEmptyPalettes: Boolean);
|
|
var
|
|
i: Integer;
|
|
Reg: TRegistry;
|
|
List: TStrings;
|
|
begin
|
|
reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := HKEY_CURRENT_USER;
|
|
if Reg.OpenKey(Target.RegistryKey + '\Palette', False) then // do not localize
|
|
begin
|
|
List := TStringList.Create;
|
|
try
|
|
Reg.GetValueNames(List);
|
|
for i := 0 to List.Count - 1 do
|
|
DoCleanPalette(reg, List[i], RemoveEmptyPalettes);
|
|
finally
|
|
List.Free;
|
|
end;
|
|
end;
|
|
|
|
if Target.IsBDS then
|
|
ClearPackageCache('Palette\Cache', 'Jv'); // do not localize
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTargetConfig.DeinstallJVCL(Progress: TDeinstallProgressEvent;
|
|
DeleteFiles: TDeleteFilesEvent; RealUninstall: Boolean);
|
|
|
|
procedure DoProgress(const Text: string; Position, Max: Integer);
|
|
begin
|
|
if Assigned(Progress) then
|
|
Progress(Self, Text, Position, Max);
|
|
end;
|
|
|
|
var
|
|
MaxSteps: Integer;
|
|
i: Integer;
|
|
// Ini: TMemIniFile;
|
|
// Kind: TPackageGroupKind;
|
|
begin
|
|
MaxSteps := 4;
|
|
if not Assigned(DeleteFiles) then
|
|
Dec(MaxSteps);
|
|
|
|
{**}DoProgress(RsCleaningPalette, 0, MaxSteps);
|
|
if RealUninstall then
|
|
CleanJVCLPalette(True);
|
|
|
|
if Target.IsBDS then
|
|
ClearPackageCache('Package Cache', 'Jv'); // do not localize
|
|
|
|
{**}DoProgress(RsCleaningPathLists, 1, MaxSteps);
|
|
|
|
// remove JVCL 1 and 2 directories
|
|
for i := Target.BrowsingPaths.Count - 1 downto 0 do
|
|
if Pos('\jvpack\', AnsiLowerCase(Target.BrowsingPaths[i])) <> 0 then // do not localize
|
|
Target.BrowsingPaths.Delete(i);
|
|
|
|
for i := Target.SearchPaths.Count - 1 downto 0 do
|
|
if Pos('\jvpack\', AnsiLowerCase(Target.SearchPaths[i])) <> 0 then // do not localize
|
|
Target.SearchPaths.Delete(i);
|
|
|
|
|
|
// remove JVCL 3 directories
|
|
AddPaths(Target.BrowsingPaths, {Add:=}False, Owner.JVCLDir,
|
|
['common', 'design', 'run', 'Resources', 'qcommon', 'qdesign', 'qrun']); // do not localize
|
|
AddPaths(Target.SearchPaths, {Add:=}False, Owner.JVCLDir,
|
|
['common', 'design', 'run', 'Resources', 'qcommon', 'qdesign', 'qrun', // do not localize
|
|
Target.InsertDirMacros(UnitOutDir), UnitOutDir]);
|
|
AddPaths(Target.DebugDcuPaths, {Add:=}False, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(DebugUnitOutDir), DebugUnitOutDir]); // do not localize
|
|
if Target.SupportsPersonalities([persBCB]) then
|
|
begin
|
|
AddPaths(Target.GlobalIncludePaths, False, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(HppDir)]);
|
|
AddPaths(Target.GlobalCppSearchPaths, False, Owner.JVCLDir,
|
|
['Resources', Target.InsertDirMacros(UnitOutDir)]); // do not localize
|
|
AddPaths(Target.GlobalCppLibraryPaths, False, Owner.JVCLDir,
|
|
[Target.InsertDirMacros(UnitOutDir)]); // do not localize
|
|
end;
|
|
Target.SavePaths;
|
|
|
|
{**}DoProgress(RsUnregisteringPackages, 2, MaxSteps);
|
|
// remove JVCL packages
|
|
with Target do
|
|
begin
|
|
for i := DisabledPackages.Count - 1 downto 0 do
|
|
if StartsWith(DisabledPackages.Items[i].Name, 'Jv', True) then // do not localize
|
|
DisabledPackages.Delete(i);
|
|
|
|
for i := KnownPackages.Count - 1 downto 0 do
|
|
if StartsWith(KnownPackages.Items[i].Name, 'Jv', True) then // do not localize
|
|
KnownPackages.Delete(i);
|
|
end;
|
|
Target.SavePackagesLists;
|
|
|
|
if RealUninstall then
|
|
begin
|
|
RemoveJediRegInformation(Target.RegistryKey, 'JVCL');
|
|
|
|
// clean ini file
|
|
{ Ini := TMemIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')); // do not localize
|
|
try
|
|
Ini.EraseSection(Target.DisplayName);
|
|
for Kind := pkFirst to pkLast do
|
|
begin
|
|
if Frameworks.Items[False, Kind] <> nil then
|
|
Ini.EraseSection(Frameworks.Items[False, Kind].BpgName);
|
|
if Frameworks.Items[True, Kind] <> nil then
|
|
Ini.EraseSection(Frameworks.Items[True, Kind].BpgName);
|
|
end;
|
|
Ini.UpdateFile;
|
|
finally
|
|
Ini.Free;
|
|
end;}
|
|
|
|
if Assigned(DeleteFiles) then
|
|
begin
|
|
{**}DoProgress(RsDeletingFiles, 3, MaxSteps);
|
|
DeleteFiles(Self);
|
|
end;
|
|
end;
|
|
|
|
{**}DoProgress(RsComplete, MaxSteps, MaxSteps);
|
|
end;
|
|
|
|
procedure TTargetConfig.GetPackageBinariesForDeletion(List: TStrings);
|
|
var
|
|
Mask: string;
|
|
begin
|
|
if Target.IsBCB then
|
|
Mask := 'Jv*C' + IntToStr(Target.Version) + '?.*' // do not localize
|
|
else
|
|
Mask := 'Jv*D' + IntToStr(Target.Version) + '?.*'; // do not localize
|
|
|
|
FindFiles(BplDir, Mask, False, List,
|
|
['.bpl', '.dcp', '.lib', '.bpi', '.tds', '.map']); // do not localize
|
|
if CompareText(DcpDir, BplDir) <> 0 then
|
|
FindFiles(DcpDir, 'Jv*.*', False, List, // do not localize
|
|
['.dcp', '.lib', '.bpi', '.lsp']); // do not localize
|
|
// in Default directories
|
|
if CompareText(BplDir, Target.BplDir) <> 0 then
|
|
FindFiles(Target.BplDir, Mask, False, List,
|
|
['.bpl', '.dcp', '.lib', '.bpi', '.tds', '.map']); // do not localize
|
|
if (CompareText(DcpDir, BplDir) <> 0) and
|
|
(CompareText(DcpDir, Target.DcpDir) <> 0) then
|
|
FindFiles(Target.DcpDir, 'Jv*.*', False, List, // do not localize
|
|
['.dcp', '.lib', '.bpi', '.lsp']); // do not localize
|
|
end;
|
|
|
|
function TTargetConfig.GetPathEnvVar: string;
|
|
|
|
function ShortName(const Filename: string): string;
|
|
begin
|
|
Result := ExtractShortPathName(ExcludeTrailingPathDelimiter(Filename));
|
|
if Result = '' then
|
|
Result := ExcludeTrailingPathDelimiter(Filename);
|
|
Result := AnsiLowerCase(Result);
|
|
end;
|
|
|
|
var
|
|
List: TStrings;
|
|
i, k: Integer;
|
|
ShortDir: string;
|
|
begin
|
|
List := TStringList.Create;
|
|
try
|
|
StrToPathList(Target.EnvPath, List);
|
|
for i := List.Count - 1 downto 0 do
|
|
begin
|
|
ShortDir := ShortName(List[i]);
|
|
if not DirectoryExists(ExcludeTrailingPathDelimiter(List[i])) then
|
|
List.Delete(i)
|
|
else
|
|
for k := 0 to Owner.Targets.Count - 1 do
|
|
begin
|
|
if (ShortName(Owner.Targets[k].BplDir) = ShortDir) or
|
|
(ShortName(Owner.Targets[k].DcpDir) = ShortDir) then
|
|
begin
|
|
if (ShortDir <> ShortName(Target.BplDir)) and
|
|
(ShortDir <> ShortName(Target.DcpDir)) and
|
|
(ShortDir <> ShortName(BplDir)) and
|
|
(ShortDir <> ShortName(DcpDir)) then
|
|
begin
|
|
List.Delete(i);
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := PathListToStr(List);
|
|
finally
|
|
List.Free;
|
|
end;
|
|
end;
|
|
|
|
{$I InstalledPackages.inc}
|
|
|
|
end.
|