521 lines
18 KiB
ObjectPascal
521 lines
18 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) extension }
|
|
{ }
|
|
{ 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/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JediInstallIntf.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are }
|
|
{ Copyright (C) of Petr Vones. All Rights Reserved. }
|
|
{ }
|
|
{ Contributor(s): Robert Rossmair (crossplatform & BCB support) }
|
|
{ Florent Ouchet (new core for more than one target) }
|
|
{ }
|
|
{ Last modified: $Date: 2006-12-30 20:56:40 +0100 (sam., 30 déc. 2006) $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JediInstall;
|
|
|
|
{$I jcl.inc}
|
|
{$I crossplatform.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes,
|
|
JclContainerIntf;
|
|
|
|
type
|
|
TJediInstallGUIOption =
|
|
(
|
|
goExpandable,
|
|
goRadioButton,
|
|
goNoAutoCheck, // do not auto-check when the parent node gets checked
|
|
goStandaloneParent, // do not auto-uncheck when all child nodes are unchecked
|
|
goChecked
|
|
);
|
|
TJediInstallGUIOptions = set of TJediInstallGUIOption;
|
|
|
|
type
|
|
TDialogType = (dtWarning, dtError, dtInformation, dtConfirmation);
|
|
TDialogResponse = (drYes, drNo, drOK, drCancel);
|
|
TDialogResponses = set of TDialogResponse;
|
|
|
|
EJediInstallInitFailure = class(Exception);
|
|
|
|
IJediPage = interface
|
|
['{5669B427-F46D-4737-9D1D-680C52CDE3DF}']
|
|
function GetCaption: string;
|
|
procedure SetCaption(const Value: string);
|
|
function GetHintAtPos(ScreenX, ScreenY: Integer): string;
|
|
procedure Show;
|
|
|
|
property Caption: string read GetCaption write SetCaption;
|
|
end;
|
|
|
|
IJediReadmePage = interface(IJediPage)
|
|
['{5DA5C5C9-649F-47CF-B64A-55E983CA88EC}']
|
|
procedure SetReadmeFileName(const Value: string);
|
|
function GetReadmeFileName: string;
|
|
|
|
property ReadmeFileName: string read GetReadmeFileName write SetReadmeFileName;
|
|
end;
|
|
|
|
IJediInstallPage = interface(IJediPage)
|
|
['{91C3A26F-0258-410A-9EAF-06F86C5748CF}']
|
|
procedure AddInstallOption(Id: Integer; Options: TJediInstallGUIOptions;
|
|
const Caption: string = ''; const Hint: string = ''; Parent: Integer = -1);
|
|
procedure InitDisplay;
|
|
function GetOptionChecked(Id: Integer): Boolean;
|
|
procedure SetOptionChecked(Id: Integer; Value: Boolean);
|
|
function GetDirectoryCount: Integer;
|
|
function GetDirectory(Index: Integer): string;
|
|
procedure SetDirectory(Index: Integer; const Value: string);
|
|
function AddDirectory(Caption: string): Integer;
|
|
function GetProgress: Integer;
|
|
procedure SetProgress(Value: Integer);
|
|
procedure BeginInstall;
|
|
procedure MarkOptionBegin(Id: Integer);
|
|
procedure MarkOptionEnd(Id: Integer; Failed: Boolean);
|
|
procedure EndInstall;
|
|
procedure CompilationStart(const ProjectName: string);
|
|
procedure AddHint(const Line: string);
|
|
procedure AddWarning(const Line: string);
|
|
procedure AddError(const Line: string);
|
|
procedure AddFatal(const Line: string);
|
|
procedure AddText(const Line: string);
|
|
procedure CompilationProgress(const FileName: string; LineNumber: Integer);
|
|
procedure SetIcon(const FileName: string);
|
|
|
|
property OptionChecked[Id: Integer]: Boolean read GetOptionChecked write SetOptionChecked;
|
|
property DirectoryCount: Integer read GetDirectoryCount;
|
|
property Directories[Index: Integer]: string read GetDirectory write SetDirectory;
|
|
property Progress: Integer read GetProgress write SetProgress;
|
|
end;
|
|
|
|
TOptionRec = record
|
|
Name: string;
|
|
Value: string;
|
|
end;
|
|
|
|
TOptionArray = array of TOptionRec;
|
|
|
|
TStringArray = array of string;
|
|
|
|
IJediConfiguration = interface
|
|
['{4E96C8E8-ABA7-475D-BDF9-88B158F2CED3}']
|
|
function GetSections: TStringArray;
|
|
function GetOptions(const Section: string): TOptionArray;
|
|
function GetOptionAsBool(const Section: string; Id: Integer): Boolean;
|
|
procedure SetOptionAsBool(const Section: string; Id: Integer; Value: Boolean);
|
|
function GetOptionAsBoolByName(const Section: string; const Name: string): Boolean;
|
|
procedure SetOptionAsBoolByName(const Section: string; const Name: string; Value: Boolean);
|
|
function GetOptionAsString(const Section: string; Id: Integer): string;
|
|
procedure SetOptionAsString(const Section: string; Id: Integer; const Value: string);
|
|
function GetOptionAsStringByName(const Section: string; const Name: string): string;
|
|
procedure SetOptionAsStringByName(const Section: string; const Name: string; const Value: string);
|
|
|
|
procedure Clear;
|
|
procedure DeleteSection(const Section: string);
|
|
procedure DeleteOption(const Section: string; Id: Integer);
|
|
function SectionExists(const Section: string): Boolean;
|
|
function ValueExists(const Section: string; Id: Integer): Boolean; overload;
|
|
function ValueExists(const Section: string; const Name: string): Boolean; overload;
|
|
|
|
property Sections: TStringArray read GetSections;
|
|
property Options[const Section: string]: TOptionArray read GetOptions;
|
|
property OptionAsBool[const Section: string; Id: Integer]: Boolean read GetOptionAsBool
|
|
write SetOptionAsBool;
|
|
property OptionAsBoolByName[const Section: string; const Name: string]: Boolean
|
|
read GetOptionAsBoolByName write SetOptionAsBoolByName;
|
|
property OptionAsString[const Section: string; Id: Integer]: string read GetOptionAsString
|
|
write SetOptionAsString;
|
|
property OptionAsStringByName[const Section: string; const Name: string]: string
|
|
read GetOptionAsStringByName write SetOptionAsStringByName;
|
|
end;
|
|
|
|
IJediDistribution = interface
|
|
['{90E201C9-EA6B-446A-9251-D2516867874D}']
|
|
end;
|
|
|
|
TInstallEvent = procedure of Object;
|
|
|
|
// GUI abstraction layer
|
|
IJediInstallGUI = interface
|
|
['{3471A535-51D7-4FBB-B6AE-20D136E38E34}']
|
|
function Dialog(const Text: string; DialogType: TDialogType = dtInformation;
|
|
Options: TDialogResponses = [drOK]): TDialogResponse;
|
|
function CreateReadmePage: IJediReadmePage;
|
|
function CreateInstallPage: IJediInstallPage;
|
|
function GetPageCount: Integer;
|
|
function GetPage(Index: Integer): IJediPage;
|
|
function GetStatus: string;
|
|
procedure SetStatus(const Value: string);
|
|
function GetCaption: string;
|
|
procedure SetCaption(const Value: string);
|
|
function GetProgress: Integer;
|
|
procedure SetProgress(Value: Integer);
|
|
procedure Execute;
|
|
|
|
property PageCount: Integer read GetPageCount;
|
|
property Pages[Index: Integer]: IJediPage read GetPage;
|
|
property Status: string read GetStatus write SetStatus;
|
|
property Caption: string read GetCaption write SetCaption;
|
|
property Progress: Integer read GetProgress write SetProgress;
|
|
end;
|
|
|
|
IJediProduct = interface
|
|
['{CF5BE67A-4A49-43FB-8F6E-217A51023DA4}']
|
|
procedure Init;
|
|
procedure Install;
|
|
procedure Uninstall;
|
|
procedure Close;
|
|
end;
|
|
|
|
TJediInstallGUICreator = function: IJediInstallGUI;
|
|
TJediConfigurationCreator = function: IJediConfiguration;
|
|
|
|
TCompileLineType = (clText, clFileProgress, clHint, clWarning, clError, clFatal);
|
|
|
|
TJediInstallCore = class(TComponent)
|
|
private
|
|
FInstallGUI: IJediInstallGUI;
|
|
{$IFDEF VisualCLX}
|
|
FGUIComponent: TComponent;
|
|
{$ENDIF VisualCLX}
|
|
FProducts: IJclIntfList;
|
|
FClosing: Boolean;
|
|
FOptions: TStrings;
|
|
FInstallGUICreator: TJediInstallGUICreator;
|
|
FConfiguration: IJediConfiguration;
|
|
FConfigurationCreator: TJediConfigurationCreator;
|
|
function GetProductCount: Integer;
|
|
function GetProduct(Index: Integer): IJediProduct;
|
|
function GetInstallGUI: IJediInstallGUI;
|
|
function GetConfiguration: IJediConfiguration;
|
|
{$IFDEF VisualCLX}
|
|
protected
|
|
procedure Notification(AComponent: TComponent;
|
|
Operation: TOperation); override;
|
|
{$ENDIF VisualCLX}
|
|
public
|
|
constructor Create; reintroduce;
|
|
destructor Destroy; override;
|
|
|
|
function AddProduct(AProduct: IJediProduct): Integer;
|
|
procedure Execute;
|
|
procedure Install;
|
|
procedure Uninstall;
|
|
procedure Close;
|
|
function AddInstallOption(const Name: string): Integer;
|
|
function GetInstallOptionName(Id: Integer): string;
|
|
function GetOptionCount: Integer;
|
|
function ProcessLogLine(const Line: string; var LineType: TCompileLineType;
|
|
Page: IJediInstallPage): string;
|
|
|
|
property ProductCount: Integer read GetProductCount;
|
|
property Products[Index: Integer]: IJediProduct read GetProduct;
|
|
property Closing: Boolean read FClosing;
|
|
property InstallOptionName[Id: Integer]: string read GetInstallOptionName;
|
|
property OptionCount: Integer read GetOptionCount;
|
|
property InstallGUI: IJediInstallGUI read GetInstallGUI;
|
|
property InstallGUICreator: TJediInstallGUICreator read FInstallGUICreator
|
|
write FInstallGUICreator;
|
|
property Configuration: IJediConfiguration read GetConfiguration;
|
|
property ConfigurationCreator: TJediConfigurationCreator read FConfigurationCreator
|
|
write FConfigurationCreator;
|
|
end;
|
|
|
|
var
|
|
JediTargetOption: Integer = -1;
|
|
|
|
function InstallCore: TJediInstallCore;
|
|
|
|
resourcestring
|
|
RsCantFindFiles = 'Can not find installation files, check your installation.';
|
|
RsCloseRADTool = 'Please close all running instances of Delphi/C++Builder IDE before the installation.';
|
|
RsConfirmInstall = 'Are you sure to install all selected features?';
|
|
RsConfirmUninstall = 'Do you really want to uninstall the JCL?';
|
|
RsInstallSuccess = 'Installation finished';
|
|
RsInstallFailure = 'Installation failed.'#10'Check compiler output for details.';
|
|
RsNoInstall = 'There is no Delphi/C++Builder installation on this machine. Installer will close.';
|
|
RsUpdateNeeded = 'You should install latest Update Pack #%d for %s.'#13#10 +
|
|
'Would you like to open Borland support web page?';
|
|
RsHintTarget = 'Installation target';
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclArrayLists;
|
|
|
|
var
|
|
InternalInstallCore: TJediInstallCore = nil;
|
|
|
|
function InstallCore: TJediInstallCore;
|
|
begin
|
|
if not Assigned(InternalInstallCore) then
|
|
InternalInstallCore := TJediInstallCore.Create;
|
|
Result := InternalInstallCore;
|
|
end;
|
|
|
|
//=== { TJediInstallCore } ===================================================
|
|
|
|
function TJediInstallCore.AddInstallOption(const Name: string): Integer;
|
|
begin
|
|
Result := FOptions.IndexOf(Name);
|
|
if Result = -1 then
|
|
Result := FOptions.Add(Name);
|
|
end;
|
|
|
|
function TJediInstallCore.AddProduct(AProduct: IJediProduct): Integer;
|
|
begin
|
|
Result := FProducts.Size;
|
|
FProducts.Add(AProduct);
|
|
end;
|
|
|
|
procedure TJediInstallCore.Close;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
if Closing then
|
|
Exit;
|
|
FClosing := True;
|
|
|
|
for Index := FProducts.Size - 1 downto 0 do
|
|
(FProducts.GetObject(Index) as IJediProduct).Close;
|
|
FProducts.Clear;
|
|
FProducts := nil;
|
|
FInstallGUI := nil;
|
|
FConfiguration := nil;
|
|
end;
|
|
|
|
constructor TJediInstallCore.Create;
|
|
begin
|
|
inherited Create(nil);
|
|
|
|
FOptions := TStringList.Create;
|
|
FProducts := TJclIntfArrayList.Create;
|
|
FClosing := False;
|
|
JediTargetOption := AddInstallOption('joTarget');
|
|
end;
|
|
|
|
destructor TJediInstallCore.Destroy;
|
|
begin
|
|
Close;
|
|
FConfigurationCreator := nil;
|
|
FInstallGUICreator := nil;
|
|
FProducts := nil;
|
|
FInstallGUI := nil;
|
|
FConfiguration := nil;
|
|
FOptions.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJediInstallCore.Execute;
|
|
var
|
|
Index: Integer;
|
|
AInstallGUI: IJediInstallGUI;
|
|
begin
|
|
AInstallGUI := InstallGUI;
|
|
|
|
for Index := FProducts.Size - 1 downto 0 do
|
|
(FProducts.GetObject(Index) as IJediProduct).Init;
|
|
|
|
if Assigned(AInstallGUI) then
|
|
AInstallGUI.Execute;
|
|
end;
|
|
|
|
function TJediInstallCore.GetConfiguration: IJediConfiguration;
|
|
begin
|
|
if Assigned(FConfigurationCreator) and not Assigned(FConfiguration) then
|
|
FConfiguration := ConfigurationCreator;
|
|
Result := FConfiguration;
|
|
end;
|
|
|
|
function TJediInstallCore.GetInstallGUI: IJediInstallGUI;
|
|
{$IFDEF VisualCLX}
|
|
var
|
|
CompRef: IInterfaceComponentReference;
|
|
{$ENDIF VisualCLX}
|
|
begin
|
|
if Assigned(FInstallGUICreator) and not Assigned(FInstallGUI) then
|
|
FInstallGUI := InstallGUICreator;
|
|
Result := FInstallGUI;
|
|
{$IFDEF VisualCLX}
|
|
Result.QueryInterface(IInterfaceComponentReference, CompRef);
|
|
if Assigned(CompRef) then
|
|
begin
|
|
FGUIComponent := CompRef.GetComponent;
|
|
FGuiComponent.FreeNotification(Self);
|
|
end;
|
|
{$ENDIF VisualCLX}
|
|
end;
|
|
|
|
function TJediInstallCore.GetInstallOptionName(Id: Integer): string;
|
|
begin
|
|
Result := FOptions.Strings[Id];
|
|
end;
|
|
|
|
function TJediInstallCore.GetOptionCount: Integer;
|
|
begin
|
|
Result := FOptions.Count;
|
|
end;
|
|
|
|
function TJediInstallCore.GetProduct(Index: Integer): IJediProduct;
|
|
begin
|
|
Result := FProducts.GetObject(Index) as IJediProduct;
|
|
end;
|
|
|
|
function TJediInstallCore.GetProductCount: Integer;
|
|
begin
|
|
Result := FProducts.Size;
|
|
end;
|
|
|
|
procedure TJediInstallCore.Install;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
for Index := FProducts.Size - 1 downto 0 do
|
|
(FProducts.GetObject(Index) as IJediProduct).Install;
|
|
end;
|
|
|
|
{$IFDEF VisualCLX}
|
|
procedure TJediInstallCore.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FGUIComponent) then
|
|
begin
|
|
FGUIComponent := nil;
|
|
FInstallGUI := nil;
|
|
end;
|
|
end;
|
|
{$ENDIF VisualCLX}
|
|
|
|
function TJediInstallCore.ProcessLogLine(const Line: string;
|
|
var LineType: TCompileLineType; Page: IJediInstallPage): string;
|
|
|
|
function HasText(Text: string; const Values: array of string): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
Text := AnsiLowerCase(Text);
|
|
for i := Low(Values) to High(Values) do
|
|
if Pos(Values[i], Text) > 0 then
|
|
Exit;
|
|
Result := False;
|
|
end;
|
|
|
|
function IsCompileFileLine(const Line: string): Boolean;
|
|
|
|
function PosLast(Ch: Char; const S: string): Integer;
|
|
begin
|
|
for Result := Length(S) downto 1 do
|
|
if S[Result] = Ch then
|
|
Exit;
|
|
Result := 0;
|
|
end;
|
|
|
|
var
|
|
ps, psEnd, LineNum, Err: Integer;
|
|
Filename: string;
|
|
begin
|
|
Result := False;
|
|
ps := PosLast('(', Line);
|
|
if (ps > 0) and (Pos(': ', Line) = 0) and (Pos('.', Line) > 0) then
|
|
begin
|
|
psEnd := PosLast(')', Line);
|
|
if psEnd < ps then
|
|
Exit;
|
|
|
|
Filename := Copy(Line, 1, ps - 1);
|
|
if (Filename <> '') and (Filename[Length(Filename)] > #32) then
|
|
begin
|
|
Val(Copy(Line, ps + 1, psEnd - ps - 1), LineNum, Err);
|
|
if Err = 0 then
|
|
begin
|
|
if Assigned(Page) then
|
|
Page.CompilationProgress(FileName, LineNum);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
LineType := clText;
|
|
Result := Line;
|
|
if Line = '' then
|
|
Exit;
|
|
|
|
if IsCompileFileLine(Line) then
|
|
begin
|
|
LineType:= clFileProgress;
|
|
Result := '';
|
|
end
|
|
else if HasText(Line, ['hint: ', 'hinweis: ', 'suggestion: ', 'conseil: ']) then // do not localize
|
|
begin
|
|
// hide hint about getter/setter names
|
|
if (Pos(' H2369 ', Line) = 0) then
|
|
begin
|
|
LineType := clHint;
|
|
if Assigned(Page) then
|
|
Page.AddHint(Line);
|
|
end
|
|
else
|
|
Result := '';
|
|
end
|
|
else if HasText(Line, ['warning: ', 'warnung: ', 'avertissement: ']) then // do not localize
|
|
begin
|
|
// hide platform warnings
|
|
if (Pos(' W1002 ', Line) = 0) then
|
|
begin
|
|
LineType := clWarning;
|
|
if Assigned(Page) then
|
|
Page.AddWarning(Line);
|
|
end
|
|
else
|
|
Result := '';
|
|
end
|
|
else if HasText(Line, ['error: ', 'fehler: ', 'erreur: ']) then // do not localize
|
|
begin
|
|
LineType := clError;
|
|
if Assigned(Page) then
|
|
Page.AddError(Line);
|
|
end
|
|
else if HasText(Line, ['fatal: ', 'schwerwiegend: ', 'fatale: ']) then // do not localize
|
|
begin
|
|
LineType := clFatal;
|
|
if Assigned(Page) then
|
|
Page.AddFatal(Line);
|
|
end
|
|
else if Assigned(Page) then
|
|
Page.AddText(Line);
|
|
end;
|
|
|
|
procedure TJediInstallCore.Uninstall;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
for Index := FProducts.Size - 1 downto 0 do
|
|
(FProducts.GetObject(Index) as IJediProduct).Uninstall;
|
|
end;
|
|
|
|
initialization
|
|
|
|
finalization
|
|
|
|
InternalInstallCore.Free;
|
|
|
|
end.
|