diff --git a/Readme.md b/Readme.md index 845294f..608ee98 100644 --- a/Readme.md +++ b/Readme.md @@ -7,42 +7,52 @@ Silverpoint MultiInstaller can help you install multiple component packs in a fe Just download the zips and select the destination folder, all the components will be uninstalled from the IDE if they were previously installed, unziped, patched, compiled and installed. It can also install multiple packages directly from GIT repositories. +For more info go to: -For more info go to: -www.silverpointdevelopment.com +## Changes in this version +By default the installer uses the setup.ini file from the same folder as the installer executable. + +This fork features some useful additions: + +- The setup .ini file can be dragged and dropped onto the installer form. +- The setup .ini file can be passed via the `-I:Setup.ini` command line switch. +- Autostarting the installer can be turned off via the `-A:off|false|0` command line switch. + Default: on. +- The default installation folder `DefaultInstallFolder` can be relative to the setup .ini file. ## License The contents of this package are licensed under a disjunctive tri-license giving you the choice of one of the three following sets of free software/open source licensing terms: - - Mozilla Public License, version 1.1 - http://www.mozilla.org/MPL/MPL-1.1.html - - GNU General Public License, version 2.0 - http://www.gnu.org/licenses/gpl-2.0.html - - GNU Lesser General Public License, version 2.1 - http://www.gnu.org/licenses/lgpl-2.1.html +- Mozilla Public License, version 1.1 + +- GNU General Public License, version 2.0 + +- GNU Lesser General Public License, version 2.1 + Software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. The initial developer of this package is Robert Lee. - ## Installation Requirements: -- RAD Studio XE or newer +- RAD Studio XE2 or newer ## Getting Started To install a component pack with MultiInstaller you have to follow these steps: + 1) Read the licenses of the component packs you want to install. 2) Get the zip files of component packs. 3) Get the Silverpoint MultiInstaller. 4) Get the Setup.ini file for that component pack installation or create one. For example, if you want to install TB2K + SpTBXLib: + 1) Create a new folder for the installation. 2) Download all the component zips to the created folder: SpTBXLib + TB2K + TB2K Patch 3) Download the MultiInstaller @@ -60,4 +70,3 @@ C:\MyInstall ``` You are ready to install the component packages, just run the MultiInstaller, select the destination folder, and all the components will be unziped, patched, compiled and installed on the Delphi IDE. - diff --git a/Release History.txt b/Release History.txt index 1a818eb..adb123f 100644 --- a/Release History.txt +++ b/Release History.txt @@ -1,3 +1,11 @@ +10 October 2025 - version 3.6.0 + - Added RAD Studio 13 Florence support. +..- Starting from RAD Studio Florence compile and install the 64-Bit IDE packages as well + - Removed support for Delphi versions before XE2 + - The setup .ini file can now be passed on the command line or dragged onto the window. + - Made Installer window resizable. + - Code cleanup + 28 November 2023 - version 3.5.10 - Added RAD Studio 12 Athens support. - Improved IDE macros parsing speed. @@ -12,47 +20,47 @@ 24 December 2020 - version 3.5.7 - Added RAD Studio Sydney support. - + 22 January 2020 - version 3.5.6 - Code cleanup - + 26 November 2018 - version 3.5.5 - Added RAD Studio 10.3 Rio support. - Added GIT support, thanks to PyScripter 21 September 2018 - version 3.5.4 - Added RAD Studio 10.2 Tokyo support. - + 21 May 2016 - version 2.5.3 - Added support for RAD Studio XE8, RAD Studio 10 Seattle and RAD Studio 10.1 Berlin - + 28 October 2014 - version 3.5.2 - Added RAD Studio XE7 support. - + 28 May 2014 - version 3.5.1 - Added RAD Studio XE6 support. - + 18 March 2014 - version 3.5 - Added RAD Studio XE4 and XE5 support. - + 20 April 2013 - version 3.4.8 - Added Delphi XE3 and C++ Builder XE3 support. - + 7 February 2012 - version 3.4.7 - Added Delphi XE2 and C++ Builder XE2 support. - + 25 June 2011 - version 3.4.6 - Added Delphi XE and C++ Builder XE support. - + 13 September 2009 - version 3.4.5 - Added Delphi 2010 and C++ Builder 2010 support. - + 15 March 2009 - version 3.4.4 - MultiInstaller is now tri-licensed, you can choose between MPL, GPL and LGPL. - + 1 March 2009 - version 3.4.3 - - Stéphane Wierzbicki improved the SpExecuteDosCommand utility + - Stéphane Wierzbicki improved the SpExecuteDosCommand utility function and added multiple SearchPaths handling, like the Includes parameter, the SearchPath parameter should either contain one source directory or multiple ones. For the later, @@ -60,27 +68,27 @@ 17 January 2009 - version 3.4.2 - Fixed incorrect French translation of the RAD Studio Project - directory, thanks to Stéphane Wierzbicki for reporting it. - + directory, thanks to Stéphane Wierzbicki for reporting it. + 26 September 2008 - version 3.4.1 - Added Delphi 2009 and C++ Builder 2009 support. - + 4 September 2007 - version 3.4 - Added Delphi 2007 and C++ Builder 2007 support. - + 24 November 2006 - version 3.3.1 - Added extra check to use -JL compiler switch, it will be used only if the C++Builder personality is installed. - + 27 August 2006 - version 3.3 - New Logo. - Exe compressed with UPX. - Minor fixes. - + 27 June 2006 - version 3.2 - Added multilanguage support for Delphi and C++Builder, it now supports English, French, German and Japanese IDEs. - + 15 June 2006 - version 3.1 - Added Environment Variables Overrides support, thanks to Wyk for implementing this. @@ -90,15 +98,15 @@ - Improved the "Intallable" directive, it is now possible to install a package that doesn't have components, this is useful when installing utility libraries, for example GraphicEx, GDI+, DirectX, etc. - + 27 February 2006 - version 3.0 - Added support for C++Builder 2006. - + 10 February 2006 - version 2.0 - Added support for BDS 2006. - Added support for $LIBSUFFIX package compiler directive. - Added DefaultInstallFolder and DefaultInstallIDE Ini key options. - Replaced the zip library for Abbrevia. - + 18 August 2005 - version 1.0 - Initial release. \ No newline at end of file diff --git a/Source/unit1.dfm b/Source/Form.Installer.dfm similarity index 87% rename from Source/unit1.dfm rename to Source/Form.Installer.dfm index 1b45323..f15a297 100644 --- a/Source/unit1.dfm +++ b/Source/Form.Installer.dfm @@ -1,7 +1,6 @@ -object Form1: TForm1 +object FormInstall: TFormInstall Left = 293 Top = 145 - BorderStyle = bsDialog Caption = 'Silverpoint MultiInstaller' ClientHeight = 378 ClientWidth = 495 @@ -21,123 +20,141 @@ object Form1: TForm1 Top = 60 Width = 495 Height = 265 - ActivePage = TabSheet1 + ActivePage = tshSelectComponents Align = alClient Style = tsFlatButtons TabOrder = 0 - object TabSheet1: TTabSheet - Caption = 'TabSheet1' + object tshSelectComponents: TTabSheet + Caption = 'tshSelectComponents' TabVisible = False - object Label1: TLabel + DesignSize = ( + 487 + 255) + object lblSelectComponents: TLabel Left = 8 Top = 8 Width = 276 Height = 13 + Anchors = [akLeft, akTop, akRight] Caption = 'You'#39're about to install the following component packages:' end - object CheckListBox1: TCheckListBox + object clbSelectComponents: TCheckListBox Left = 8 Top = 24 Width = 473 Height = 201 + Anchors = [akLeft, akTop, akRight, akBottom] Style = lbOwnerDrawVariable TabOrder = 0 - OnClickCheck = CheckListBox1ClickCheck - OnDrawItem = CheckListBox1DrawItem - OnMeasureItem = CheckListBox1MeasureItem + OnClickCheck = clbSelectComponentsClickCheck + OnDrawItem = clbSelectComponentsDrawItem + OnMeasureItem = clbSelectComponentsMeasureItem end - object CheckBox1: TCheckBox - Left = 8 + object chkGetFromGit: TCheckBox + Left = 231 Top = 231 Width = 249 Height = 17 + Anchors = [akLeft, akBottom] Caption = 'Get files from GIT repository when available' - Checked = True - State = cbChecked + Enabled = False TabOrder = 1 end + object chkSelectAllNone: TCheckBox + Left = 8 + Top = 231 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Select all/none' + TabOrder = 2 + OnClick = chkSelectAllNoneClick + end end - object TabSheet2: TTabSheet - Caption = 'TabSheet2' + object tshSelectIde: TTabSheet + Caption = 'tshSelectIde' ImageIndex = 1 TabVisible = False - object Label2: TLabel + DesignSize = ( + 487 + 255) + object lblInstallfolder: TLabel Left = 8 Top = 16 - Width = 323 + Width = 358 Height = 13 + Anchors = [akLeft, akTop, akRight] Caption = 'Select a destination directory to install all the component pack' + - 'ages:' + 'age sources:' end - object InstallFolderEdit: TEdit + object edtInstallFolder: TEdit Left = 8 Top = 42 Width = 393 Height = 21 + Anchors = [akLeft, akTop, akRight] TabOrder = 0 end - object ButtonBrowse: TButton + object btnInstallFolder: TButton Left = 408 Top = 40 Width = 75 Height = 25 Action = aBrowse + Anchors = [akTop, akRight] TabOrder = 1 end - object RadioGroup1: TRadioGroup + object rgSelectIde: TRadioGroup Left = 8 Top = 80 Width = 473 Height = 171 - Caption = ' ' + Anchors = [akLeft, akTop, akRight, akBottom] + Caption = ' Select target IDE' Columns = 2 - Enabled = False TabOrder = 2 end - object CompileCheckbox: TCheckBox - Left = 20 - Top = 78 - Width = 195 - Height = 17 - Caption = 'Compile packages and install on IDE' - TabOrder = 3 - OnClick = CompileCheckboxClick - end end - object TabSheet3: TTabSheet - Caption = 'TabSheet3' + object tshInstallation: TTabSheet + Caption = 'tshInstallation' ImageIndex = 2 TabVisible = False - object Label3: TLabel + DesignSize = ( + 487 + 255) + object lblInstallation: TLabel Left = 8 Top = 8 Width = 74 Height = 13 + Anchors = [akLeft, akTop, akRight] Caption = 'Installation log:' end - object FinishLabel: TLabel + object lblInstallationFinished: TLabel Left = 8 Top = 238 Width = 427 Height = 13 + Anchors = [akLeft, akRight, akBottom] Caption = 'Setup has finished installing the components on your computer. C' + 'lick Finish to exit Setup.' Visible = False end - object LogMemo: TMemo + object memInstallationLog: TMemo Left = 8 Top = 32 Width = 473 Height = 193 + Anchors = [akLeft, akTop, akRight, akBottom] ReadOnly = True ScrollBars = ssBoth TabOrder = 0 end end end - object Panel1: TPanel + object pnlBottom: TPanel Left = 0 Top = 325 Width = 495 @@ -150,39 +167,43 @@ object Form1: TForm1 DesignSize = ( 495 53) - object Bevel2: TBevel + object bvlBottom: TBevel Left = 162 Top = 0 Width = 322 Height = 9 + Anchors = [akLeft, akRight, akBottom] Shape = bsBottomLine end - object PaintBoxLabel: TPaintBox + object pbxVersionInfo: TPaintBox Left = 15 Top = 0 - Width = 144 + Width = 150 Height = 14 - OnClick = PaintBoxLabelClick - OnPaint = PaintBoxLabelPaint + Anchors = [akLeft, akBottom] + OnClick = pbxVersionInfoClick + OnPaint = pbxVersionInfoPaint end - object Button1: TButton + object btnSaveLog: TButton Left = 315 Top = 18 Width = 75 Height = 25 Action = aSaveLog + Anchors = [akRight, akBottom] TabOrder = 4 end - object ButtonFinish: TButton + object btnFinish: TButton Left = 410 Top = 18 Width = 75 Height = 25 Action = aFinish + Anchors = [akRight, akBottom] TabOrder = 3 end - object ButtonNext: TButton - Left = 311 + object btnNext: TButton + Left = 315 Top = 18 Width = 75 Height = 25 @@ -190,25 +211,27 @@ object Form1: TForm1 Anchors = [akRight, akBottom] TabOrder = 0 end - object ButtonBack: TButton + object btnBack: TButton Left = 235 Top = 18 Width = 75 Height = 25 Action = aBack + Anchors = [akRight, akBottom] Enabled = False TabOrder = 1 end - object ButtonCancel: TButton + object btnCancel: TButton Left = 410 Top = 18 Width = 75 Height = 25 Action = aCancel + Anchors = [akRight, akBottom] TabOrder = 2 end end - object Panel2: TPanel + object pnlTop: TPanel Left = 0 Top = 0 Width = 495 @@ -218,11 +241,15 @@ object Form1: TForm1 Color = clWhite ParentBackground = False TabOrder = 2 - object LabelTitle: TLabel + DesignSize = ( + 495 + 60) + object lblTitle: TLabel Left = 8 Top = 15 Width = 425 Height = 29 + Anchors = [akLeft, akTop, akRight] AutoSize = False Caption = 'Title' Font.Charset = ANSI_CHARSET @@ -234,7 +261,7 @@ object Form1: TForm1 Layout = tlCenter WordWrap = True end - object Bevel1: TBevel + object bvlTop: TBevel Left = 0 Top = 51 Width = 495 @@ -242,11 +269,12 @@ object Form1: TForm1 Align = alBottom Shape = bsBottomLine end - object Image1: TImage + object imgLogo: TImage Left = 442 Top = 5 Width = 48 Height = 48 + Anchors = [akTop, akRight] AutoSize = True Picture.Data = { 07544269746D6170361B0000424D361B00000000000036000000280000003000 diff --git a/Source/Form.Installer.pas b/Source/Form.Installer.pas new file mode 100644 index 0000000..0c3f2d7 --- /dev/null +++ b/Source/Form.Installer.pas @@ -0,0 +1,547 @@ +unit Form.Installer; + +interface + +{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation + +{$IFDEF DEBUG} +{$DEFINE SPDEBUGMODE} // Uncomment to debug +{$ENDIF} + + +uses + Windows, + Messages, + Classes, + Graphics, + Controls, + Forms, + Dialogs, + ComCtrls, + StdCtrls, + ExtCtrls, + ActnList, + CheckLst, + Actions, + SpComponentInstaller; + +type + TFormInstall = class(TForm) + PageControl1: TPageControl; + tshSelectComponents: TTabSheet; + tshSelectIde: TTabSheet; + tshInstallation: TTabSheet; + pnlTop: TPanel; + pnlBottom: TPanel; + btnNext: TButton; + btnBack: TButton; + btnCancel: TButton; + btnFinish: TButton; + btnSaveLog: TButton; + btnInstallFolder: TButton; + lblTitle: TLabel; + lblSelectComponents: TLabel; + clbSelectComponents: TCheckListBox; + chkGetFromGit: TCheckBox; + edtInstallFolder: TEdit; + lblInstallfolder: TLabel; + ActionList1: TActionList; + aBack: TAction; + aNext: TAction; + aCancel: TAction; + aBrowse: TAction; + aSaveLog: TAction; + aFinish: TAction; + rgSelectIde: TRadioGroup; + lblInstallation: TLabel; + lblInstallationFinished: TLabel; + bvlTop: TBevel; + memInstallationLog: TMemo; + bvlBottom: TBevel; + pbxVersionInfo: TPaintBox; + imgLogo: TImage; + Timer1: TTimer; + SaveDialog1: TSaveDialog; + chkSelectAllNone: TCheckBox; + procedure aBrowseExecute(Sender: TObject); + procedure aBackExecute(Sender: TObject); + procedure aCancelExecute(Sender: TObject); + procedure aFinishExecute(Sender: TObject); + procedure aNextExecute(Sender: TObject); + procedure aSaveLogExecute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure clbSelectComponentsDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure clbSelectComponentsMeasureItem(Control: TWinControl; + Index: Integer; var Height: Integer); + procedure clbSelectComponentsClickCheck(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure pbxVersionInfoPaint(Sender: TObject); + procedure pbxVersionInfoClick(Sender: TObject); + procedure chkSelectAllNoneClick(Sender: TObject); + private + FAppPath : string; + FIniPath : string; + FAutoStart: Boolean; + FInstaller: TSpMultiInstaller; + + function ChangePage(Next: Boolean): Boolean; + function Install: Boolean; + function ValidateCheckListBox: Boolean; + + procedure CloseDelphi; + procedure CreateInstaller; + procedure FillCheckListBox; + procedure FillRadioGroup; + procedure ShowNavigationActions(AFinalStep: Boolean); + procedure WMDROPFILES(var Msg: TWMDropFiles); message WM_DROPFILES; + end; + +var + FormInstall: TFormInstall; + +implementation + +{$R *.dfm} + + +uses + Winapi.ShellAPI, + System.StrUtils, + System.SysUtils, + System.UITypes; + +const + rvMultiInstallerVersion = 'Silverpoint MultiInstaller 3.6.0'; + rvMultiInstallerLink = 'http://www.silverpointdevelopment.com'; + rvSetupIni = 'Setup.Ini'; + crIDC_HAND = 32649; + +resourcestring + SWelcomeTitle = 'Welcome to the Silverpoint MultiInstaller Setup Wizard'; + SDestinationTitle = 'Select Destination Folder'; + SInstallingTitle = 'Installing...'; + SFinishTitle = 'Completing the MultiInstaller Setup Wizard'; + + SCloseDelphi = 'Close Delphi to continue.'; + SErrorLabel = 'There were errors found in the setup, check the log.'; + SErrorInvalidBasePath = 'The directory doesn''t exist.'; + +//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM +{ Form UI } + +procedure TFormInstall.FormCreate(Sender: TObject); +var + LAutoStart: string; + LSetupIni : string; +begin + Screen.Cursors[crIDC_HAND] := LoadCursor(0, IDC_HAND); + pbxVersionInfo.Cursor := crIDC_HAND; + FAppPath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)); + + DragAcceptFiles(Handle, True); + + PageControl1.ActivePageIndex := 0; + lblTitle.Caption := SWelcomeTitle; + SaveDialog1.InitialDir := FAppPath; + + // Allow to turn the autostart off via command line. Default:on + if FindCmdLineSwitch('A', LAutoStart) then + FAutoStart := MatchText(LAutoStart, ['Yes', 'True', '1']) + else + FAutoStart := True; + + // Allow to pass the ini file via command line + if FindCmdLineSwitch('I', LSetupIni) then + FIniPath := LSetupIni + else + FIniPath := FAppPath + rvSetupIni; + CreateInstaller; + +{$IFDEF SPDEBUGMODE} + ReportMemoryLeaksOnShutdown := True; +{$ENDIF} +end; + +procedure TFormInstall.FormDestroy(Sender: TObject); +begin + FInstaller.Free; +end; + +procedure TFormInstall.FormShow(Sender: TObject); +begin + CloseDelphi; + + if DirectoryExists(FInstaller.ComponentPackages.DefaultInstallFolder) then + begin + edtInstallFolder.Text := FInstaller.ComponentPackages.DefaultInstallFolder; + if FAutoStart then + begin + PageControl1.ActivePageIndex := PageControl1.PageCount - 1; + Timer1.Enabled := True; // Delay it a little for UI responsiveness + end; + end; +end; + +procedure TFormInstall.Timer1Timer(Sender: TObject); +begin + Timer1.Enabled := False; + Install; +end; + +function TFormInstall.ChangePage(Next: Boolean): Boolean; +var + I, C: Integer; +begin + Result := False; + I := PageControl1.ActivePageIndex; + C := PageControl1.PageCount - 1; + + if Next then + begin + if I = C then + Exit + else + if I = 1 then + if not DirectoryExists(edtInstallFolder.Text) then + begin + MessageDlg(SErrorInvalidBasePath, mtWarning, [mbOK], 0); + Exit; + end; + end + else + if I = 0 then + Exit; + + Result := True; + if Next then + Inc(I) + else + Dec(I); + PageControl1.ActivePageIndex := I; + + btnBack.Enabled := I > 0; + case I of + 0: + begin + lblTitle.Caption := SWelcomeTitle; + CreateInstaller; + end; + 1: + lblTitle.Caption := SDestinationTitle; + 2: + begin + lblTitle.Caption := SInstallingTitle; + Timer1.Enabled := True; // Delay it a little for UI responsiveness + end; + else + lblTitle.Caption := ''; + end; +end; + +procedure TFormInstall.chkSelectAllNoneClick(Sender: TObject); +var + I: Integer; +begin + for I := 0 to clbSelectComponents.Count - 1 do + clbSelectComponents.Checked[I] := chkSelectAllNone.Checked; +end; + +procedure TFormInstall.CreateInstaller; +var + I: Integer; +begin + FreeAndNil(FInstaller); + + FInstaller := TSpMultiInstaller.Create(FIniPath); + FillCheckListBox; + FillRadioGroup; + ValidateCheckListBox; + + // Enable Get from Git only when at least one component has a Git URL + for I := 0 to FInstaller.ComponentPackages.Count - 1 do + if not FInstaller.ComponentPackages[I].Git.IsEmpty then + begin + chkGetFromGit.Enabled := True; + chkGetFromGit.Checked := True; + Break; + end; + + if DirectoryExists(FInstaller.ComponentPackages.DefaultInstallFolder) then + edtInstallFolder.Text := FInstaller.ComponentPackages.DefaultInstallFolder; +end; + +procedure TFormInstall.FillCheckListBox; +var + I, G, P: Integer; +begin + clbSelectComponents.Clear; + clbSelectComponents.ItemIndex := -1; + + for I := 0 to FInstaller.ComponentPackages.Count - 1 do + begin + P := -1; + G := FInstaller.ComponentPackages[I].GroupIndex; + if G > 0 then + begin + P := clbSelectComponents.Items.IndexOfObject(Pointer(G)); + if P > -1 then + clbSelectComponents.Items[P] := clbSelectComponents.Items[P] + sLineBreak + + FInstaller.ComponentPackages[I].Name; + end; + + if P = -1 then + begin + P := clbSelectComponents.Items.AddObject(FInstaller.ComponentPackages[I].Name, Pointer(G)); + clbSelectComponents.Checked[P] := True; + if FInstaller.ComponentPackages[I].Git <> '' then + clbSelectComponents.Items[P] := clbSelectComponents.Items[P] + sLineBreak + + 'GIT: ' + FInstaller.ComponentPackages[I].Git; + end; + end; + chkSelectAllNone.Checked := True; +end; + +procedure TFormInstall.FillRadioGroup; +var + IDE: TSpIDEType; +begin + rgSelectIde.Items.Clear; + rgSelectIde.ItemIndex := -1; + + for IDE := Low(TSpIDEType) to High(TSpIDEType) do + if IDE >= FInstaller.ComponentPackages.MinimumIDE then + if TSpDelphiIDE.Installed(IDE) then + begin + rgSelectIde.Items.AddObject(IDETypes[IDE].IDEName, Pointer(Ord(IDE))); + if IDE = FInstaller.ComponentPackages.DefaultInstallIDE then + rgSelectIde.ItemIndex := rgSelectIde.Items.Count - 1; + end; + + if rgSelectIde.ItemIndex = -1 then + rgSelectIde.ItemIndex := rgSelectIde.Items.Count - 1; +end; + +function TFormInstall.ValidateCheckListBox: Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to clbSelectComponents.Count - 1 do + if clbSelectComponents.Checked[I] then + begin + Result := True; + Break; + end; + + btnNext.Enabled := Result; +end; + +procedure TFormInstall.WMDROPFILES(var Msg: TWMDropFiles); +var + LDropHandle : HDROP; + FileNameLength: Integer; + LCount : Integer; + LFileName : string; + LFileExt : string; +begin + inherited; + + LDropHandle := Msg.Drop; + LCount := DragQueryFile(LDropHandle, $FFFFFFFF, nil, 0); + + try + if LCount = 1 then + begin + FileNameLength := DragQueryFile(LDropHandle, 0, nil, 0); + SetLength(LFileName, FileNameLength); + DragQueryFile(LDropHandle, 0, PChar(LFileName), FileNameLength + 1); + LFileExt := ExtractFileExt(LFileName); + if SameText(LFileExt, '.ini') then + begin + FIniPath := LFileName; + CreateInstaller; + end; + end; + + finally + DragFinish(LDropHandle); + Msg.Result := 0; + end; +end; + +procedure TFormInstall.clbSelectComponentsClickCheck(Sender: TObject); +begin + ValidateCheckListBox; +end; + +procedure TFormInstall.clbSelectComponentsMeasureItem(Control: TWinControl; + Index: Integer; var Height: Integer); +var + R: TRect; +begin + if Index > -1 then + Height := DrawText(clbSelectComponents.Canvas.Handle, PChar(clbSelectComponents.Items[Index]), -1, R, DT_CALCRECT) + 4; +end; + +procedure TFormInstall.clbSelectComponentsDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + if Index > -1 then + begin + clbSelectComponents.Canvas.FillRect(Rect); + OffsetRect(Rect, 8, 2); + DrawText(clbSelectComponents.Canvas.Handle, PChar(clbSelectComponents.Items[Index]), -1, Rect, 0); + end; +end; + +procedure TFormInstall.pbxVersionInfoPaint(Sender: TObject); +var + C: TCanvas; +begin + C := pbxVersionInfo.Canvas; + C.Brush.Style := bsClear; + C.Font.Color := clBtnHighlight; + C.TextOut(1, 1, rvMultiInstallerVersion); + C.Font.Color := clBtnShadow; + C.TextOut(0, 0, rvMultiInstallerVersion); +end; + +procedure TFormInstall.pbxVersionInfoClick(Sender: TObject); +begin + SpOpenLink(rvMultiInstallerLink); +end; + +procedure TFormInstall.ShowNavigationActions(AFinalStep: Boolean); +begin + aFinish.Visible := AFinalStep; + aSaveLog.Visible := AFinalStep; + aNext.Visible := not AFinalStep; + aCancel.Visible := not AFinalStep; +end; + + +//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM +{$REGION 'Actions'} + + +procedure TFormInstall.aBackExecute(Sender: TObject); +begin + ChangePage(False); + ShowNavigationActions(False); + lblInstallationFinished.Visible := False; +end; + +procedure TFormInstall.aNextExecute(Sender: TObject); +begin + ChangePage(True); +end; + +procedure TFormInstall.aCancelExecute(Sender: TObject); +begin + Close; +end; + +procedure TFormInstall.aFinishExecute(Sender: TObject); +begin + Close; +end; + +procedure TFormInstall.aSaveLogExecute(Sender: TObject); +begin + if SaveDialog1.Execute then + memInstallationLog.Lines.SaveToFile(SaveDialog1.FileName); +end; + +procedure TFormInstall.aBrowseExecute(Sender: TObject); +var + D: string; +begin + if SpSelectDirectory('', D) then + edtInstallFolder.Text := D; +end; + +{$ENDREGION 'Actions'} + +//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM + +{ Install } + +procedure TFormInstall.CloseDelphi; +var + Cancel: Boolean; +begin +{$IFDEF SPDEBUGMODE} + Exit; +{$ENDIF} + Cancel := False; + while not Cancel and ((FindWindow('TAppBuilder', nil) <> 0) or (FindWindow('TAppBuilder', nil) <> 0)) do + Cancel := MessageDlg(SCloseDelphi, mtWarning, [mbOK, mbCancel], 0) = mrCancel; + if Cancel then + Close; +end; + +function TFormInstall.Install: Boolean; +var + I, J, G: Integer; + IDE : TSpIDEType; +begin + Result := False; + CloseDelphi; + + // Get IDE version + IDE := ideNone; + I := rgSelectIde.ItemIndex; + if (I > -1) and Assigned(rgSelectIde.Items.Objects[I]) then + IDE := TSpIDEType(rgSelectIde.Items.Objects[I]); + + // Delete unchecked components from the ComponentPackages list + for I := 0 to clbSelectComponents.Count - 1 do + if not clbSelectComponents.Checked[I] then + begin + G := Integer(clbSelectComponents.Items.Objects[I]); + for J := FInstaller.ComponentPackages.Count - 1 downto 0 do + if (G > 0) and (FInstaller.ComponentPackages[J].GroupIndex = G) then + FInstaller.ComponentPackages.Delete(J) + else + if clbSelectComponents.Items[I].Contains(FInstaller.ComponentPackages[J].Name) then + FInstaller.ComponentPackages.Delete(J); + end; + + // Prioritize GIT over ZIP + if chkGetFromGit.Checked then + begin + for J := 0 to FInstaller.ComponentPackages.Count - 1 do + if not FInstaller.ComponentPackages[J].Git.IsEmpty then + FInstaller.ComponentPackages[J].ZipFile := ''; + end; + + ShowNavigationActions(True); + aBack.Enabled := False; + aFinish.Enabled := False; + aSaveLog.Enabled := False; + lblInstallationFinished.Visible := False; + + Application.ProcessMessages; + try + // Check, Unzip, Patch, Compile, Install + if FInstaller.Install(FAppPath, edtInstallFolder.Text, IDE, memInstallationLog.Lines) then + Result := True; + finally + lblTitle.Caption := SFinishTitle; + aBack.Enabled := True; + aFinish.Enabled := True; + aSaveLog.Enabled := True; + lblInstallationFinished.Visible := True; + if not Result then + begin + lblInstallationFinished.Font.Color := clRed; + lblInstallationFinished.Caption := SErrorLabel; + end; + lblInstallationFinished.Visible := True; + end; +end; + +end. diff --git a/Source/MultiInstaller.dpr b/Source/MultiInstaller.dpr index 951a3cf..2b78306 100644 --- a/Source/MultiInstaller.dpr +++ b/Source/MultiInstaller.dpr @@ -2,13 +2,13 @@ program MultiInstaller; uses Forms, - unit1 in 'unit1.pas' {Form1}; + Form.Installer in 'Form.Installer.pas' {FormInstall}; {$R *.res} begin Application.Initialize; Application.MainFormOnTaskbar := True; - Application.CreateForm(TForm1, Form1); + Application.CreateForm(TFormInstall, FormInstall); Application.Run; end. diff --git a/Source/MultiInstaller.dproj b/Source/MultiInstaller.dproj index e43afa7..427923f 100644 --- a/Source/MultiInstaller.dproj +++ b/Source/MultiInstaller.dproj @@ -2,14 +2,15 @@ {EBF09947-4C9C-4019-AB2C-5AC10A4CEF07} MultiInstaller.dpr - Debug + Release DCC32 - 20.1 + 20.3 True Application VCL Win32 1 + MultiInstaller true @@ -126,8 +127,8 @@ MainSource - -
Form1
+ +
FormInstall
 Base @@ -179,8 +180,8 @@ - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server diff --git a/Source/MultiInstaller.res b/Source/MultiInstaller.res index c61c42a..35d5ad7 100644 Binary files a/Source/MultiInstaller.res and b/Source/MultiInstaller.res differ diff --git a/Source/SpComponentInstaller.pas b/Source/SpComponentInstaller.pas index 4c85f10..8e577c6 100644 --- a/Source/SpComponentInstaller.pas +++ b/Source/SpComponentInstaller.pas @@ -33,29 +33,32 @@ interface -{$WARN SYMBOL_PLATFORM OFF} -{$WARN UNIT_PLATFORM OFF} -{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation +{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation {$R 'SpComponentInstallerRes.res'} // Has EmptyResourceFile.res file as a resource used by TSpDelphiDPKFile.CreateAndCopyEmptyResIfNeeded uses - Windows, Messages, SysUtils, Classes, Forms, Contnrs, Generics.Collections; + System.Classes, + System.Generics.Collections; resourcestring - SLogStartUnzip = '=========================================' + #13#10 + - 'Unzipping - Cloning' + #13#10 + - '========================================='; - SLogStartExecute = '=========================================' + #13#10 + - 'Executing patches' + #13#10 + - '========================================='; - SLogStartCompile = '=========================================' + #13#10 + - 'Compiling and installing:' + #13#10 + - '%s' + #13#10 + - '========================================='; - SLogEnd = '=========================================' + #13#10 + - 'Finished' + #13#10 + - '========================================='; + SLogStartUnzip = + '=========================================' + sLineBreak + + 'Unzipping - Cloning' + sLineBreak + + '========================================='; + SLogStartExecute = + '=========================================' + sLineBreak + + 'Executing patches' + sLineBreak + + '========================================='; + SLogStartCompile = + '=========================================' + sLineBreak + + 'Compiling and installing:' + sLineBreak + + '%s' + sLineBreak + + '========================================='; + SLogEnd = + '=========================================' + sLineBreak + + 'Finished' + sLineBreak + + '========================================='; SLogInvalidPath = 'Error: %s doesn''t exist.'; SLogInvalidIDE = 'Error: %s is not installed.'; @@ -65,33 +68,28 @@ interface SLogCorruptedZip = 'Error: %s is corrupted.'; SLogGitCloneFailed = 'Error: in Git clone %s'; SLogGitNotInstalled = 'Error: Git not installed'; + SLogErrorNoPackage = 'Error: No package defined for %s'; SLogErrorCopying = 'Error copying %s to %s'; SLogErrorDeleting = 'Error deleting %s'; SLogErrorExecuting = 'Error executing %s'; SLogErrorCompiling = 'Error compiling %s'; + SLogErrorRegistering = 'Error registering %s'; - SLogCopying = 'Copying:' + #13#10 + ' %s' + #13#10 + 'To:' + #13#10 + ' %s'; - SLogExecuting = 'Executing:' + #13#10 + ' %s'; - SLogExtracting = 'Extracting:' + #13#10 + ' %s' + #13#10 + 'To:' + #13#10 + ' %s'; - SLogGitCloning = 'Git cloning:' + #13#10 + ' %s' + #13#10 + 'To:' + #13#10 + ' %s'; - SLogCompiling = 'Compiling Package: %s'; - SLogInstalling = 'Installing Package: %s'; - SLogFinished = 'All the component packages have been successfully installed.' + #13#10 + 'Elapsed time: %f secs.'; + SLogCopying = 'Copying:' + sLineBreak + ' %s' + sLineBreak + 'To:' + sLineBreak + ' %s'; + SLogExecuting = 'Executing:' + sLineBreak + ' %s'; + SLogExtracting = 'Extracting:' + sLineBreak + ' %s' + sLineBreak + 'To:' + sLineBreak + ' %s'; + SLogGitCloning = 'Git cloning:' + sLineBreak + ' %s' + sLineBreak + 'To:' + sLineBreak + ' %s'; + SLogCompiling = 'Compiling %s package for %s' + sLineBreak + 'Package: %s'; + SLogInstalling = 'Installing %s package for %s' + sLineBreak + 'Package: %s'; + SLogFinished = 'All the component packages have been successfully installed.' + sLineBreak + 'Elapsed time: %f secs.'; - SGitCloneCommand = 'GIT.EXE clone --verbose --progress %s %s'; + SGitCloneCommand = 'GIT.EXE clone --verbose --progress "%s" "%s"'; SGitIsInstalledCommand = 'GIT.EXE --version'; type TSpIDEType = ( // [IDE-Change-Update] ideNone, // - ideDelphi7, // D7 - ideDelphi2005, // D9 - ideDelphi2006, // D10 - ideDelphi2007, // D11 - ideDelphi2009, // D12 - ideDelphi2010, // D14 - ideDelphiXE, // D15 ideDelphiXE2, // D16 ideDelphiXE3, // D17 ideDelphiXE4, // D18 @@ -105,8 +103,9 @@ interface ideDelphiRio, // D26 ideDelphiSydney, // D27 ideDelphiAlexandria, // D28 - ideDelphiAthens // D29 - ); + ideDelphiAthens, // D29 + ideDelphiFlorence // D37 + ); TSpIDETypeRec = record IDEVersion: string; @@ -119,13 +118,6 @@ TSpIDETypeRec = record // [IDE-Change-Update] IDETypes: array [TSpIDEType] of TSpIDETypeRec = ( (IDEVersion: 'None'; IDEName: 'None'; IDERegistryPath: 'None'; IDERADStudioVersion: ''), - (IDEVersion: 'D7'; IDEName: 'Delphi 7'; IDERegistryPath: 'SOFTWARE\Borland\Delphi\7.0'; IDERADStudioVersion: ''), - (IDEVersion: 'D9'; IDEName: 'Delphi 2005'; IDERegistryPath: 'SOFTWARE\Borland\BDS\3.0'; IDERADStudioVersion: '3.0'), - (IDEVersion: 'D10'; IDEName: 'Developer Studio 2006'; IDERegistryPath: 'SOFTWARE\Borland\BDS\4.0'; IDERADStudioVersion: '4.0'), - (IDEVersion: 'D11'; IDEName: 'RAD Studio 2007'; IDERegistryPath: 'SOFTWARE\Borland\BDS\5.0'; IDERADStudioVersion: '5.0'), - (IDEVersion: 'D12'; IDEName: 'RAD Studio 2009'; IDERegistryPath: 'SOFTWARE\CodeGear\BDS\6.0'; IDERADStudioVersion: '6.0'), - (IDEVersion: 'D14'; IDEName: 'RAD Studio 2010'; IDERegistryPath: 'SOFTWARE\CodeGear\BDS\7.0'; IDERADStudioVersion: '7.0'), - (IDEVersion: 'D15'; IDEName: 'RAD Studio XE'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\8.0'; IDERADStudioVersion: '8.0'), (IDEVersion: 'D16'; IDEName: 'RAD Studio XE2'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\9.0'; IDERADStudioVersion: '9.0'), (IDEVersion: 'D17'; IDEName: 'RAD Studio XE3'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\10.0'; IDERADStudioVersion: '10.0'), (IDEVersion: 'D18'; IDEName: 'RAD Studio XE4'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\11.0'; IDERADStudioVersion: '11.0'), @@ -139,17 +131,35 @@ TSpIDETypeRec = record (IDEVersion: 'D26'; IDEName: 'RAD Studio 10.3 Rio'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\20.0'; IDERADStudioVersion: '20.0'), (IDEVersion: 'D27'; IDEName: 'RAD Studio 10.4 Sydney'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\21.0'; IDERADStudioVersion: '21.0'), (IDEVersion: 'D28'; IDEName: 'RAD Studio 11 Alexandria'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\22.0'; IDERADStudioVersion: '22.0'), - (IDEVersion: 'D29'; IDEName: 'RAD Studio 12 Athens'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\23.0'; IDERADStudioVersion: '23.0') - ); + (IDEVersion: 'D29'; IDEName: 'RAD Studio 12 Athens'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\23.0'; IDERADStudioVersion: '23.0'), + (IDEVersion: 'D37'; IDEName: 'RAD Studio 13 Florence'; IDERegistryPath: 'SOFTWARE\Embarcadero\BDS\37.0'; IDERADStudioVersion: '37.0') + ); type TSpIDEPersonality = (persDelphiWin32, persDelphiNET, persCPPBuilder); + TSpPlatform = (pltWin32, pltWin64); + + TSpPlatformHelper = record helper for TSpPlatform + private + function GetDccConfig: string; + function GetDccPath: string; + function GetKnownPackages: string; + function GetName: string; + function GetRegKey: string; + public + property DccConfig : string read GetDccConfig; + property DccPath : string read GetDccPath; + property KnownPackages: string read GetKnownPackages; + property Name : string read GetName; + property RegKey : string read GetRegKey; + end; TSpDelphiIDE = class private class var FCachedMacrosCommaDelimited: string; - class var FCachedMacrosIDE: TSpIDEType; - class procedure GetMacros(IDE: TSpIDEType; NamesAndValues: TStringList); + class var FCachedMacrosIDE : TSpIDEType; + class var FCachedMacrosPlatform : TSpPlatform; + class procedure GetMacros(IDE: TSpIDEType; APlatform: TSpPlatform; NamesAndValues: TStringList); public // IDE class function Installed(IDE: TSpIDEType): Boolean; @@ -160,47 +170,17 @@ TSpDelphiIDE = class // Path class function GetIDEDir(IDE: TSpIDEType): string; - class function GetDCC32Filename(IDE: TSpIDEType): string; - class function GetBPLOutputDir(IDE: TSpIDEType): string; - class function GetDCPOutputDir(IDE: TSpIDEType): string; + class function GetDCCFilename(IDE: TSpIDEType; APlatform: TSpPlatform): string; + class function GetBPLOutputDir(IDE: TSpIDEType; APlatform: TSpPlatform): string; + class function GetDCPOutputDir(IDE: TSpIDEType; APlatform: TSpPlatform): string; // Macros class function ReadEnvironmentProj(IDE: TSpIDEType; NamesAndValues: TStringList): Boolean; - class function ExpandMacros(S: string; IDE: TSpIDEType): string; + class function ExpandMacros(S: string; IDE: TSpIDEType; APlatform: TSpPlatform): string; // SearchPath - class function GetSearchPath(IDE: TSpIDEType; CPPBuilderPath: Boolean): string; - class procedure AddToSearchPath(SourcesL: TStrings; IDE: TSpIDEType); - end; - - TSpDelphiDPKFile = class - private - FDPKFilename: string; - FBPLFilename: string; - FExists: Boolean; - FOnlyRuntime: Boolean; - FOnlyDesigntime: Boolean; - FDescription: string; - FLibSuffix: string; - FIDEVersion: TSpIDEType; - procedure CreateAndCopyEmptyResIfNeeded; - function RegisterPackage(Log: TStrings): Boolean; - public - property DPKFilename: string read FDPKFilename; - property BPLFilename: string read FBPLFilename; - property Exists: Boolean read FExists; - property OnlyRuntime: Boolean read FOnlyRuntime; - property OnlyDesigntime : Boolean read FOnlyDesigntime; - property Description: string read FDescription; - property LibSuffix: string read FLibSuffix; - property IDEVersion: TSpIDEType read FIDEVersion; - constructor Create(const Filename: string; IDE: TSpIDEType); virtual; - function CompilePackage(DCC: string; SourcesL, IncludesL, Log: TStrings; TempDir: string = ''): Boolean; - end; - - TSpDelphiDPKFilesList = class(TObjectList) - public - procedure Sort; reintroduce; + class function GetSearchPath(IDE: TSpIDEType; APlatform: TSpPlatform; CPPBuilderPath: Boolean): string; + class procedure AddToSearchPath(SourcesL: TStrings; IDE: TSpIDEType; APlatform: TSpPlatform); end; TSpActionType = (satNone, satCopy, satCopyRun, satRun); @@ -209,12 +189,12 @@ TSpDelphiDPKFilesList = class(TObjectList) TSpExecuteEntry = class private - FAction: TSpActionType; - FOrigin: string; - FDestination: string; + FAction : TSpActionType; + FOrigin : string; + FDestination : string; public - property Action: TSpActionType read FAction write FAction; - property Origin: string read FOrigin write FOrigin; + property Action : TSpActionType read FAction write FAction; + property Origin : string read FOrigin write FOrigin; property Destination: string read FDestination write FDestination; end; @@ -241,9 +221,9 @@ TSpComponentPackage = class TSpComponentPackageList = class(TObjectList) private - FDefaultInstallIDE: TSpIDEType; + FDefaultInstallIDE : TSpIDEType; FDefaultInstallFolder: string; - FMinimumIDE: TSpIDEType; + FMinimumIDE : TSpIDEType; public procedure LoadFromIni(Filename: string); function ExtractAllZips(Source, Destination: string; Log: TStrings): Boolean; @@ -257,7 +237,7 @@ TSpComponentPackageList = class(TObjectList) TSpMultiInstaller = class protected FComponentPackages: TSpComponentPackageList; - FInstalling: Boolean; + FInstalling : Boolean; public constructor Create(IniFilename: string); virtual; destructor Destroy; override; @@ -268,7 +248,7 @@ TSpMultiInstaller = class { Misc } procedure SpOpenLink(URL: string); function SpStringSearch(S, SubStr: string; Delimiter: Char = ';'): Boolean; -procedure SpWriteLog(Log: TStrings; ResourceS, Arg1: string; Arg2: string = ''); +procedure SpWriteLog(Log: TStrings; const AMessage: string; const AParams: array of TVarRec); { Files } function SpGetParameter(const ParamName: string; out ParamValue: string): Boolean; @@ -298,34 +278,106 @@ function SpStringToActionType(S: string): TSpActionType; implementation uses - ActiveX, ShellApi, ShlObj, IniFiles, Registry, + Winapi.ShellAPI, + Winapi.ShlObj, + Winapi.Windows, + System.IniFiles, + System.Win.Registry, + System.IOUtils, + System.StrUtils, + System.SysUtils, System.Zip, // Abbrevia is not needed anymore - Vcl.FileCtrl, System.IOUtils, StrUtils, Generics.Defaults, - Xml.XMLIntf, Xml.XMLDoc, themes; + System.Generics.Defaults, + Vcl.FileCtrl, + Vcl.Forms, + Xml.XMLIntf, + Xml.XMLDoc; const - rvCount = 'Count'; - rvPackageIniSectionPrefix = 'Package -'; - rvName = 'Name'; - rvZip = 'Zip'; - rvGit = 'Git'; - rvFolder = 'Folder'; - rvSearchPath = 'SearchPath'; - rvGroupIndex = 'GroupIndex'; - rvIncludes = 'Includes'; - rvInstallable = 'Installable'; - rvExecuteIniPrefix = 'Execute'; - rvBaseFolder = '$BaseFolder'; - rvOptionsIniSection = 'Options'; - rvDefaultInstallIDE = 'DefaultInstallIDE'; - rvDefaultInstallFolder = 'DefaultInstallFolder'; - rvMinimumIDE = 'MinimumIDEVersion'; + rvCount = 'Count'; + rvPackageIniSectionPrefix = 'Package -'; + rvName = 'Name'; + rvZip = 'Zip'; + rvGit = 'Git'; + rvFolder = 'Folder'; + rvSearchPath = 'SearchPath'; + rvGroupIndex = 'GroupIndex'; + rvIncludes = 'Includes'; + rvInstallable = 'Installable'; + rvExecuteIniPrefix = 'Execute'; + rvBaseFolder = '$BaseFolder'; + rvOptionsIniSection = 'Options'; + rvDefaultInstallIDE = 'DefaultInstallIDE'; + rvDefaultInstallFolder = 'DefaultInstallFolder'; + rvMinimumIDE = 'MinimumIDEVersion'; ActionTypes: array [TSpActionType] of string = ('none', 'copy', 'copyandrun', 'run'); IDEPersonalityRegNameTypes: array [TSpIDEPersonality] of string = ('Delphi.Win32', 'Delphi.NET', 'BCB'); +type + TSpDelphiDPKFile = class + private + FDPKFilename : string; + FBPLFilename : string; + FExists : Boolean; + FOnlyRuntime : Boolean; + FOnlyDesigntime: Boolean; + FDescription : string; + FLibSuffix : string; + FIDEVersion : TSpIDEType; + function GetPackageType: string; + procedure CreateAndCopyEmptyResIfNeeded; + function RegisterPackage(APlatform: TSpPlatform; Log: TStrings): Boolean; + property PackageType: string read GetPackageType; + public + constructor Create(const Filename: string; IDE: TSpIDEType); virtual; + function CompilePackage(APlatform: TSpPlatform; SourcesL, IncludesL, Log: TStrings; TempDir: string = ''): Boolean; + property DPKFilename: string read FDPKFilename; + property BPLFilename: string read FBPLFilename; + property Exists: Boolean read FExists; + property OnlyRuntime: Boolean read FOnlyRuntime; + property OnlyDesigntime: Boolean read FOnlyDesigntime; + property Description: string read FDescription; + property LibSuffix: string read FLibSuffix; + property IDEVersion: TSpIDEType read FIDEVersion; + end; + + TSpDelphiDPKFilesList = class(TObjectList) + private + procedure BubbleSort(const AComparer: IComparer); + public + procedure Sort; reintroduce; + end; + //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Helpers } +{ TSpPlatformHelper } + +function TSpPlatformHelper.GetDccConfig: string; +begin + Result := IfThen(Self = pltWin32, 'dcc32.cfg', 'dcc64.cfg'); +end; + +function TSpPlatformHelper.GetDccPath: string; +begin + Result := IfThen(Self = pltWin32, 'dcc32.exe', 'dcc64.exe'); +end; + +function TSpPlatformHelper.GetKnownPackages: string; +begin + Result := '\Known Packages' + IfThen(Self = pltWin32, '', ' x64'); +end; + +function TSpPlatformHelper.GetName: string; +begin + Result := IfThen(Self = pltWin32, 'Win32', 'Win64'); +end; + +function TSpPlatformHelper.GetRegKey: string; +begin + Result := '\' + GetName; +end; + procedure SpOpenLink(URL: string); begin ShellExecute(Application.Handle, 'open', PChar(URL), '', '', SW_SHOWNORMAL); @@ -335,23 +387,24 @@ function SpStringSearch(S, SubStr: string; Delimiter: Char): Boolean; var L: TStringList; begin - L := TStringList.Create; + L := TStringList.Create; try L.StrictDelimiter := True; L.Delimiter := Delimiter; L.DelimitedText := S; Result := L.IndexOf(SubStr) > -1; finally - L.free; + L.Free; end; end; -procedure SpWriteLog(Log: TStrings; ResourceS, Arg1: string; Arg2: string = ''); +procedure SpWriteLog(Log: TStrings; const AMessage: string; const AParams: array of TVarRec); begin - if Assigned(Log) then begin - Log.Add(Format(ResourceS, [Arg1, Arg2])); - Log.Add(''); - end; + if Assigned(Log) then + begin + Log.Add(Format(AMessage, AParams)); + Log.Add(''); + end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM @@ -379,13 +432,13 @@ function SpExecuteDosCommand(CommandLine, WorkDir: string; out OutputString: str // Do not use pipes and redirections in CommandLine (|, >, <) // Ported by Stephane Wierzbicki from JclSysUtils.InternalExecute const - BufferSize = 255; + BufferSize = 255; NativeLineFeed = Char(#10); NativeCarriageReturn = Char(#13); - NativeCrLf = string(#13#10); + NativeCrLf = string(sLineBreak); var - Buffer: array [0..BufferSize] of AnsiChar; - TempOutput: string; + Buffer : array [0 .. BufferSize] of AnsiChar; + TempOutput : string; PipeBytesRead: Cardinal; function MuteCRTerminatedLines(const RawOutput: string): string; @@ -393,36 +446,36 @@ function SpExecuteDosCommand(CommandLine, WorkDir: string; out OutputString: str Delta = 1024; var BufPos, OutPos, LfPos, EndPos: Integer; - C: Char; + C : Char; begin SetLength(Result, Length(RawOutput)); OutPos := 1; LfPos := OutPos; EndPos := OutPos; for BufPos := 1 to Length(RawOutput) do - begin - if OutPos >= Length(Result)-2 then - SetLength(Result, Length(Result) + Delta); - C := RawOutput[BufPos]; - case C of - NativeCarriageReturn: - OutPos := LfPos; - NativeLineFeed: - begin - OutPos := EndPos; - Result[OutPos] := NativeCarriageReturn; - Inc(OutPos); - Result[OutPos] := C; - Inc(OutPos); - EndPos := OutPos; - LfPos := OutPos; - end; - else - Result[OutPos] := C; - Inc(OutPos); - EndPos := OutPos; + begin + if OutPos >= Length(Result) - 2 then + SetLength(Result, Length(Result) + Delta); + C := RawOutput[BufPos]; + case C of + NativeCarriageReturn: + OutPos := LfPos; + NativeLineFeed: + begin + OutPos := EndPos; + Result[OutPos] := NativeCarriageReturn; + Inc(OutPos); + Result[OutPos] := C; + Inc(OutPos); + EndPos := OutPos; + LfPos := OutPos; + end; + else + Result[OutPos] := C; + Inc(OutPos); + EndPos := OutPos; + end; end; - end; SetLength(Result, OutPos - 1); end; @@ -434,10 +487,10 @@ function SpExecuteDosCommand(CommandLine, WorkDir: string; out OutputString: str procedure ProcessLine(LineEnd: Integer); begin if (TempOutput[LineEnd] <> NativeCarriageReturn) then - begin - while (LineEnd > 0) and CharIsReturn(TempOutput[LineEnd]) do - Dec(LineEnd); - end; + begin + while (LineEnd > 0) and CharIsReturn(TempOutput[LineEnd]) do + Dec(LineEnd); + end; end; procedure ProcessBuffer; @@ -448,21 +501,21 @@ function SpExecuteDosCommand(CommandLine, WorkDir: string; out OutputString: str // outsourced from Win32ExecAndRedirectOutput var - StartupInfo: TStartupInfo; - ProcessInfo: TProcessInformation; - SecurityAttr: TSecurityAttributes; + StartupInfo : TStartupInfo; + ProcessInfo : TProcessInformation; + SecurityAttr : TSecurityAttributes; PipeRead, PipeWrite: THandle; - PWorkDirChar : PChar; + PWorkDirChar : PChar; begin Result := $FFFFFFFF; SecurityAttr.nLength := SizeOf(SecurityAttr); SecurityAttr.lpSecurityDescriptor := nil; SecurityAttr.bInheritHandle := True; if not CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0) then - begin - Result := GetLastError; - Exit; - end; + begin + Result := GetLastError; + Exit; + end; FillChar(StartupInfo, SizeOf(TStartupInfo), #0); StartupInfo.cb := SizeOf(TStartupInfo); StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; @@ -471,48 +524,50 @@ function SpExecuteDosCommand(CommandLine, WorkDir: string; out OutputString: str StartupInfo.hStdOutput := PipeWrite; StartupInfo.hStdError := PipeWrite; - if WorkDir = '' then PWorkDirChar := nil - else PWorkDirChar := PChar(WorkDir); + if WorkDir = '' then + PWorkDirChar := nil + else + PWorkDirChar := PChar(WorkDir); if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, PWorkDirChar, StartupInfo, ProcessInfo) then - begin - CloseHandle(PipeWrite); + begin + CloseHandle(PipeWrite); - while ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do - ProcessBuffer; - if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and - not GetExitCodeProcess(ProcessInfo.hProcess, Result) then + while ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do + ProcessBuffer; + if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and + not GetExitCodeProcess(ProcessInfo.hProcess, Result) then Result := $FFFFFFFF; - CloseHandle(ProcessInfo.hThread); - CloseHandle(ProcessInfo.hProcess); - end + CloseHandle(ProcessInfo.hThread); + CloseHandle(ProcessInfo.hProcess); + end else CloseHandle(PipeWrite); CloseHandle(PipeRead); - if TempOutput <> '' then - OutputString := OutputString + MuteCRTerminatedLines(TempOutput); + OutputString := MuteCRTerminatedLines(TempOutput); end; function SpFileOperation(Origin, Destination: string; Operation: Cardinal): Boolean; var - F: TShFileOpStruct; + F: TSHFileOpStruct; begin - Result := False; + Result := False; // Operation can be: FO_COPY, FO_MOVE, FO_DELETE, FO_RENAME - if not (Operation in [FO_MOVE..FO_RENAME]) then Exit; - - Origin := Origin + #0#0; - Destination := Destination + #0#0; - - FillChar(F, SizeOf(F), #0); - F.Wnd := Application.Handle; - F.wFunc := Operation; - F.pFrom := PChar(Origin); - F.pTo := PChar(Destination); - F.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; - Result := SHFileOperation(F) = 0; + if not(Operation in [FO_MOVE .. FO_RENAME]) then + Exit; + + Origin := Origin + #0#0; + Destination := Destination + #0#0; + + FillChar(F, SizeOf(F), #0); + F.Wnd := Application.Handle; + F.wFunc := Operation; + F.pFrom := PChar(Origin); + F.pTo := PChar(Destination); + F.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; + Result := SHFileOperation(F) = 0; end; function SpSelectDirectory(Root: string; out Directory: string): Boolean; @@ -546,7 +601,7 @@ function SpGitClone(AGit, DestinationPath: string; Log: TStrings): Boolean; CommandLine := Format(SGitCloneCommand, [AGit, DestinationPath]); Result := SpExecuteDosCommand(CommandLine, '', DosOutput) = 0; if Assigned(Log) then - Log.Text := Log.Text + DosOutput + #13#10; + Log.Text := Log.Text + DosOutput + sLineBreak; end; function SpIsGitInstalled(Log: TStrings): Boolean; @@ -555,7 +610,7 @@ function SpIsGitInstalled(Log: TStrings): Boolean; begin Result := SpExecuteDosCommand(SGitIsInstalledCommand, '', DosOutput) = 0; if Assigned(Log) then - Log.Text := Log.Text + DosOutput + #13#10; + Log.Text := Log.Text + DosOutput + sLineBreak; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM @@ -587,10 +642,11 @@ function SpReadRegValue(Key, Name: string; out Value: string): Boolean; try R.RootKey := HKEY_CURRENT_USER; if R.OpenKey(Key, False) then - if R.ValueExists(Name) then begin - Value := R.ReadString(Name); - Result := True; - end; + if R.ValueExists(Name) then + begin + Value := R.ReadString(Name); + Result := True; + end; finally R.Free; end; @@ -598,25 +654,27 @@ function SpReadRegValue(Key, Name: string; out Value: string): Boolean; function SpReadRegKey(Key: string; NamesAndValues: TStringList): Boolean; var - R: TRegistry; + R : TRegistry; Names: TStringList; - I: Integer; + I : Integer; begin Result := False; - if not Assigned(NamesAndValues) then Exit; + if not Assigned(NamesAndValues) then + Exit; NamesAndValues.Clear; R := TRegistry.Create; Names := TStringList.Create; try R.RootKey := HKEY_CURRENT_USER; - if R.OpenKey(Key, False) then begin - R.GetValueNames(Names); - for I := 0 to Names.Count - 1 do - if R.ValueExists(Names[I]) then - NamesAndValues.Values[Names[I]] := R.ReadString(Names[I]); - Result := True; - end; + if R.OpenKey(Key, False) then + begin + R.GetValueNames(Names); + for I := 0 to Names.Count - 1 do + if R.ValueExists(Names[I]) then + NamesAndValues.Values[Names[I]] := R.ReadString(Names[I]); + Result := True; + end; finally R.Free; Names.Free; @@ -631,10 +689,11 @@ function SpWriteRegValue(Key, Name, Value: string): Boolean; R := TRegistry.Create; try R.RootKey := HKEY_CURRENT_USER; - if R.OpenKey(Key, True) then begin - R.WriteString(Name, Value); - Result := True; - end; + if R.OpenKey(Key, True) then + begin + R.WriteString(Name, Value); + Result := True; + end; finally R.Free; end; @@ -642,16 +701,17 @@ function SpWriteRegValue(Key, Name, Value: string): Boolean; procedure SpIniLoadStringList(L: TStringList; IniFilename, Section: string; NamePrefix: string = ''); var - F: TMemIniFile; - I, C: integer; + F : TMemIniFile; + I, C: Integer; begin - if not Assigned(L) then Exit; + if not Assigned(L) then + Exit; F := TMemIniFile.Create(IniFilename); try L.Clear; C := F.ReadInteger(Section, NamePrefix + rvCount, -1); for I := 0 to C - 1 do - L.Add(F.ReadString(Section, NamePrefix + inttostr(I), '')); + L.Add(F.ReadString(Section, NamePrefix + IntToStr(I), '')); finally F.Free; end; @@ -660,18 +720,20 @@ procedure SpIniLoadStringList(L: TStringList; IniFilename, Section: string; Name procedure SpIniSaveStringList(L: TStringList; IniFilename, Section: string; NamePrefix: string = ''); var F: TMemIniFile; - I: integer; + I: Integer; begin - if not Assigned(L) then Exit; + if not Assigned(L) then + Exit; F := TMemIniFile.Create(IniFilename); try F.EraseSection(Section); - if L.Count > 0 then begin - F.WriteInteger(Section, NamePrefix + rvCount, L.Count); - for I := 0 to L.Count - 1 do - F.WriteString(Section, NamePrefix + IntToStr(I), L[I]); - F.UpdateFile; - end; + if L.Count > 0 then + begin + F.WriteInteger(Section, NamePrefix + rvCount, L.Count); + for I := 0 to L.Count - 1 do + F.WriteString(Section, NamePrefix + IntToStr(I), L[I]); + F.UpdateFile; + end; finally F.Free; end; @@ -702,41 +764,33 @@ function SpStringToActionType(S: string): TSpActionType; Result := satNone; S := LowerCase(S); for A := Low(ActionTypes) to High(ActionTypes) do - if AnsiSameText(S, ActionTypes[A]) then begin - Result := A; - Exit; - end; + if AnsiSameText(S, ActionTypes[A]) then + begin + Result := A; + Exit; + end; end; -procedure SpIDESearchPathRegKey(IDE: TSpIDEType; out Key, Name: string; CPPBuilderPath: Boolean); +procedure SpIDESearchPathRegKey(IDE: TSpIDEType; out Key, Name: string; CPPBuilderPath: Boolean; APlatform: TSpPlatform); begin Key := ''; Name := ''; - if IDE = ideNone then Exit; + if IDE = ideNone then + Exit; // [IDE-Change] Key := IDETypes[IDE].IDERegistryPath; - if CPPBuilderPath and (IDE >= ideDelphi2006) then begin - if IDE = ideDelphi2006 then begin - // '\CppPaths\SearchPath' with no space in the middle for C++Builder 2006 - Key := Key + '\CppPaths'; - Name := 'SearchPath'; - end - else begin + if CPPBuilderPath then + begin Name := 'LibraryPath'; - if IDE >= ideDelphiXE2 then - Key := Key + '\C++\Paths\Win32' // '\C++\Paths\Win32\LibraryPath' with no space in the middle for C++Builder XE2 and above - else - Key := Key + '\C++\Paths'; // '\C++\Paths\LibraryPath' with no space in the middle for C++Builder 2009 and above - end; - end - else begin - Name := 'Search Path'; - if IDE >= ideDelphiXE2 then - Key := Key + '\Library\Win32' - else + Key := Key + '\C++\Paths'; // '\C++\Paths\\LibraryPath' with no space in the middle for C++Builder XE2 and above + end + else + begin + Name := 'Search Path'; Key := Key + '\Library'; - end; + end; + Key := Key + APlatform.RegKey; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM @@ -747,7 +801,7 @@ class function TSpDelphiIDE.Installed(IDE: TSpIDEType): Boolean; if IDE = ideNone then Result := False else - Result := TFile.Exists(GetDCC32Filename(IDE)); + Result := TFile.Exists(GetDCCFilename(IDE, pltWin32)); // Just check for the dcc32 executable end; class function TSpDelphiIDE.PersonalityInstalled(IDE: TSpIDEType; @@ -756,14 +810,13 @@ class function TSpDelphiIDE.PersonalityInstalled(IDE: TSpIDEType; S, PersReg: string; begin Result := False; - if IDE = ideNone then Exit; + if IDE = ideNone then + Exit; - if IDE >= ideDelphi2006 then begin - IDEPersonalityTypeToString(IDEPersonality, PersReg); - SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Personalities', PersReg, S); - if S <> ''then - Result := True; - end; + IDEPersonalityTypeToString(IDEPersonality, PersReg); + SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Personalities', PersReg, S); + if S <> '' then + Result := True; end; class function TSpDelphiIDE.StringToIDEType(S: string): TSpIDEType; @@ -772,10 +825,11 @@ class function TSpDelphiIDE.StringToIDEType(S: string): TSpIDEType; begin Result := ideNone; for A := Low(IDETypes) to High(IDETypes) do - if AnsiSameText(S, IDETypes[A].IDEVersion) then begin - Result := A; - Exit; - end; + if AnsiSameText(S, IDETypes[A].IDEVersion) then + begin + Result := A; + Exit; + end; end; class function TSpDelphiIDE.IDEPackageVersion(IDE: TSpIDEType): string; @@ -795,80 +849,85 @@ class function TSpDelphiIDE.GetIDEDir(IDE: TSpIDEType): string; SpReadRegValue(IDETypes[IDE].IDERegistryPath, 'RootDir', Result); end; -class function TSpDelphiIDE.GetDCC32Filename(IDE: TSpIDEType): string; +class function TSpDelphiIDE.GetDCCFilename(IDE: TSpIDEType; APlatform: TSpPlatform): string; begin SpReadRegValue(IDETypes[IDE].IDERegistryPath, 'App', Result); if Result <> '' then - Result := TPath.Combine(TPath.GetDirectoryName(Result), 'dcc32.exe'); + Result := TPath.Combine(TPath.GetDirectoryName(Result), APlatform.DccPath); end; -class function TSpDelphiIDE.GetBPLOutputDir(IDE: TSpIDEType): string; +class function TSpDelphiIDE.GetBPLOutputDir(IDE: TSpIDEType; APlatform: TSpPlatform): string; begin // BPL Output Dir - if IDE >= ideDelphiXE2 then - SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Library\Win32', 'Package DPL Output', Result) - else - SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Library', 'Package DPL Output', Result); - Result := TSpDelphiIDE.ExpandMacros(Result, IDE); + SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Library' + APlatform.RegKey, 'Package DPL Output', Result); + Result := TSpDelphiIDE.ExpandMacros(Result, IDE, APlatform); end; -class function TSpDelphiIDE.GetDCPOutputDir(IDE: TSpIDEType): string; +class function TSpDelphiIDE.GetDCPOutputDir(IDE: TSpIDEType; APlatform: TSpPlatform): string; begin // DCP Output Dir - if IDE >= ideDelphiXE2 then - SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Library\Win32', 'Package DCP Output', Result) - else - SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Library', 'Package DCP Output', Result); - Result := TSpDelphiIDE.ExpandMacros(Result, IDE); + SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Library' + APlatform.RegKey, 'Package DCP Output', Result); + Result := TSpDelphiIDE.ExpandMacros(Result, IDE, APlatform); end; class function TSpDelphiIDE.ReadEnvironmentProj(IDE: TSpIDEType; NamesAndValues: TStringList): Boolean; // Reads environment.proj file. // In newer versions of RAD Studio (2007 and up) the macros are stored in: -// C:\Users\x\AppData\Roaming\Embarcadero\BDS\19.0\environment.proj +// C:\Users\\AppData\Roaming\Embarcadero\BDS\19.0\environment.proj // This file is used by MSBuild // https://docs.microsoft.com/en-us/visualstudio/msbuild/how-to-use-environment-variables-in-a-build?view=vs-2017 var - LStr: array[0 .. MAX_PATH] of Char; - Filename: string; - Doc: IXMLDocument; + LStr : array [0 .. MAX_PATH] of Char; + Filename : string; + Doc : IXMLDocument; Node, Root: IXMLNode; begin Result := False; - if not Assigned(NamesAndValues) or (IDE < ideDelphi2007) then Exit; + if not Assigned(NamesAndValues) then + Exit; NamesAndValues.Clear; SetLastError(ERROR_SUCCESS); - if SHGetFolderPath(0, CSIDL_APPDATA, 0, 0, @LStr) = S_OK then begin - Filename := TPath.Combine(LStr, 'Embarcadero\BDS\' + IDETypes[IDE].IDERADStudioVersion + '\environment.proj'); - if TFile.Exists(Filename) then begin - Doc := TXMLDocument.Create(Filename); - Root := Doc.ChildNodes.FindNode('Project'); - if Root <> nil then begin - Root := Root.ChildNodes.FindNode('PropertyGroup'); - if Root <> nil then begin - // Add $(Delphi), $(BDS), $(BDSPROJECTSDIR), $(BDSCOMMONDIR), - // $(BDSUSERDIR), $(BDSLIB) macros - Node := Root.ChildNodes.FindNode('Delphi'); - if Node <> nil then NamesAndValues.AddPair('Delphi', Node.Text); - Node := Root.ChildNodes.FindNode('BDS'); - if Node <> nil then NamesAndValues.AddPair('BDS', Node.Text); - Node := Root.ChildNodes.FindNode('BDSPROJECTSDIR'); - if Node <> nil then NamesAndValues.AddPair('BDSPROJECTSDIR', Node.Text); - Node := Root.ChildNodes.FindNode('BDSCOMMONDIR'); - if Node <> nil then NamesAndValues.AddPair('BDSCOMMONDIR', Node.Text); - Node := Root.ChildNodes.FindNode('BDSUSERDIR'); - if Node <> nil then NamesAndValues.AddPair('BDSUSERDIR', Node.Text); - Node := Root.ChildNodes.FindNode('BDSLIB'); - if Node <> nil then NamesAndValues.AddPair('BDSLIB', Node.Text); - Result := True; + if SHGetFolderPath(0, CSIDL_APPDATA, 0, 0, @LStr) = S_OK then + begin + Filename := TPath.Combine(LStr, 'Embarcadero\BDS\' + IDETypes[IDE].IDERADStudioVersion + '\environment.proj'); + if TFile.Exists(Filename) then + begin + Doc := TXMLDocument.Create(Filename); + Root := Doc.ChildNodes.FindNode('Project'); + if Assigned(Root) then + begin + Root := Root.ChildNodes.FindNode('PropertyGroup'); + if Assigned(Root) then + begin + // Add $(Delphi), $(BDS), $(BDSPROJECTSDIR), $(BDSCOMMONDIR), + // $(BDSUSERDIR), $(BDSLIB) macros + Node := Root.ChildNodes.FindNode('Delphi'); + if Assigned(Node) then + NamesAndValues.AddPair('Delphi', Node.Text); + Node := Root.ChildNodes.FindNode('BDS'); + if Assigned(Node) then + NamesAndValues.AddPair('BDS', Node.Text); + Node := Root.ChildNodes.FindNode('BDSPROJECTSDIR'); + if Assigned(Node) then + NamesAndValues.AddPair('BDSPROJECTSDIR', Node.Text); + Node := Root.ChildNodes.FindNode('BDSCOMMONDIR'); + if Assigned(Node) then + NamesAndValues.AddPair('BDSCOMMONDIR', Node.Text); + Node := Root.ChildNodes.FindNode('BDSUSERDIR'); + if Assigned(Node) then + NamesAndValues.AddPair('BDSUSERDIR', Node.Text); + Node := Root.ChildNodes.FindNode('BDSLIB'); + if Assigned(Node) then + NamesAndValues.AddPair('BDSLIB', Node.Text); + Result := True; + end; + end; end; - end; end; - end; end; -class procedure TSpDelphiIDE.GetMacros(IDE: TSpIDEType; NamesAndValues: TStringList); +class procedure TSpDelphiIDE.GetMacros(IDE: TSpIDEType; APlatform: TSpPlatform; NamesAndValues: TStringList); // Get $(Delphi), $(BDS), $(BDSPROJECTSDIR), $(BDSCOMMONDIR), // $(BDSUSERDIR), $(BDSLIB) macros and IDE Environment Variables Overrides // with full directory paths. @@ -879,28 +938,30 @@ class procedure TSpDelphiIDE.GetMacros(IDE: TSpIDEType; NamesAndValues: TStringL begin Result := False; I := OverrideL.IndexOfName(Macro); - if I = -1 then begin - I := DefaultL.IndexOfName(Macro); - if I >= 0 then begin - // No override found, use default value - OverrideL.Values[Macro] := DefaultL.ValueFromIndex[I]; - Result := True; + if I = -1 then + begin + I := DefaultL.IndexOfName(Macro); + if I >= 0 then + begin + // No override found, use default value + OverrideL.Values[Macro] := DefaultL.ValueFromIndex[I]; + Result := True; + end; end; - end; end; const // English, German, French strings - DirArrayBDS: array [0..2] of string = ('Borland Studio Projects', 'Borland Studio-Projekte', 'Projets Borland Studio'); - DirArrayRAD: array [0..2] of string = ('Projects', 'Projekte', 'Projets'); + DirArrayBDS: array [0 .. 2] of string = ('Borland Studio Projects', 'Borland Studio-Projekte', 'Projets Borland Studio'); + DirArrayRAD: array [0 .. 2] of string = ('Projects', 'Projekte', 'Projets'); var R, MyDocs: string; - I: Integer; - DefaultL: TStringList; + I : Integer; + DefaultL : TStringList; begin // In newer versions of RAD Studio (2007 and up) the macros are stored in: - // C:\Users\x\AppData\Roaming\Embarcadero\BDS\19.0\environment.proj + // C:\Users\\AppData\Roaming\Embarcadero\BDS\19.0\environment.proj // // When the IDE is opened it reads environment.proj and sets the macros as // system Environment Variables. @@ -909,7 +970,8 @@ class procedure TSpDelphiIDE.GetMacros(IDE: TSpIDEType; NamesAndValues: TStringL // So when the IDE is not running we can't use SysUtils.GetEnvironmentVariable. NamesAndValues.Clear; - if IDE = ideNone then Exit; + if IDE = ideNone then + Exit; DefaultL := TStringList.Create; try @@ -924,87 +986,79 @@ class procedure TSpDelphiIDE.GetMacros(IDE: TSpIDEType; NamesAndValues: TStringL NamesAndValues.Values['Delphi'] := GetIDEDir(IDE); // $(BDS) - if IDE >= ideDelphi2005 then - if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDS') then - NamesAndValues.Values['BDS'] := GetIDEDir(IDE); + if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDS') then + NamesAndValues.Values['BDS'] := GetIDEDir(IDE); // $(BDSCOMMONDIR) // It points to a different directory according to how you install Delphi: // If you choose All Users during installation: - // C:\Users\Public\Documents\Embarcadero\Studio\19.0 + // C:\Users\Public\Documents\Embarcadero\Studio\ // If you choose Just Me during installation: - // C:\Users\x\Documents\Embarcadero\Studio\19.0 - if IDE >= ideDelphi2007 then - ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSCOMMONDIR'); + // C:\Users\\Documents\Embarcadero\Studio\ + ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSCOMMONDIR'); // $(BDSPROJECTSDIR) - // Example: C:\Users\x\Documents\Embarcadero\Studio\Projects - if IDE >= ideDelphi2005 then begin - // This macro can be overrided by adding a string value called - // 'DefaultProjectsDirectory' containing a different directory to: - // HKCU\Software\Borland\BDS\4.0\Globals - SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Globals', 'DefaultProjectsDirectory', R); - if not TDirectory.Exists(R) then - if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSPROJECTSDIR') then begin + // Example: C:\Users\\Documents\Embarcadero\Studio\Projects + // This macro can be overridden by adding a string value called + // 'DefaultProjectsDirectory' containing a different directory to: + // HKCU\Software\Borland\BDS\4.0\Globals + SpReadRegValue(IDETypes[IDE].IDERegistryPath + '\Globals', 'DefaultProjectsDirectory', R); + if not TDirectory.Exists(R) then + if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSPROJECTSDIR') then + begin // Try to guess it // Since BDSPROJECTSDIR is not defined in the registry we have to find it // manually, looking for all the localized dir names in MyDocuments folder MyDocs := TPath.GetDocumentsPath; - if IDE in [ideDelphi2005, ideDelphi2006] then begin - // For older BDS check if it's My Documents\Borland Studio Projects - for I := 0 to High(DirArrayBDS) do begin - R := TPath.Combine(MyDocs, DirArrayBDS[I]); - if TDirectory.Exists(R) then Break; - end; - end - else begin - // For newer versions check if it's C:\Users\x\Documents\Embarcadero\Studio\Projects - // or C:\Users\x\Documents\RAD Studio\Projects - for I := 0 to High(DirArrayRAD) do begin + // For newer versions check if it's C:\Users\\Documents\Embarcadero\Studio\Projects + // or C:\Users\\Documents\RAD Studio\Projects + for I := 0 to High(DirArrayRAD) do + begin if IDE >= ideDelphiXE6 then R := TPath.Combine(MyDocs, 'Embarcadero\Studio\' + DirArrayRAD[I]) else R := TPath.Combine(MyDocs, 'RAD Studio\' + DirArrayRAD[I]); - if TDirectory.Exists(R) then Break; + if TDirectory.Exists(R) then + Break; end; - end; if TDirectory.Exists(R) then NamesAndValues.Values['BDSPROJECTSDIR'] := R; end; - end; // $(BDSUSERDIR) - // Example: C:\Users\x\Documents\Embarcadero\Studio\19.0 - if IDE >= ideDelphi2007 then - if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSUSERDIR') then begin + // Example: C:\Users\\Documents\Embarcadero\Studio\ + if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSUSERDIR') then + begin // Try to guess it // Get BDSPROJECTSDIR and add IDE version R := NamesAndValues.Values['BDSPROJECTSDIR']; - if TDirectory.Exists(R) then begin - R := TPath.Combine(ExtractFilePath(R), IDETypes[IDE].IDERADStudioVersion); - if TDirectory.Exists(R) then - NamesAndValues.Values['BDSUSERDIR'] := R; - end; + if TDirectory.Exists(R) then + begin + R := TPath.Combine(ExtractFilePath(R), IDETypes[IDE].IDERADStudioVersion); + if TDirectory.Exists(R) then + NamesAndValues.Values['BDSUSERDIR'] := R; + end; end; // $(BDSLIB) - // Example: C:\Program Files\Embarcadero\Studio\19.0\lib + // Example: C:\Program Files\Embarcadero\Studio\\lib if not ReplaceWithDefault(NamesAndValues, DefaultL, 'BDSLIB') then NamesAndValues.Values['BDSLIB'] := TPath.Combine(GetIDEDir(IDE), 'lib'); // $(PLATFORM) // Not sure were to find this macro - // Since we're using DCC32 to compile assume Win32 - NamesAndValues.Values['PLATFORM'] := 'Win32'; + // Assume the platform name + NamesAndValues.Values['PLATFORM'] := APlatform.Name; FCachedMacrosCommaDelimited := NamesAndValues.CommaText; FCachedMacrosIDE := IDE; + FCachedMacrosPlatform := APlatform; finally DefaultL.Free; end; end; -class function TSpDelphiIDE.ExpandMacros(S: string; IDE: TSpIDEType): string; +class function TSpDelphiIDE.ExpandMacros(S: string; IDE: TSpIDEType; APlatform: TSpPlatform): string; // Replace $(Delphi), $(BDS), $(BDSPROJECTSDIR), $(BDSCOMMONDIR), // $(BDSUSERDIR), $(BDSLIB) macros and IDE Environment Variables Overrides // with full directory paths. @@ -1014,14 +1068,15 @@ class function TSpDelphiIDE.ExpandMacros(S: string; IDE: TSpIDEType): string; L: TStringList; begin Result := S; - if IDE = ideNone then Exit; + if IDE = ideNone then + Exit; L := TStringList.Create; try - if (FCachedMacrosIDE = IDE) and not FCachedMacrosCommaDelimited.IsEmpty then - L.CommaText := FCachedMacrosCommaDelimited // use the cached macros + if (FCachedMacrosIDE = IDE) and (FCachedMacrosPlatform = APlatform) and not FCachedMacrosCommaDelimited.IsEmpty then + L.CommaText := FCachedMacrosCommaDelimited // use the cached macros else - GetMacros(IDE, L); + GetMacros(IDE, APlatform, L); // Replace all for I := 0 to L.Count - 1 do Result := StringReplace(Result, '$(' + L.Names[I] + ')', ExcludeTrailingPathDelimiter(L.ValueFromIndex[I]), [rfReplaceAll, rfIgnoreCase]); @@ -1030,50 +1085,51 @@ class function TSpDelphiIDE.ExpandMacros(S: string; IDE: TSpIDEType): string; end; end; -class function TSpDelphiIDE.GetSearchPath(IDE: TSpIDEType; - CPPBuilderPath: Boolean): string; +class function TSpDelphiIDE.GetSearchPath(IDE: TSpIDEType; APlatform: TSpPlatform; CPPBuilderPath: Boolean): string; var Key, Name: string; begin Result := ''; - if IDE <> ideNone then begin - SpIDESearchPathRegKey(IDE, Key, Name, CPPBuilderPath); - SpReadRegValue(Key, Name, Result); - end; + if IDE <> ideNone then + begin + SpIDESearchPathRegKey(IDE, Key, Name, CPPBuilderPath, APlatform); + SpReadRegValue(Key, Name, Result); + end; end; -class procedure TSpDelphiIDE.AddToSearchPath(SourcesL: TStrings; IDE: TSpIDEType); +class procedure TSpDelphiIDE.AddToSearchPath(SourcesL: TStrings; IDE: TSpIDEType; APlatform: TSpPlatform); var - I : Integer; + I : Integer; S, Key, Name: string; begin - for I := 0 to SourcesL.Count - 1 do begin - SourcesL[I] := ExpandMacros(ExcludeTrailingPathDelimiter(SourcesL[I]), IDE); - - // Add the directory to the Delphi Win32 search path registry entry - S := GetSearchPath(IDE, False); - if (S <> '') and (SourcesL[I] <> '') then - if not SpStringSearch(S, SourcesL[I]) then begin - if S[Length(S)] <> ';' then - S := S + ';'; - S := S + SourcesL[I]; - SpIDESearchPathRegKey(IDE, Key, Name, False); - SpWriteRegValue(Key, Name, S) - end; + for I := 0 to SourcesL.Count - 1 do + begin + SourcesL[I] := ExpandMacros(ExcludeTrailingPathDelimiter(SourcesL[I]), IDE, APlatform); - // Add the directory to the C++Builder search path registry entry - if IDE >= ideDelphi2006 then begin - S := GetSearchPath(IDE, True); + // Add the directory to the Delphi Win32/Win64 search path registry entry + S := GetSearchPath(IDE, APlatform, False); if (S <> '') and (SourcesL[I] <> '') then - if not SpStringSearch(S, SourcesL[I]) then begin - if S[Length(S)] <> ';' then - S := S + ';'; - S := S + SourcesL[I]; - SpIDESearchPathRegKey(IDE, Key, Name, True); - SpWriteRegValue(Key, Name, S) - end; + if not SpStringSearch(S, SourcesL[I]) then + begin + if S[Length(S)] <> ';' then + S := S + ';'; + S := S + SourcesL[I]; + SpIDESearchPathRegKey(IDE, Key, Name, False, APlatform); + SpWriteRegValue(Key, Name, S); + end; + + // Add the directory to the C++Builder search path registry entry + S := GetSearchPath(IDE, APlatform, True); + if (S <> '') and (SourcesL[I] <> '') then + if not SpStringSearch(S, SourcesL[I]) then + begin + if S[Length(S)] <> ';' then + S := S + ';'; + S := S + SourcesL[I]; + SpIDESearchPathRegKey(IDE, Key, Name, True, APlatform); + SpWriteRegValue(Key, Name, S); + end; end; - end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM @@ -1081,7 +1137,7 @@ class procedure TSpDelphiIDE.AddToSearchPath(SourcesL: TStrings; IDE: TSpIDEType constructor TSpDelphiDPKFile.Create(const Filename: string; IDE: TSpIDEType); var - L: TStringList; + L : TStringList; P, P2: Integer; begin FDPKFilename := ''; @@ -1093,54 +1149,60 @@ constructor TSpDelphiDPKFile.Create(const Filename: string; IDE: TSpIDEType); FLibSuffix := ''; FIDEVersion := IDE; - if TFile.Exists(Filename) then begin - FDPKFilename := Filename; - FBPLFilename := TPath.ChangeExtension(TPath.GetFileName(Filename), 'bpl'); - - L := TStringList.Create; - try - L.LoadFromFile(Filename); - P := Pos('{$RUNONLY}', L.Text); - if P > 0 then - FOnlyRuntime := True; - P := Pos('{$DESIGNONLY}', L.Text); - if P > 0 then - FOnlyDesigntime := True; - P := Pos('{$DESCRIPTION ''', L.Text); // {$DESCRIPTION 'Package Description'} - if P > 0 then begin - P := P + Length('{$DESCRIPTION '''); - P2 := PosEx('''}', L.Text, P); - if P2 > 0 then - FDescription := Copy(L.Text, P, P2 - P); - end; + if TFile.Exists(Filename) then + begin + FDPKFilename := Filename; + FBPLFilename := TPath.ChangeExtension(TPath.GetFileName(Filename), 'bpl'); - // Try to parse $LIBSUFFIX - // Won't work if there are nested $IFDEFs, for example: - // {$IFDEF VER340} {$LIBSUFFIX '270'} {$ENDIF} - // {$IFDEF VER350} {$LIBSUFFIX '280'} {$ENDIF} - // Delphi 10.4 Sydney added the AUTO option: {$LIBSUFFIX AUTO} - P := Pos('{$LIBSUFFIX AUTO}', L.Text); - if P > 0 then begin - FLibSuffix := 'AUTO'; - FBPLFilename := TPath.GetFileNameWithoutExtension(DPKFilename) + TSpDelphiIDE.IDEPackageVersion(IDE) + '.bpl'; - end - else begin - P := Pos('{$LIBSUFFIX ''', L.Text); // {$LIBSUFFIX '280'} for example: file280.bpl - if P > 0 then begin - P := P + Length('{$LIBSUFFIX '''); - P2 := PosEx('''}', L.Text, P); - if P2 > 0 then begin - FLibSuffix := Copy(L.Text, P, P2 - P); - FBPLFilename := TPath.GetFileNameWithoutExtension(DPKFilename) + FLibSuffix + '.bpl'; + L := TStringList.Create; + try + L.LoadFromFile(Filename); + P := Pos('{$RUNONLY}', L.Text); + if P > 0 then + FOnlyRuntime := True; + P := Pos('{$DESIGNONLY}', L.Text); + if P > 0 then + FOnlyDesigntime := True; + P := Pos('{$DESCRIPTION ''', L.Text); // {$DESCRIPTION 'Package Description'} + if P > 0 then + begin + P := P + Length('{$DESCRIPTION '''); + P2 := PosEx('''}', L.Text, P); + if P2 > 0 then + FDescription := Copy(L.Text, P, P2 - P); end; - end; - end; - FExists := True; - finally - L.Free; + // Try to parse $LIBSUFFIX + // Won't work if there are nested $IFDEFs, for example: + // {$IFDEF VER340} {$LIBSUFFIX '270'} {$ENDIF} + // {$IFDEF VER350} {$LIBSUFFIX '280'} {$ENDIF} + // Delphi 10.4 Sydney added the AUTO option: {$LIBSUFFIX AUTO} + P := Pos('{$LIBSUFFIX AUTO}', L.Text); + if P > 0 then + begin + FLibSuffix := 'AUTO'; + FBPLFilename := TPath.GetFileNameWithoutExtension(DPKFilename) + TSpDelphiIDE.IDEPackageVersion(IDE) + '.bpl'; + end + else + begin + P := Pos('{$LIBSUFFIX ''', L.Text); // {$LIBSUFFIX '280'} for example: file280.bpl + if P > 0 then + begin + P := P + Length('{$LIBSUFFIX '''); + P2 := PosEx('''}', L.Text, P); + if P2 > 0 then + begin + FLibSuffix := Copy(L.Text, P, P2 - P); + FBPLFilename := TPath.GetFileNameWithoutExtension(DPKFilename) + FLibSuffix + '.bpl'; + end; + end; + end; + + FExists := True; + finally + L.Free; + end; end; - end; end; procedure TSpDelphiDPKFile.CreateAndCopyEmptyResIfNeeded; @@ -1149,21 +1211,36 @@ procedure TSpDelphiDPKFile.CreateAndCopyEmptyResIfNeeded; FStream: TResourceStream; begin // Create and copy a res file if needed - if Exists then begin - ResFile := TPath.ChangeExtension(FDPKFilename, 'res'); - if not TFile.Exists(ResFile) then begin - FStream := TResourceStream.Create(HInstance, 'EMPTYRES', RT_RCDATA); - try - FStream.SaveToFile(ResFile); - finally - FStream.Free; - end; + if Exists then + begin + ResFile := TPath.ChangeExtension(FDPKFilename, 'res'); + if not TFile.Exists(ResFile) then + begin + FStream := TResourceStream.Create(HInstance, 'EMPTYRES', RT_RCDATA); + try + FStream.SaveToFile(ResFile); + finally + FStream.Free; + end; + end; end; - end; end; -function TSpDelphiDPKFile.CompilePackage(DCC: string; SourcesL, - IncludesL, Log: TStrings; TempDir: string): Boolean; +function TSpDelphiDPKFile.GetPackageType: string; +begin + if OnlyRuntime then + Result := 'run time' + else if OnlyDesigntime then + Result := 'design time' + else + Result := 'unknown' +end; + +function TSpDelphiDPKFile.CompilePackage( + APlatform: TSpPlatform; + SourcesL, IncludesL, + Log: TStrings; + TempDir: string): Boolean; // DCC = full path of dcc32.exe, e.g. 'C:\Program Files\Borland\Delphi7\Bin\dcc32.exe // IDE = IDE version to compile with // SourcesL = list of source folders of the component package to add to the Library Search Path @@ -1171,170 +1248,208 @@ function TSpDelphiDPKFile.CompilePackage(DCC: string; SourcesL, // Log = Log strings // TempDir = Temp dir where the package dcu will be copied, e.g. 'C:\Windows\Temp\MyCompos' var + DCC : string; CommandLine, WorkDir, DOSOutput, DCCConfig: string; - L: TStringList; - I: Integer; - S, R: string; // Auxiliary strings + L : TStringList; + I : Integer; + S, R : string; // Auxiliary strings + LError : string; begin Result := False; - if FIDEVersion = ideNone then Exit; - if not Exists then begin - if Assigned(Log) then - SpWriteLog(Log, SLogInvalidPath, FDPKFilename); + LError := ''; + if FIDEVersion = ideNone then Exit; - end - else begin - // [IDE Bug]: dcc32.exe won't execute if -Q option is not used - // But it works fine without -Q if ShellExecute is used: - // ShellExecute(Application.Handle, 'open', DCC, ExtractFileName(FDPKFilename), ExtractFilePath(FDPKFilename), SW_SHOWNORMAL); - // There must be something wrong with SpExecuteDosCommand - // Example: dcc32.exe -Q sptbxlib.dpk - CommandLine := DCC + ' -Q ' + TPath.GetFileName(FDPKFilename); - WorkDir := TPath.GetDirectoryName(FDPKFilename); - - // Create and save DCC32.CFG file on the Package directory - // Example of cfg file: - // -U"$(BDSLIB)\$(Platform)\release";"C:\TB2K\Source";"C:\SpTBXLib\Source" - // -R"C:\SpTBXLib\Source" - // -LE"C:\Users\Public\Documents\Embarcadero\Studio\19.0\Bpl" - // -LN"C:\Users\Public\Documents\Embarcadero\Studio\19.0\Dcp" - // -NB"C:\Users\Public\Documents\Embarcadero\Studio\19.0\Dcp" - // -NSSystem.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi - // -N"C:\Users\x\AppData\Local\Temp\SpMultiInstall" - // -JL - L := TStringList.Create; - try - // Add the SourcesL directories to the registry - TSpDelphiIDE.AddToSearchPath(SourcesL, FIDEVersion); - - // Expand SearchPath, replace $(Delphi) and $(BDS) with real directories - // and enclose the paths with " " to transform it to a valid - // comma delimited string for the -U switch. - L.Text := TSpDelphiIDE.ExpandMacros(TSpDelphiIDE.GetSearchPath(FIDEVersion, False), FIDEVersion); - L.Text := StringReplace(L.Text, ';', #13#10, [rfReplaceAll, rfIgnoreCase]); - for I := 0 to L.Count - 1 do - L[I] := '"' + L[I] + '"'; - S := StringReplace(L.Text, #13#10, ';', [rfReplaceAll, rfIgnoreCase]); - if S[Length(S)] = ';' then - Delete(S, Length(S), 1); - - // Save the DCC32.CFG file on the Package directory - DCCConfig := TPath.Combine(WorkDir, 'DCC32.CFG'); - R := IDETypes[FIDEVersion].IDERegistryPath; - L.Clear; - // SearchPath - L.Add('-U' + S); - // Resource directories, add the source folder as the default *.dcr search folder - S := ''; - for I := 0 to SourcesL.Count - 1 do - S := S + ';' + SourcesL[I]; - if S <> '' then begin - Delete(S, 1, 1); - S := '"' + S + '"'; - L.Add('-R' + S); - end; - // BPL Output - S := TSpDelphiIDE.GetBPLOutputDir(FIDEVersion); - L.Add('-LE"' + S + '"'); - // DCP Output - S := TSpDelphiIDE.GetDCPOutputDir(FIDEVersion); - L.Add('-LN"' + S + '"'); - // BPI Output for the compiled packages, required for C++Builder 2006 and above, - // same as DCP Output - if FIDEVersion >= ideDelphi2006 then + if not Exists then + begin + if Assigned(Log) then + SpWriteLog(Log, SLogInvalidPath, [FDPKFilename]); + Exit; + end + else + begin + DCC := TSpDelphiIDE.GetDCCFilename(FIDEVersion, APlatform); + + // [IDE Bug]: dcc32.exe won't execute if -Q option is not used + // But it works fine without -Q if ShellExecute is used: + // ShellExecute(Application.Handle, 'open', DCC, ExtractFileName(FDPKFilename), ExtractFilePath(FDPKFilename), SW_SHOWNORMAL); + // There must be something wrong with SpExecuteDosCommand + // Example: dcc32.exe -Q sptbxlib.dpk + CommandLine := DCC + ' -Q ' + TPath.GetFileName(FDPKFilename); + WorkDir := TPath.GetDirectoryName(FDPKFilename); + + // Create and save DCC32/64.CFG file on the Package directory + // Example of cfg file: + // -U"$(BDSLIB)\$(Platform)\release";"C:\TB2K\Source";"C:\SpTBXLib\Source" + // -R"C:\SpTBXLib\Source" + // -LE"C:\Users\Public\Documents\Embarcadero\Studio\\Bpl" + // -LN"C:\Users\Public\Documents\Embarcadero\Studio\\Dcp" + // -NB"C:\Users\Public\Documents\Embarcadero\Studio\\Dcp" + // -NSSystem.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi + // -N"C:\Users\\AppData\Local\Temp\SpMultiInstall" + // -JL + L := TStringList.Create; + try + // Add the SourcesL directories to the registry + TSpDelphiIDE.AddToSearchPath(SourcesL, FIDEVersion, APlatform); + + // Expand SearchPath, replace $(Delphi) and $(BDS) with real directories + // and enclose the paths with " " to transform it to a valid + // comma delimited string for the -U switch. + L.Text := TSpDelphiIDE.ExpandMacros(TSpDelphiIDE.GetSearchPath(FIDEVersion, APlatform, False), FIDEVersion, APlatform); + L.Text := StringReplace(L.Text, ';', sLineBreak, [rfReplaceAll, rfIgnoreCase]); + for I := 0 to L.Count - 1 do + L[I] := '"' + L[I] + '"'; + S := StringReplace(L.Text, sLineBreak, ';', [rfReplaceAll, rfIgnoreCase]); + if S[Length(S)] = ';' then + Delete(S, Length(S), 1); + + // Save the DCC32/64.CFG file on the Package directory + DCCConfig := TPath.Combine(WorkDir, APlatform.DccConfig); + R := IDETypes[FIDEVersion].IDERegistryPath; + L.Clear; + // SearchPath + L.Add('-U' + S); + // Resource directories, add the source folder as the default *.dcr search folder + S := ''; + for I := 0 to SourcesL.Count - 1 do + S := S + ';' + SourcesL[I]; + if S <> '' then + begin + Delete(S, 1, 1); + S := '"' + S + '"'; + L.Add('-R' + S); + end; + // BPL Output + S := TSpDelphiIDE.GetBPLOutputDir(FIDEVersion, APlatform); + L.Add('-LE"' + S + '"'); + // DCP Output + S := TSpDelphiIDE.GetDCPOutputDir(FIDEVersion, APlatform); + L.Add('-LN"' + S + '"'); + // BPI Output for the compiled packages, required for C++Builder 2006 and above, + // same as DCP Output L.Add('-NB"' + S + '"'); - // Unit namespaces for Delphi XE2: - if FIDEVersion >= ideDelphiXE2 then + // Unit namespaces for Delphi XE2 and up: L.Add('-NSSystem.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi'); - // Includes, dcc32.exe accepts Includes as a semicolon separated string - // enclosed by double quotes, e.g. "C:\dir1;C:\dir2;C:\dir3" - S := ''; - for I := 0 to IncludesL.Count - 1 do - S := S + ';' + IncludesL[I]; - if S <> '' then begin - Delete(S, 1, 1); - S := '"' + S + '"'; - L.Add('-I' + S); - end; - // DCU Output for the compiled packages - if TempDir <> '' then - L.Add('-N"' + TempDir + '"'); - // Add -JL compiler switch to make Hpp files required for C++Builder 2006 and above - // This switch is undocumented: - // http://groups.google.com/group/borland.public.cppbuilder.ide/browse_thread/thread/456bece4c5665459/0c4c61ecec179ca8 - if FIDEVersion >= ideDelphi2006 then + // Includes, dcc32.exe accepts Includes as a semicolon separated string + // enclosed by double quotes, e.g. "C:\dir1;C:\dir2;C:\dir3" + S := ''; + for I := 0 to IncludesL.Count - 1 do + S := S + ';' + IncludesL[I]; + if S <> '' then + begin + Delete(S, 1, 1); + S := '"' + S + '"'; + L.Add('-I' + S); + end; + // DCU Output for the compiled packages + if TempDir <> '' then + L.Add('-N"' + TempDir + '"'); + // Add -JL compiler switch to make Hpp files required for C++Builder 2006 and above + // This switch is undocumented: + // http://groups.google.com/group/borland.public.cppbuilder.ide/browse_thread/thread/456bece4c5665459/0c4c61ecec179ca8 if TSpDelphiIDE.PersonalityInstalled(FIDEVersion, persCPPBuilder) then L.Add('-JL'); - L.SaveToFile(DCCConfig); - finally - L.Free; - end; + L.SaveToFile(DCCConfig); + finally + L.Free; + end; - // Create and copy an empty res file if needed. - // Some component libraries like VirtualTreeView don't include .res files. - CreateAndCopyEmptyResIfNeeded; + // Create and copy an empty res file if needed. + // Some component libraries like VirtualTreeView don't include .res files. + CreateAndCopyEmptyResIfNeeded; - // Compile - SpWriteLog(Log, SLogCompiling, FDPKFilename); - try - Result := SpExecuteDosCommand(CommandLine, WorkDir, DOSOutput) = 0; - if Assigned(Log) then - Log.Text := Log.Text + DosOutput + #13#10; - if Result then - Result := RegisterPackage(Log); - finally - DeleteFile(DCCConfig); + // Compile + SpWriteLog(Log, SLogCompiling, [PackageType, APlatform.Name, FDPKFilename]); + try + Result := SpExecuteDosCommand(CommandLine, WorkDir, DOSOutput) = 0; + if Assigned(Log) then + Log.Text := Log.Text + DOSOutput + sLineBreak; + if Result then + begin + Result := RegisterPackage(APlatform, Log); + if not Result then + LError := SLogErrorRegistering; + end + else + LError := SLogErrorCompiling; + finally + System.SysUtils.DeleteFile(DCCConfig); + end; end; - end; if not Result and Assigned(Log) then - SpWriteLog(Log, SLogErrorCompiling, FDPKFilename, ''); + SpWriteLog(Log, LError, [FDPKFilename]); end; -function TSpDelphiDPKFile.RegisterPackage(Log: TStrings): Boolean; +function TSpDelphiDPKFile.RegisterPackage(APlatform: TSpPlatform; Log: TStrings): Boolean; var BPL, RegKey: string; begin Result := False; - if FIDEVersion = ideNone then Exit; + if FIDEVersion = ideNone then + Exit; // BPL filename - BPL := TPath.Combine(TSpDelphiIDE.GetBPLOutputDir(FIDEVersion), FBPLFilename); + BPL := TPath.Combine(TSpDelphiIDE.GetBPLOutputDir(FIDEVersion, APlatform), FBPLFilename); - RegKey := IDETypes[FIDEVersion].IDERegistryPath + '\Known Packages'; + RegKey := IDETypes[FIDEVersion].IDERegistryPath + APlatform.KnownPackages; - if FOnlyRuntime then begin - SpDeleteRegValue(RegKey, BPL); - Result := True - end + if FOnlyRuntime then + begin + SpDeleteRegValue(RegKey, BPL); + Result := True; + end else - if FOnlyDesigntime and TFile.Exists(BPL) then begin - if SpWriteRegValue(RegKey, BPL, FDescription) then begin - SpWriteLog(Log, SLogInstalling, FDPKFilename); - Result := True; - end; + if FOnlyDesigntime and TFile.Exists(BPL) then + begin + if SpWriteRegValue(RegKey, BPL, FDescription) then + begin + SpWriteLog(Log, SLogInstalling, [PackageType, APlatform.Name, FDPKFilename]); + Result := True; + end; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpDelphiDPKFilesList } +procedure TSpDelphiDPKFilesList.BubbleSort(const AComparer: IComparer); +var + I, J : Integer; + LWasSwapped: Boolean; +begin + for I := Pred(Count) downto 1 do + begin + LWasSwapped := False; + for J := 1 to I do + if (AComparer.Compare(Items[J - 1], Items[J]) > 0) then + begin + Exchange(J - 1, J); + LWasSwapped := True; + end; + if not LWasSwapped then + Break; + end; +end; + procedure TSpDelphiDPKFilesList.Sort; begin - inherited Sort(TComparer.Construct( - function (const Left, Right: TSpDelphiDPKFile): Integer - begin - // Runtime packages should be sorted first - if not Left.FOnlyDesigntime and Right.FOnlyDesigntime then - Result := -1 - else - if Left.FOnlyDesigntime and not Right.FOnlyDesigntime then - Result := 1 - else - Result := 0; - end - )); + // Use BubbleSort, because the default Quicksort is unstable and may + // swap the order of "identical" items + BubbleSort(TComparer.Construct( + function(const Left, Right: TSpDelphiDPKFile): Integer + begin + // Runtime packages should be sorted first + if not Left.FOnlyDesigntime and Right.FOnlyDesigntime then + Result := -1 + else + if Left.FOnlyDesigntime and not Right.FOnlyDesigntime then + Result := 1 + else + Result := 0; + end + )); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM @@ -1356,13 +1471,29 @@ destructor TSpComponentPackage.Destroy; { TSpComponentPackageList } procedure TSpComponentPackageList.LoadFromIni(Filename: string); + + function MakeAbsolutePath(APath: string): string; + var + LPath: string; + begin + // Allow to specify the installation path relative to the .ini file + if TPath.IsRelativePath(APath) then + begin + LPath := TPath.GetDirectoryName(Filename); + LPath := TPath.Combine([LPath, APath]); + Result := TPath.GetFullPath(LPath); + end + else + Result := APath; + end; + var - F: TMemIniFile; + F : TMemIniFile; LSections: TStringList; - Entry: TSpComponentPackage; - I, Aux: integer; - S: string; - A: TSpIDEType; + Entry : TSpComponentPackage; + I, Aux : Integer; + S : string; + A : TSpIDEType; begin if not TFile.Exists(Filename) then Exit; @@ -1373,7 +1504,7 @@ procedure TSpComponentPackageList.LoadFromIni(Filename: string); // Read Options S := F.ReadString(rvOptionsIniSection, rvDefaultInstallIDE, ''); FDefaultInstallIDE := TSpDelphiIDE.StringToIDEType(S); - FDefaultInstallFolder := F.ReadString(rvOptionsIniSection, rvDefaultInstallFolder, ''); + FDefaultInstallFolder := MakeAbsolutePath(F.ReadString(rvOptionsIniSection, rvDefaultInstallFolder, '')); S := F.ReadString(rvOptionsIniSection, rvMinimumIDE, ''); FMinimumIDE := TSpDelphiIDE.StringToIDEType(S); if FMinimumIDE = ideNone then @@ -1381,107 +1512,126 @@ procedure TSpComponentPackageList.LoadFromIni(Filename: string); // Read Component Packages F.ReadSections(LSections); - for I := 0 to LSections.Count - 1 do begin - S := LSections[I]; - if Length(S) > Length(rvPackageIniSectionPrefix) then - if AnsiSameText(Copy(S, 1, Length(rvPackageIniSectionPrefix)), rvPackageIniSectionPrefix) then begin - Entry := TSpComponentPackage.Create; - Entry.Name := F.ReadString(S, rvName, ''); - Entry.ZipFile := F.ReadString(S, rvZip, ''); - Entry.Git := F.ReadString(S, rvGit, ''); - Entry.Destination := F.ReadString(S, rvFolder, ''); - Entry.SearchPath := F.ReadString(S, rvSearchPath, ''); - Entry.GroupIndex := F.ReadInteger(S, rvGroupIndex, 0); - Aux := F.ReadInteger(S, rvInstallable, 1); - if Aux < 0 then Aux := 0; - if Aux > Ord(High(TSpInstallType)) then Aux := 1; - Entry.Installable := TSpInstallType(Aux); - Entry.Includes := F.ReadString(S, rvIncludes, ''); + for I := 0 to LSections.Count - 1 do + begin + S := LSections[I]; + if Length(S) > Length(rvPackageIniSectionPrefix) then + if AnsiSameText(Copy(S, 1, Length(rvPackageIniSectionPrefix)), rvPackageIniSectionPrefix) then + begin + Entry := TSpComponentPackage.Create; + Entry.Name := F.ReadString(S, rvName, ''); + Entry.ZipFile := F.ReadString(S, rvZip, ''); + Entry.Git := F.ReadString(S, rvGit, ''); + Entry.Destination := F.ReadString(S, rvFolder, ''); + Entry.SearchPath := F.ReadString(S, rvSearchPath, ''); + Entry.GroupIndex := F.ReadInteger(S, rvGroupIndex, 0); + Aux := F.ReadInteger(S, rvInstallable, 1); + if Aux < 0 then + Aux := 0; + if Aux > Ord(High(TSpInstallType)) then + Aux := 1; + Entry.Installable := TSpInstallType(Aux); + Entry.Includes := F.ReadString(S, rvIncludes, ''); // [IDE-Change] - if Entry.Installable = sitInstallable then begin - for A := FMinimumIDE to High(TSpIDEType) do - Entry.PackageList[A] := F.ReadString(S, IDETypes[A].IDEVersion, ''); - end; - - Entry.ExecuteList.LoadFromIni(Filename, S); - Add(Entry); - end; - end; + if Entry.Installable = sitInstallable then + begin + for A := FMinimumIDE to High(TSpIDEType) do + Entry.PackageList[A] := F.ReadString(S, IDETypes[A].IDEVersion, ''); + end; + + Entry.ExecuteList.LoadFromIni(Filename, S); + Add(Entry); + end; + end; finally LSections.Free; F.Free; end; end; -function TSpComponentPackageList.ExtractAllZips(Source, Destination: string; +function TSpComponentPackageList.ExtractAllZips( + Source, Destination: string; Log: TStrings): Boolean; var GitChecked: Boolean; - I: integer; - Item: TSpComponentPackage; + I : Integer; + Item : TSpComponentPackage; begin GitChecked := False; Result := False; - SpWriteLog(Log, SLogStartUnzip, ''); + SpWriteLog(Log, SLogStartUnzip, []); // Check if the files exist - if not TDirectory.Exists(Destination) then begin - SpWriteLog(Log, SLogInvalidPath, Destination); - Exit; - end; - for I := 0 to Count - 1 do begin - Item := Items[I]; - // Expand ZipFile - if Item.ZipFile <> '' then - Item.ZipFile := TPath.Combine(Source, Item.ZipFile); - // Expand Destination - if Item.Destination <> '' then - Item.Destination := TPath.Combine(Destination, Item.Destination); - if TFile.Exists(Item.ZipFile) then begin - if not AnsiSameText(TPath.GetExtension(Item.ZipFile), '.ZIP') then begin - SpWriteLog(Log, SLogNotAZip, Item.ZipFile); - Exit; - end; - end - else - if Item.Git <> '' then begin - if not AnsiSameText(TPath.GetExtension(Item.Git), '.GIT') then begin - SpWriteLog(Log, SLogNotAGit, Item.Git); - Exit; + if not TDirectory.Exists(Destination) then + begin + SpWriteLog(Log, SLogInvalidPath, [Destination]); + Exit; + end; + for I := 0 to Count - 1 do + begin + Item := Items[I]; + // Expand ZipFile + if Item.ZipFile <> '' then + Item.ZipFile := TPath.Combine(Source, Item.ZipFile); + // Expand Destination + if Item.Destination <> '' then + Item.Destination := TPath.Combine(Destination, Item.Destination); + if TFile.Exists(Item.ZipFile) then + begin + if not AnsiSameText(TPath.GetExtension(Item.ZipFile), '.ZIP') then + begin + SpWriteLog(Log, SLogNotAZip, [Item.ZipFile]); + Exit; + end; + end + else + if Item.Git <> '' then + begin + if not AnsiSameText(TPath.GetExtension(Item.Git), '.GIT') then + begin + SpWriteLog(Log, SLogNotAGit, [Item.Git]); + Exit; + end; end; - end; - end; + end; // Unzip - Git Clone - for I := 0 to Count - 1 do begin - Item := Items[I]; + for I := 0 to Count - 1 do + begin + Item := Items[I]; - if Item.ZipFile <> '' then begin - SpWriteLog(Log, SLogExtracting, Item.ZipFile, Item.Destination); - if not SpExtractZip(Item.ZipFile, Item.Destination) then begin - SpWriteLog(Log, SLogCorruptedZip, Item.ZipFile); - Exit; - end; - end - else - if Item.Git <> '' then begin - if not GitChecked then begin - GitChecked := True; - if not SpIsGitInstalled(Log) then begin - SpWriteLog(Log, SLogGitCloneFailed, ''); - Exit; - end; - end; - SpWriteLog(Log, SLogGitCloning, Item.Git, Item.Destination); - if not SpGitClone(Item.Git, Item.Destination, Log) then begin - SpWriteLog(Log, SLogGitCloneFailed, Item.Git); - Exit; - end; - end + if Item.ZipFile <> '' then + begin + SpWriteLog(Log, SLogExtracting, [Item.ZipFile, Item.Destination]); + if not SpExtractZip(Item.ZipFile, Item.Destination) then + begin + SpWriteLog(Log, SLogCorruptedZip, [Item.ZipFile]); + Exit; + end; + end else - SpWriteLog(Log, SLogNotInstallable, Item.Name); // Not a Zip nor a Git, keep going - end; + if Item.Git <> '' then + begin + if not GitChecked then + begin + GitChecked := True; + if not SpIsGitInstalled(Log) then + begin + SpWriteLog(Log, SLogGitCloneFailed, [Item.Git]); + Exit; + end; + end; + SpWriteLog(Log, SLogGitCloning, [Item.Git, Item.Destination]); + if not SpGitClone(Item.Git, Item.Destination, Log) then + begin + SpWriteLog(Log, SLogGitCloneFailed, [Item.Git]); + Exit; + end; + end + else + SpWriteLog(Log, SLogNotInstallable, [Item.Name]); // Not a Zip nor a Git, keep going + end; Result := True; end; @@ -1490,32 +1640,37 @@ function TSpComponentPackageList.ExecuteAll(BaseFolder: string; Log: TStrings): I: Integer; begin Result := True; - if Count > 0 then begin - SpWriteLog(Log, SLogStartExecute, ''); - for I := 0 to Count - 1 do begin - Result := Items[I].ExecuteList.ExecuteAll(BaseFolder, Log); - if not Result then Exit; - Application.ProcessMessages; + if Count > 0 then + begin + SpWriteLog(Log, SLogStartExecute, []); + for I := 0 to Count - 1 do + begin + Result := Items[I].ExecuteList.ExecuteAll(BaseFolder, Log); + if not Result then + Exit; + Application.ProcessMessages; + end; end; - end; end; function TSpComponentPackageList.CompileAll(BaseFolder: string; IDE: TSpIDEType; Log: TStrings): Boolean; var - DCC, TempDir: string; - I, J: integer; - Item: TSpComponentPackage; + TempDir : string; + J : Integer; + LComponent : TSpComponentPackage; SourcesL, CompileL, IncludesL: TStringList; - DPKList: TSpDelphiDPKFilesList; + LPackageList : TSpDelphiDPKFilesList; + LPackage : TSpDelphiDPKFile; begin Result := False; - if IDE = ideNone then begin - Result := True; - Exit; - end - else - if not TSpDelphiIDE.Installed(IDE) then begin - SpWriteLog(Log, SLogInvalidIDE, IDETypes[IDE].IDEName); + if IDE = ideNone then + begin + Result := True; + Exit; + end + else if not TSpDelphiIDE.Installed(IDE) then + begin + SpWriteLog(Log, SLogInvalidIDE, [IDETypes[IDE].IDEName]); Exit; end; @@ -1523,63 +1678,86 @@ function TSpComponentPackageList.CompileAll(BaseFolder: string; IDE: TSpIDEType; TempDir := TPath.Combine(TPath.GetTempPath, 'SpMultiInstall'); CreateDir(TempDir); - DCC := TSpDelphiIDE.GetDCC32Filename(IDE); SourcesL := TStringList.Create; try - for I := 0 to Count - 1 do begin - Item := Items[I]; - SpWriteLog(Log, SLogStartCompile, Item.Name); - - // Expand Search Path - if Item.SearchPath <> '' then begin - SourcesL.CommaText := Item.SearchPath; - // Add the destination search path - for J := 0 to SourcesL.Count - 1 do - SourcesL[J] := TPath.Combine(Item.Destination, SourcesL[J]); - end - else - SourcesL.Add(Item.Destination); - Item.SearchPath := SourcesL.CommaText; - - case Item.Installable of - sitNotInstallable: ; // do nothing - sitSearchPathOnly: - // If the package is not installable add the SearchPath to the registry - // This is useful when installing utility libraries that doesn't have - // components to install, for example GraphicEx, GDI+, DirectX, etc - TSpDelphiIDE.AddToSearchPath(SourcesL, IDE); - sitInstallable: + for LComponent in Self do + begin + SpWriteLog(Log, SLogStartCompile, [LComponent.Name]); + + // Expand Search Path + if LComponent.SearchPath <> '' then begin - IncludesL := TStringList.Create; - DPKList := TSpDelphiDPKFilesList.Create; - try - // Expand Packages - CompileL := TStringList.Create; + SourcesL.CommaText := LComponent.SearchPath; + // Add the destination search path + for J := 0 to SourcesL.Count - 1 do + SourcesL[J] := TPath.GetFullPath(TPath.Combine(LComponent.Destination, SourcesL[J])); + end + else + SourcesL.Add(LComponent.Destination); + LComponent.SearchPath := SourcesL.CommaText; + + case LComponent.Installable of + sitNotInstallable: + ; // do nothing + sitSearchPathOnly: + begin + // If the package is not installable add the SearchPath to the registry + // This is useful when installing utility libraries that doesn't have + // components to install, for example GraphicEx, GDI+, DirectX, etc + TSpDelphiIDE.AddToSearchPath(SourcesL, IDE, pltWin32); + TSpDelphiIDE.AddToSearchPath(SourcesL, IDE, pltWin64); + end; + sitInstallable: + begin + IncludesL := TStringList.Create; + LPackageList := TSpDelphiDPKFilesList.Create; try - CompileL.CommaText := Item.PackageList[IDE]; - for J := 0 to CompileL.Count - 1 do - DPKList.Add(TSpDelphiDPKFile.Create(TPath.Combine(Item.Destination, CompileL[J]), IDE)); + // Expand Packages + CompileL := TStringList.Create; + try + CompileL.CommaText := LComponent.PackageList[IDE]; + for J := 0 to CompileL.Count - 1 do + LPackageList.Add(TSpDelphiDPKFile.Create(TPath.Combine(LComponent.Destination, CompileL[J]), IDE)); + finally + CompileL.Free; + end; + // Runtime packages must be compiled first + LPackageList.Sort; + + // Expand Includes + IncludesL.CommaText := StringReplace(LComponent.Includes, rvBaseFolder, ExcludeTrailingPathDelimiter(BaseFolder), [rfReplaceAll, rfIgnoreCase]); + + // Compile and Install + if LPackageList.Count = 0 then + begin + SpWriteLog(Log, SLogErrorNoPackage, [IDETypes[IDE].IDEName]); + Exit; + end + else + for LPackage in LPackageList do + begin + // Run- & design time packages for Win32 + if not LPackage.CompilePackage(pltWin32, SourcesL, IncludesL, Log, TempDir) then + Exit; + + // Compile Run time packages for Win64 + // Starting from Delphi 13 compile also design packages + if LPackage.OnlyRuntime or (IDE >= ideDelphiFlorence) then + if not LPackage.CompilePackage(pltWin64, SourcesL, IncludesL, Log, TempDir) then + Exit; + end; + finally - CompileL.Free; + IncludesL.Free; + LPackageList.Free; end; - // Runtime packages must be compiled first - DPKList.Sort; - // Expand Includes - IncludesL.CommaText := StringReplace(Item.Includes, rvBaseFolder, ExcludeTrailingPathDelimiter(BaseFolder), [rfReplaceAll, rfIgnoreCase]); - // Compile and Install - for J := 0 to DPKList.Count - 1 do - if not DPKList[J].CompilePackage(DCC, SourcesL, IncludesL, Log, TempDir) then - Exit; - finally - IncludesL.Free; - DPKList.Free; end; - end; - end; + end; - Application.ProcessMessages; - end; + Application.ProcessMessages; + end; Result := True; + finally SourcesL.Free; SpFileOperation(TempDir, '', FO_DELETE); @@ -1591,10 +1769,10 @@ function TSpComponentPackageList.CompileAll(BaseFolder: string; IDE: TSpIDEType; procedure TSpExecuteList.LoadFromIni(Filename, Section: string); var - L, V: TStringList; + L, V : TStringList; ExecuteEntry: TSpExecuteEntry; - Action: TSpActionType; - I: integer; + Action : TSpActionType; + I : Integer; begin L := TStringList.Create; V := TStringList.Create; @@ -1602,16 +1780,18 @@ procedure TSpExecuteList.LoadFromIni(Filename, Section: string); Clear; SpIniLoadStringList(L, Filename, Section, rvExecuteIniPrefix); for I := 0 to L.Count - 1 do - if SpParseEntryValue(L[I], V, 3) then begin - Action := SpStringToActionType(V[0]); - if Action <> satNone then begin - ExecuteEntry := TSpExecuteEntry.Create; - ExecuteEntry.Action := Action; - ExecuteEntry.Origin := V[1]; - ExecuteEntry.Destination := V[2]; - Add(ExecuteEntry); + if SpParseEntryValue(L[I], V, 3) then + begin + Action := SpStringToActionType(V[0]); + if Action <> satNone then + begin + ExecuteEntry := TSpExecuteEntry.Create; + ExecuteEntry.Action := Action; + ExecuteEntry.Origin := V[1]; + ExecuteEntry.Destination := V[2]; + Add(ExecuteEntry); + end; end; - end; finally L.Free; V.Free; @@ -1620,7 +1800,7 @@ procedure TSpExecuteList.LoadFromIni(Filename, Section: string); function TSpExecuteList.ExecuteAll(BaseFolder: string; Log: TStrings): Boolean; var - I: Integer; + I : Integer; Item: TSpExecuteEntry; function ExecuteRun: Boolean; @@ -1630,52 +1810,59 @@ function TSpExecuteList.ExecuteAll(BaseFolder: string; Log: TStrings): Boolean; // Run it if it's a valid file Result := False; S := TPath.GetFileName(Item.Origin); - if S <> '' then begin - S := TPath.Combine(Item.Destination, S); - SpWriteLog(Log, SLogExecuting, S); - if SpExecuteDosCommand(S, Item.Destination, DosOutput) = 0 then begin - Log.Text := Log.Text + DosOutput + #13#10; - Result := True; - end - else - SpWriteLog(Log, SLogErrorExecuting, S, ''); - end; + if S <> '' then + begin + S := TPath.Combine(Item.Destination, S); + SpWriteLog(Log, SLogExecuting, [S]); + if SpExecuteDosCommand(S, Item.Destination, DosOutput) = 0 then + begin + Log.Text := Log.Text + DosOutput + sLineBreak; + Result := True; + end + else + SpWriteLog(Log, SLogErrorExecuting, [S]); + end; end; begin Result := False; // Check if the files exist - for I := 0 to Count - 1 do begin - Item := Items[I]; - Item.Origin := StringReplace(Item.Origin, rvBaseFolder, BaseFolder, [rfReplaceAll, rfIgnoreCase]); - Item.Destination := StringReplace(Item.Destination, rvBaseFolder, BaseFolder, [rfReplaceAll, rfIgnoreCase]); - if not TFile.Exists(Item.Origin) then begin - SpWriteLog(Log, SLogInvalidPath, Item.Origin); - Exit; + for I := 0 to Count - 1 do + begin + Item := Items[I]; + Item.Origin := StringReplace(Item.Origin, rvBaseFolder, BaseFolder, [rfReplaceAll, rfIgnoreCase]); + Item.Destination := StringReplace(Item.Destination, rvBaseFolder, BaseFolder, [rfReplaceAll, rfIgnoreCase]); + if not TFile.Exists(Item.Origin) then + begin + SpWriteLog(Log, SLogInvalidPath, [Item.Origin]); + Exit; + end; end; - end; // Execute - for I := 0 to Count - 1 do begin - Item := Items[I]; - case Item.Action of - satRun: - if not ExecuteRun then - Exit; - satCopy, satCopyRun: - if SpFileOperation(Item.Origin, Item.Destination, FO_COPY) then begin - SpWriteLog(Log, SLogCopying, Item.Origin, Item.Destination); - if Item.Action = satCopyRun then - if not ExecuteRun then + for I := 0 to Count - 1 do + begin + Item := Items[I]; + case Item.Action of + satRun: + if not ExecuteRun then + Exit; + satCopy, satCopyRun: + if SpFileOperation(Item.Origin, Item.Destination, FO_COPY) then + begin + SpWriteLog(Log, SLogCopying, [Item.Origin, Item.Destination]); + if Item.Action = satCopyRun then + if not ExecuteRun then + Exit; + end + else + begin + SpWriteLog(Log, SLogErrorCopying, [Item.Origin, Item.Destination]); Exit; - end - else begin - SpWriteLog(Log, SLogErrorCopying, Item.Origin, Item.Destination); - Exit; - end; + end; + end; end; - end; Result := True; end; @@ -1706,13 +1893,13 @@ function TSpMultiInstaller.Install(ZipPath, BaseFolder: string; IDE: TSpIDEType; N := GetTickCount; if ComponentPackages.ExtractAllZips(ZipPath, BaseFolder, Log) then if ComponentPackages.ExecuteAll(BaseFolder, Log) then - if ComponentPackages.CompileAll(BaseFolder, IDE, Log) then begin - Secs := (GetTickCount - N) / 1000; - SpWriteLog(Log, SLogEnd, ''); - Log.Add(Format(SLogFinished, [Secs])); + if ComponentPackages.CompileAll(BaseFolder, IDE, Log) then + begin + Secs := (GetTickCount - N) / 1000; + SpWriteLog(Log, SLogEnd, []); + Log.Add(Format(SLogFinished, [Secs])); - // [IDE-Change] - if IDE >= ideDelphi2007 then begin + // [IDE-Change] // From the Delphi 2007 readme: // http://edn.embarcadero.com/article/36648 // If you your component installer updates paths in Delphi's registry to include paths @@ -1727,10 +1914,9 @@ function TSpMultiInstaller.Install(ZipPath, BaseFolder: string; IDE: TSpIDEType; // Vista/7/8: C:\Users\...\AppData\Roaming\Borland\BDS\5.0 // C:\Users\...\AppData\Roaming\Embarcadero\BDS\15.0 SpWriteRegValue(IDETypes[IDE].IDERegistryPath + '\Globals', 'ForceEnvOptionsUpdate', '1'); - end; - Result := True; - end; + Result := True; + end; finally FInstalling := False; end; diff --git a/Source/unit1.pas b/Source/unit1.pas deleted file mode 100644 index 3dcf09b..0000000 --- a/Source/unit1.pas +++ /dev/null @@ -1,411 +0,0 @@ -unit Unit1; - -interface - -{$WARN SYMBOL_PLATFORM OFF} -{$WARN UNIT_PLATFORM OFF} -{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation - -// {$DEFINE SPDEBUGMODE} // Uncomment to debug - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ComCtrls, StdCtrls, ExtCtrls, ActnList, CheckLst, Contnrs, - IniFiles, Actions, SpComponentInstaller; - -const - rvMultiInstallerVersion = 'Silverpoint MultiInstaller 3.5.10'; - rvMultiInstallerLink = 'http://www.silverpointdevelopment.com'; - -resourcestring - SWelcomeTitle = 'Welcome to the Silverpoint MultiInstaller Setup Wizard'; - SDestinationTitle = 'Select Destination Folder'; - SInstallingTitle = 'Installing...'; - SFinishTitle = 'Completing the MultiInstaller Setup Wizard'; - - SCloseDelphi = 'Close Delphi to continue.'; - SErrorLabel = 'There were errors found in the setup, check the log.'; - SErrorInvalidBasePath = 'The directory doesn''t exist.'; - -type - TForm1 = class(TForm) - PageControl1: TPageControl; - TabSheet1: TTabSheet; - TabSheet2: TTabSheet; - TabSheet3: TTabSheet; - Panel1: TPanel; - ButtonNext: TButton; - ButtonBack: TButton; - Panel2: TPanel; - LabelTitle: TLabel; - Label1: TLabel; - ButtonCancel: TButton; - InstallFolderEdit: TEdit; - ButtonBrowse: TButton; - Label2: TLabel; - ActionList1: TActionList; - aBack: TAction; - aNext: TAction; - aCancel: TAction; - aBrowse: TAction; - RadioGroup1: TRadioGroup; - CompileCheckbox: TCheckBox; - Label3: TLabel; - FinishLabel: TLabel; - ButtonFinish: TButton; - Bevel1: TBevel; - Button1: TButton; - aSaveLog: TAction; - aFinish: TAction; - SaveDialog1: TSaveDialog; - LogMemo: TMemo; - CheckListBox1: TCheckListBox; - Timer1: TTimer; - Bevel2: TBevel; - PaintBoxLabel: TPaintBox; - Image1: TImage; - CheckBox1: TCheckBox; - procedure FormCreate(Sender: TObject); - procedure aBrowseExecute(Sender: TObject); - procedure aBackExecute(Sender: TObject); - procedure aNextExecute(Sender: TObject); - procedure aCancelExecute(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure CompileCheckboxClick(Sender: TObject); - procedure aSaveLogExecute(Sender: TObject); - procedure aFinishExecute(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure CheckListBox1DrawItem(Control: TWinControl; Index: Integer; - Rect: TRect; State: TOwnerDrawState); - procedure CheckListBox1MeasureItem(Control: TWinControl; - Index: Integer; var Height: Integer); - procedure CheckListBox1ClickCheck(Sender: TObject); - procedure Timer1Timer(Sender: TObject); - procedure PaintBoxLabelPaint(Sender: TObject); - procedure PaintBoxLabelClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - AppPath: string; - Installer: TSpMultiInstaller; - procedure FillCheckListBox; - procedure FillRadioGroup; - function ValidateCheckListBox: Boolean; - function ChangePage(Next: Boolean): Boolean; - function Install: Boolean; - procedure CloseDelphi; - end; - -var - Form1: TForm1; - -implementation - -{$R *.dfm} - -uses - System.UITypes; - -const - rvSetupIni = 'Setup.Ini'; - crIDC_HAND = 32649; - -//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM -{ Form UI } - -procedure TForm1.FormCreate(Sender: TObject); -begin - Screen.Cursors[crIDC_HAND] := LoadCursor(0, IDC_HAND); - PaintBoxLabel.Cursor := crIDC_HAND; - AppPath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)); - - Installer := TSpMultiInstaller.Create(AppPath + rvSetupIni); - PageControl1.ActivePageIndex := 0; - LabelTitle.Caption := SWelcomeTitle; - SaveDialog1.InitialDir := AppPath; - FillCheckListBox; - FillRadioGroup; - ValidateCheckListBox; - - {$IFDEF SPDEBUGMODE} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} -end; - -procedure TForm1.FormDestroy(Sender: TObject); -begin - Installer.Free; -end; - -procedure TForm1.FormShow(Sender: TObject); -begin - CloseDelphi; - - if DirectoryExists(Installer.ComponentPackages.DefaultInstallFolder) then begin - InstallFolderEdit.Text := Installer.ComponentPackages.DefaultInstallFolder; - if CompileCheckbox.Checked then begin - PageControl1.ActivePageIndex := PageControl1.PageCount - 1; - Timer1.Enabled := True; // Delay it a little for UI responsiveness - end; - end; -end; - -procedure TForm1.Timer1Timer(Sender: TObject); -begin - Timer1.Enabled := False; - Install; -end; - -function TForm1.ChangePage(Next: Boolean): Boolean; -var - I, C: Integer; -begin - Result := False; - I := PageControl1.ActivePageIndex; - C := PageControl1.PageCount - 1; - - if Next then begin - if I = C then Exit - else - if I = 1 then - if not DirectoryExists(InstallFolderEdit.Text) then begin - MessageDlg(SErrorInvalidBasePath, mtWarning, [mbOK], 0); - Exit; - end; - end - else - if I = 0 then Exit; - - Result := True; - if Next then inc(I) - else dec(I); - PageControl1.ActivePageIndex := I; - - ButtonBack.Enabled := I > 0; - case I of - 0: LabelTitle.Caption := SWelcomeTitle; - 1: LabelTitle.Caption := SDestinationTitle; - 2: begin - LabelTitle.Caption := SInstallingTitle; - Timer1.Enabled := True; // Delay it a little for UI responsiveness - end; - else - LabelTitle.Caption := ''; - end; -end; - -procedure TForm1.CompileCheckboxClick(Sender: TObject); -begin - RadioGroup1.Enabled := CompileCheckbox.Checked; -end; - -procedure TForm1.FillCheckListBox; -var - I, G, P: Integer; -begin - for I := 0 to Installer.ComponentPackages.Count - 1 do begin - P := -1; - G := Installer.ComponentPackages[I].GroupIndex; - if G > 0 then begin - P := CheckListBox1.Items.IndexOfObject(Pointer(G)); - if P > -1 then - CheckListBox1.Items[P] := CheckListBox1.Items[P] + #13#10 + Installer.ComponentPackages[I].Name; - end; - - if P = -1 then begin - P := CheckListBox1.Items.AddObject(Installer.ComponentPackages[I].Name, Pointer(G)); - CheckListBox1.Checked[P] := True; - if Installer.ComponentPackages[I].Git <> '' then - CheckListBox1.Items[P] := CheckListBox1.Items[P] + #13#10 + - 'GIT: ' + Installer.ComponentPackages[I].Git; - end; - end; -end; - -procedure TForm1.FillRadioGroup; -var - IDE: TSpIDEType; -begin - RadioGroup1.ItemIndex := -1; - - for IDE := Low(TSpIDEType) to High(TSpIDEType) do - if IDE >= Installer.ComponentPackages.MinimumIDE then - if TSpDelphiIDE.Installed(IDE) then begin - RadioGroup1.Items.AddObject(IDETypes[IDE].IDEName, Pointer(Ord(IDE))); - if IDE = Installer.ComponentPackages.DefaultInstallIDE then - RadioGroup1.ItemIndex := RadioGroup1.Items.Count - 1; - end; - - if RadioGroup1.ItemIndex = -1 then - RadioGroup1.ItemIndex := RadioGroup1.Items.Count - 1 - else - CompileCheckbox.Checked := True; -end; - -function TForm1.ValidateCheckListBox: Boolean; -var - I: Integer; -begin - Result := False; - for I := 0 to CheckListBox1.Count - 1 do - if CheckListBox1.Checked[I] then begin - Result := True; - Break; - end; - - ButtonNext.Enabled := Result; -end; - -procedure TForm1.CheckListBox1ClickCheck(Sender: TObject); -begin - ValidateCheckListBox; -end; - -procedure TForm1.CheckListBox1MeasureItem(Control: TWinControl; - Index: Integer; var Height: Integer); -var - R: TRect; -begin - if Index > -1 then - Height := DrawText(CheckListBox1.Canvas.Handle, PChar(CheckListBox1.Items[Index]), -1, R, DT_CALCRECT) + 4; -end; - -procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; - Index: Integer; Rect: TRect; State: TOwnerDrawState); -begin - if Index > -1 then begin - CheckListBox1.Canvas.FillRect(Rect); - OffsetRect(Rect, 8, 2); - DrawText(CheckListBox1.Canvas.Handle, PChar(CheckListBox1.Items[Index]), -1, Rect, 0); - end; -end; - -procedure TForm1.PaintBoxLabelPaint(Sender: TObject); -var - C: TCanvas; -begin - C := PaintBoxLabel.Canvas; - C.Brush.Style := bsClear; - C.Font.Color := clBtnHighlight; - C.TextOut(1, 1, rvMultiInstallerVersion); - C.Font.Color := clBtnShadow; - C.TextOut(0, 0, rvMultiInstallerVersion); -end; - -procedure TForm1.PaintBoxLabelClick(Sender: TObject); -begin - SpOpenLink(rvMultiInstallerLink); -end; - -//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM -{ Actions } - -procedure TForm1.aBackExecute(Sender: TObject); -begin - ChangePage(False); -end; - -procedure TForm1.aNextExecute(Sender: TObject); -begin - ChangePage(True); -end; - -procedure TForm1.aCancelExecute(Sender: TObject); -begin - Close; -end; - -procedure TForm1.aFinishExecute(Sender: TObject); -begin - Close; -end; - -procedure TForm1.aSaveLogExecute(Sender: TObject); -begin - if SaveDialog1.Execute then - LogMemo.Lines.SaveToFile(SaveDialog1.FileName); -end; - -procedure TForm1.aBrowseExecute(Sender: TObject); -var - D: string; -begin - if SpSelectDirectory('', D) then - InstallFolderEdit.Text := D; -end; - -//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM -{ Install } - -procedure TForm1.CloseDelphi; -var - Cancel: Boolean; -begin - {$IFDEF SPDEBUGMODE} - Exit; - {$ENDIF} - - Cancel := False; - while not Cancel and ((FindWindow('TAppBuilder', nil) <> 0) or (FindWindow('TAppBuilder', nil) <> 0)) do - Cancel := MessageDlg(SCloseDelphi, mtWarning, [mbOK, mbCancel], 0) = mrCancel; - if Cancel then - Close; -end; - -function TForm1.Install: Boolean; -var - I, J, G: Integer; - IDE: TSpIDEType; -begin - Result := False; - CloseDelphi; - - // Get IDE version - IDE := ideNone; - I := RadioGroup1.ItemIndex; - if (CompileCheckbox.Checked) and (I > -1) and Assigned(RadioGroup1.Items.Objects[I]) then - IDE := TSpIDEType(RadioGroup1.Items.Objects[I]); - - // Delete unchecked components from the ComponentPackages list - for I := 0 to CheckListBox1.Count - 1 do - if not CheckListBox1.Checked[I] then begin - G := Integer(CheckListBox1.Items.Objects[I]); - for J := Installer.ComponentPackages.Count - 1 downto 0 do - if (G > 0) and (Installer.ComponentPackages[J].GroupIndex = G) then - Installer.ComponentPackages.Delete(J) - else - if CheckListBox1.items[I].Contains(Installer.ComponentPackages[J].Name) then - Installer.ComponentPackages.Delete(J); - end; - - // Prioritize GIT over ZIP - if CheckBox1.Checked then begin - for J := 0 to Installer.ComponentPackages.Count - 1 do - if not Installer.ComponentPackages[J].Git.IsEmpty then - Installer.ComponentPackages[J].ZipFile := ''; - end; - - aFinish.Visible := True; - aSaveLog.Visible := True; - aBack.Visible := False; - aNext.Visible := False; - aCancel.Visible := False; - Application.ProcessMessages; - try - // Check, Unzip, Patch, Compile, Install - if Installer.Install(AppPath, InstallFolderEdit.Text, IDE, LogMemo.Lines) then - Result := True; - finally - LabelTitle.Caption := SFinishTitle; - aFinish.Enabled := True; - aSaveLog.Enabled := True; - if not Result then begin - FinishLabel.Font.Color := clRed; - FinishLabel.Caption := SErrorLabel; - end; - FinishLabel.Visible := True; - end; -end; - -end.