diff --git a/Delphi/Project/ExercismCLIInstaller.dpr b/Delphi/Project/ExercismCLIInstaller.dpr index aad2c3c..804ae6f 100644 --- a/Delphi/Project/ExercismCLIInstaller.dpr +++ b/Delphi/Project/ExercismCLIInstaller.dpr @@ -11,19 +11,15 @@ uses {$R *.res} -var LoopStatus, - ResultStatus: TResultStatus; - i: integer; - InstallInfo: TInstallInfo; - begin + var InstallInfo: TInstallInfo; fillchar(InstallInfo, sizeof(TInstallInfo), #0); Application.Initialize; Application.MainFormOnTaskbar := True; - i := 0; - LoopStatus := rsContinue; - ResultStatus := rsCancel; + var i := 0; + var LoopStatus := rsContinue; repeat + var ResultStatus := rsCancel; case i of 0: ResultStatus := ShowInstallLocationForm(InstallInfo); 1: ResultStatus := ShowClientDownloadForm(InstallInfo); diff --git a/Delphi/Project/ExercismCLIInstaller.dproj b/Delphi/Project/ExercismCLIInstaller.dproj index 667d427..66a8212 100644 --- a/Delphi/Project/ExercismCLIInstaller.dproj +++ b/Delphi/Project/ExercismCLIInstaller.dproj @@ -4,10 +4,10 @@ ExercismCLIInstaller.dpr True Release - 1153 + 1025 Application VCL - 18.4 + 18.7 Win32 @@ -18,11 +18,6 @@ Base true - - true - Base - true - true Base @@ -82,10 +77,6 @@ Win32\ Win32\ - - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - RELEASE;$(DCC_Define) 0 @@ -97,16 +88,16 @@ true - true true Win32\Release - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.5.3.2;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.5;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.5.3.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.5;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) Win32\Release 5 3 - 2 + 4 true true + PerMonitor DEBUG;$(DCC_Define) @@ -118,11 +109,11 @@ true - true true CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) Win32\Debug Win32\Debug + PerMonitor @@ -166,9 +157,7 @@ True - True True - False @@ -178,6 +167,12 @@ true + + + ExercismCLIInstaller.exe + true + + 1 @@ -187,7 +182,6 @@ 1 - Contents\MacOS 0 @@ -197,6 +191,12 @@ 1 + + + res\xml + 1 + + library\lib\armeabi-v7a @@ -233,6 +233,18 @@ 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + res\drawable @@ -269,6 +281,36 @@ 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + res\drawable-small @@ -293,6 +335,12 @@ 1 + + + res\values + 1 + + 1 @@ -311,6 +359,11 @@ 1 .framework + + Contents\MacOS + 1 + .framework + 0 @@ -333,6 +386,11 @@ 1 .dylib + + Contents\MacOS + 1 + .dylib + 0 .dll;.bpl @@ -356,6 +414,11 @@ 1 .dylib + + Contents\MacOS + 1 + .dylib + 0 .bpl @@ -378,6 +441,10 @@ Contents\Resources\StartUp\ 0 + + Contents\Resources\StartUp\ + 0 + 0 @@ -393,6 +460,17 @@ 1 + + + 1 + + + 1 + + + 1 + + 1 @@ -404,6 +482,39 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -415,6 +526,61 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -426,6 +592,116 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -459,6 +735,28 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -514,23 +812,41 @@ 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + ..\ 1 + + ..\ + 1 + Contents 1 + + Contents + 1 + Contents\Resources 1 + + Contents\Resources + 1 + @@ -553,6 +869,10 @@ Contents\MacOS 1 + + Contents\MacOS + 1 + 0 @@ -592,6 +912,7 @@ + diff --git a/Delphi/Project/Source/uClientDownloadFrm.dfm b/Delphi/Project/Source/uClientDownloadFrm.dfm index 763a0cf..f8910c5 100644 --- a/Delphi/Project/Source/uClientDownloadFrm.dfm +++ b/Delphi/Project/Source/uClientDownloadFrm.dfm @@ -111,24 +111,6 @@ object frmDownload: TfrmDownload ParentFont = False Transparent = True end - object urlDocs: TOvcURL - Left = 404 - Top = 32 - Width = 125 - Height = 18 - Hint = 'http://cli.exercism.io' - Caption = 'CLI Documentation' - URL = 'http://cli.exercism.io' - UseVisitedColor = True - Font.Charset = DEFAULT_CHARSET - Font.Color = clWhite - Font.Height = -15 - Font.Name = 'Tahoma' - Font.Style = [fsUnderline] - ParentFont = False - Transparent = True - Visible = False - end object imgV2Logo: TImage Left = 5 Top = 7 @@ -6284,6 +6266,22 @@ object frmDownload: TfrmDownload FFFF} Stretch = True end + object urlDocs: TLinkLabel + Left = 404 + Top = 32 + Width = 150 + Height = 22 + Caption = 'https://exercism.io/cli/' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 0 + Visible = False + OnLinkClick = urlDocsLinkClick + end end object btnCancel: TButton Left = 421 @@ -6344,7 +6342,6 @@ object frmDownload: TfrmDownload AcceptCharset = 'UTF-8, *;q=0.8' BaseURL = 'https://api.github.com/repos/exercism/cli/releases/latest' Params = <> - HandleRedirects = True RaiseExceptionOn500 = False Left = 52 Top = 124 diff --git a/Delphi/Project/Source/uClientDownloadFrm.pas b/Delphi/Project/Source/uClientDownloadFrm.pas index 3585bd2..1270ed8 100644 --- a/Delphi/Project/Source/uClientDownloadFrm.pas +++ b/Delphi/Project/Source/uClientDownloadFrm.pas @@ -11,7 +11,7 @@ interface FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, REST.Response.Adapter, REST.Client, Data.Bind.Components, Data.Bind.ObjectScope, System.Types, System.Net.HttpClient, System.UITypes, - Vcl.Imaging.pngimage, ovcurl; + Vcl.Imaging.pngimage, REST.Types; type Tos = class @@ -55,11 +55,11 @@ TfrmDownload = class(TForm) btnStopDownload: TButton; Label4: TLabel; btnFinish: TButton; - urlDocs: TOvcURL; Root: TRESTResponseDataSetAdapter; tableRoot: TFDMemTable; Image1: TImage; imgV2Logo: TImage; + urlDocs: TLinkLabel; procedure btnCancelClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure tmrDownloadTimer(Sender: TObject); @@ -68,6 +68,8 @@ TfrmDownload = class(TForm) procedure tmrInstallTimer(Sender: TObject); procedure btnStopDownloadClick(Sender: TObject); procedure btnFinishClick(Sender: TObject); + procedure urlDocsLinkClick(Sender: TObject; const Link: string; + LinkType: TSysLinkType); private { Private declarations } InstallInfo : TInstallInfo; @@ -99,7 +101,7 @@ TfrmDownload = class(TForm) function NewAssets(aFDMemTable: TFDMemTable): IAssetsURL; implementation -uses System.IOUtils, System.Zip, uUpdatePath; +uses System.IOUtils, System.Zip, uUpdatePath, Vcl.ExtActns; {$R *.dfm} type TAssetsURL = class(TInterfacedObject, IAssetsURL) @@ -192,10 +194,8 @@ procedure TfrmDownload.btnStopDownloadClick(Sender: TObject); end; procedure TfrmDownload.FormCreate(Sender: TObject); -var - TLSProts: THTTPSecureProtocols; begin - TLSProts := [THTTPSecureProtocol.TLS12]; + var TLSProts: THTTPSecureProtocols := [THTTPSecureProtocol.TLS12]; RESTClient1.SecureProtocols := TLSProts; FClient := THTTPClient.Create; FClient.SecureProtocols := TLSProts; @@ -319,18 +319,14 @@ function TfrmDownload.FetchDownloadURL(const aIs32BitWindows: Boolean; var aStat end; procedure TfrmDownload.Download_CLI_ZIP(aDownloadURL: IDownloadURL; var aStatus: TResultStatus); -var - lFilename: string; - URL: string; - LSize: Int64; begin aStatus := rsCancel; - LFileName := TPath.Combine(InstallInfo.Path, 'exercism.zip'); + var lFileName := TPath.Combine(InstallInfo.Path, 'exercism.zip'); try FAsyncResponse := nil; - URL := aDownloadURL.Url; + var URL := aDownloadURL.Url; - LSize := aDownloadURL.DownloadSize; + var LSize := aDownloadURL.DownloadSize; ProgressBarDownload.Max := LSize; ProgressBarDownload.Min := 0; @@ -359,13 +355,11 @@ procedure TfrmDownload.Download_CLI_ZIP(aDownloadURL: IDownloadURL; var aStatus: end; procedure TfrmDownload.Unzip_CLI(var aStatus: TResultStatus); -var - lFilename: string; begin aStatus := rsCancel; mStatus.Lines.Add(format('Unzipping CLI to %s',[InstallInfo.Path])); + var lFilename := TPath.Combine(InstallInfo.Path,'exercism.zip'); try - lFilename := TPath.Combine(InstallInfo.Path,'exercism.zip'); TZipFile.ExtractZipFile(lFilename, TPath.Combine(InstallInfo.Path,'')); aStatus := rsNext; mStatus.Lines.Add('CLI Extraction Successful'); @@ -387,6 +381,15 @@ procedure TfrmDownload.Update_PATH(var aStatus: TResultStatus); mStatus.Lines.Add(format('Folder "%s" NOT added to Path.',[InstallInfo.Path])); end; +procedure TfrmDownload.urlDocsLinkClick(Sender: TObject; const Link: string; + LinkType: TSysLinkType); +begin + var Browser := TBrowseUrl.Create(self); + Browser.URL := Link; + Browser.Execute; + Browser.DisposeOf; +end; + procedure TfrmDownload.tmrDownloadTimer(Sender: TObject); var lIs32BitWindows: boolean; diff --git a/Delphi/Project/Source/uConfigApiFrm.dfm b/Delphi/Project/Source/uConfigApiFrm.dfm index 5202232..06588ad 100644 --- a/Delphi/Project/Source/uConfigApiFrm.dfm +++ b/Delphi/Project/Source/uConfigApiFrm.dfm @@ -33,23 +33,6 @@ object frmConfigAPI: TfrmConfigAPI ParentFont = False WordWrap = True end - object OvcURL1: TOvcURL - Left = 200 - Top = 182 - Width = 216 - Height = 16 - Hint = 'http://exercism.io/account/key' - Caption = 'I don'#39't have or don'#39't know my API key' - URL = 'http://exercism.io/account/key' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -13 - Font.Name = 'Tahoma' - Font.Style = [fsUnderline] - ParentFont = False - ParentShowHint = False - ShowHint = True - end object Label4: TLabel Left = 11 Top = 127 @@ -233,6 +216,23 @@ object frmConfigAPI: TfrmConfigAPI TabOrder = 6 OnClick = btnBrowseClick end + object LinkLabel1: TLinkLabel + Left = 200 + Top = 182 + Width = 183 + Height = 20 + Caption = + 'https://exercism.io/my' + + '/settings' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 7 + OnLinkClick = LinkLabel1LinkClick + end object DosCommand1: TDosCommand InputToOutput = True MaxTimeAfterBeginning = 0 diff --git a/Delphi/Project/Source/uConfigApiFrm.pas b/Delphi/Project/Source/uConfigApiFrm.pas index ee1e82e..f180905 100644 --- a/Delphi/Project/Source/uConfigApiFrm.pas +++ b/Delphi/Project/Source/uConfigApiFrm.pas @@ -4,7 +4,7 @@ interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, - Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, ovcurl, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, uTypes, Vcl.Imaging.pngimage, DosCommand; type @@ -15,7 +15,6 @@ TfrmConfigAPI = class(TForm) btnFinish: TButton; Label3: TLabel; fldAPI: TEdit; - OvcURL1: TOvcURL; Label4: TLabel; btnConfigure: TButton; DosCommand1: TDosCommand; @@ -25,12 +24,15 @@ TfrmConfigAPI = class(TForm) Label5: TLabel; Label6: TLabel; Image1: TImage; + LinkLabel1: TLinkLabel; procedure btnFinishClick(Sender: TObject); procedure fldChanging(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnConfigureClick(Sender: TObject); procedure DosCommand1Terminated(Sender: TObject); procedure btnBrowseClick(Sender: TObject); + procedure LinkLabel1LinkClick(Sender: TObject; const Link: string; + LinkType: TSysLinkType); private { Private declarations } InstallInfo: TInstallInfo; @@ -44,7 +46,8 @@ TfrmConfigAPI = class(TForm) implementation uses System.IOUtils, - Vcl.FileCtrl; + Vcl.FileCtrl, + Vcl.ExtActns; {$R *.dfm} function ShowConfigAPIForm(const aInstallInfo: TInstallInfo): TResultStatus; @@ -63,14 +66,12 @@ function ShowConfigAPIForm(const aInstallInfo: TInstallInfo): TResultStatus; procedure TfrmConfigAPI.btnFinishClick(Sender: TObject); begin - close; + close; end; procedure TfrmConfigAPI.btnBrowseClick(Sender: TObject); -var - folder: string; begin - folder := fldSolutionLocation.Text; + var folder: string := fldSolutionLocation.Text; if Vcl.FileCtrl.SelectDirectory('Select Solution Location', '', folder, [sdNewUI, sdNewFolder], Self) then begin fldSolutionLocation.Text := folder; @@ -81,14 +82,11 @@ procedure TfrmConfigAPI.btnBrowseClick(Sender: TObject); procedure TfrmConfigAPI.btnConfigureClick(Sender: TObject); procedure MakeBat; - var - lBatFile: TStringlist; - lCommandLine: string; begin - lBatFile := TStringlist.Create; + var lBatFile := TStringlist.Create; lBatFile.Add('@echo off'); lBatFile.Add(format('cd "%s"',[InstallInfo.Path])); - lCommandLine := format('%s %s --key=%s --dir="%s"', + var lCommandLine := format('%s %s --key=%s --dir="%s"', ['exercism.exe', 'configure', fldAPI.Text, fldSolutionLocation.Text]); lBatFile.Add(lCommandLine); lBatFile.Add('exit'); @@ -96,13 +94,11 @@ procedure TfrmConfigAPI.btnConfigureClick(Sender: TObject); lBatFile.DisposeOf; end; -var - lCommandLine: string; begin MakeBat; btnConfigure.Enabled := false; DosCommand1.CurrentDir := InstallInfo.Path; - lCommandLine := TPath.Combine(InstallInfo.Path,'config.bat'); + var lCommandLine := TPath.Combine(InstallInfo.Path,'config.bat'); DosCommand1.CommandLine := lCommandLine; DosCommand1.Execute; end; @@ -115,11 +111,9 @@ procedure TfrmConfigAPI.DosCommand1Terminated(Sender: TObject); end; procedure TfrmConfigAPI.fldChanging(Sender: TObject); -var - lAPI, lLocation: string; begin - lAPI := fldAPI.Text; - lLocation := fldSolutionLocation.Text; + var lAPI: string := fldAPI.Text; + var lLocation: string := fldSolutionLocation.Text; btnConfigure.Enabled := not (lAPI.IsEmpty or lLocation.IsEmpty);; end; @@ -128,4 +122,13 @@ procedure TfrmConfigAPI.FormCreate(Sender: TObject); SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW); end; +procedure TfrmConfigAPI.LinkLabel1LinkClick(Sender: TObject; const Link: string; + LinkType: TSysLinkType); +begin + var Browser := TBrowseUrl.Create(self); + Browser.URL := Link; + Browser.Execute; + Browser.DisposeOf; +end; + end. diff --git a/Delphi/Project/Source/uInstallLocationFrm.dfm b/Delphi/Project/Source/uInstallLocationFrm.dfm index bae30c9..0eae5c4 100644 --- a/Delphi/Project/Source/uInstallLocationFrm.dfm +++ b/Delphi/Project/Source/uInstallLocationFrm.dfm @@ -15,7 +15,9 @@ object frmInstallLocation: TfrmInstallLocation Font.Style = [] OldCreateOrder = False Position = poScreenCenter + OnActivate = FormActivate OnCreate = FormCreate + OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Label3: TLabel @@ -48,27 +50,78 @@ object frmInstallLocation: TfrmInstallLocation Caption = 'By clicking &Next you accept the' Transparent = True end - object OvcURL4: TOvcURL - Left = 311 - Top = 193 - Width = 91 - Height = 13 - Hint = - 'https://github.com/exercism/windows-installer/blob/master/LICENS' + - 'E' - Caption = 'License Agreement' - URL = - 'https://github.com/exercism/windows-installer/blob/master/LICENS' + - 'E' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [fsUnderline] - ParentFont = False - ParentShowHint = False - ShowHint = True - Transparent = True + object pnlPreexistingCLI: TPanel + Left = 8 + Top = 88 + Width = 624 + Height = 169 + ParentBackground = False + ShowCaption = False + TabOrder = 6 + Visible = False + object Label6: TLabel + Left = 23 + Top = 12 + Width = 578 + Height = 36 + AutoSize = False + Caption = + 'A copy of the Exercism CLI has been found already installed on t' + + 'his system. Only one copy of the CLI should be installed and al' + + 'l other copies removed.' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + WordWrap = True + end + object Label7: TLabel + Left = 81 + Top = 64 + Width = 462 + Height = 18 + Caption = + 'Would you like to install the CLI where the previous version was' + + ' found?' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object btnYes: TButton + Left = 220 + Top = 92 + Width = 75 + Height = 25 + Caption = 'Yes' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 0 + OnClick = btnYesClick + end + object btnNo: TButton + Left = 328 + Top = 92 + Width = 75 + Height = 25 + Caption = 'No' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 1 + OnClick = btnNoClick + end end object Panel1: TPanel Left = 0 @@ -6366,4 +6419,18 @@ object frmInstallLocation: TfrmInstallLocation TabOrder = 4 OnClick = btnBrowseClick end + object LinkLabel1: TLinkLabel + Left = 311 + Top = 193 + Width = 95 + Height = 17 + Hint = + 'https://github.com/exercism/windows-installer/blob/master/LICENS' + + 'E' + Caption = + 'License Agreement' + TabOrder = 5 + OnLinkClick = LinkLabel1LinkClick + end end diff --git a/Delphi/Project/Source/uInstallLocationFrm.pas b/Delphi/Project/Source/uInstallLocationFrm.pas index dcd6a6a..0fc822f 100644 --- a/Delphi/Project/Source/uInstallLocationFrm.pas +++ b/Delphi/Project/Source/uInstallLocationFrm.pas @@ -1,14 +1,14 @@ unit uInstallLocationFrm; -{_define SimTLSCheckFailure} -{$define SkipTLSCheck} interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uTypes, Vcl.StdCtrls, Vcl.ExtCtrls, - Vcl.Imaging.pngimage, System.UITypes, ovcurl; + Vcl.Imaging.pngimage, System.Generics.Collections, System.UITypes, Vcl.Buttons; type + TCLIPresent = class; + TfrmInstallLocation = class(TForm) Panel1: TPanel; Label1: TLabel; @@ -20,34 +20,62 @@ TfrmInstallLocation = class(TForm) btnBrowse: TButton; Label4: TLabel; Label5: TLabel; - OvcURL4: TOvcURL; Image1: TImage; imgV2Logo: TImage; + LinkLabel1: TLinkLabel; + pnlPreexistingCLI: TPanel; + Label6: TLabel; + Label7: TLabel; + btnYes: TButton; + btnNo: TButton; procedure btnCancelClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure btnBrowseClick(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure LinkLabel1LinkClick(Sender: TObject; const Link: string; + LinkType: TSysLinkType); + procedure FormDestroy(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure btnYesClick(Sender: TObject); + procedure btnNoClick(Sender: TObject); private { Private declarations } + OldCLIPresent: TCLIPresent; public { Public declarations } NextClicked: boolean; end; + TCLIPresent = class + strict private + const + CliFilename = 'exercism.exe'; + var + FInstallTo: string; + FListOfFinds: TList; + FIsPresent: Boolean; + FNumberFound: Integer; + function GetPath: string; + public + constructor Create; + destructor Destroy; override; + procedure FindPreexistingCLI; + property InstallTo: string read FInstallTo; + property IsPresent: Boolean read FIsPresent; + property NumberFound: Integer read FNumberFound; + end; + function ShowInstallLocationForm(var aInstallInfo: TInstallInfo): TResultStatus; implementation uses - Vcl.FileCtrl; + StrUtils, Vcl.FileCtrl, Vcl.ExtActns, Registry; {$R *.dfm} -var - thisForm: TfrmInstallLocation; - function ShowInstallLocationForm(var aInstallInfo: TInstallInfo): TResultStatus; begin result := rsCancel; - thisForm := TfrmInstallLocation.Create(nil); + var thisForm := TfrmInstallLocation.Create(nil); try thisForm.ShowModal; if thisForm.NextClicked then @@ -61,10 +89,8 @@ function ShowInstallLocationForm(var aInstallInfo: TInstallInfo): TResultStatus; end; procedure TfrmInstallLocation.btnBrowseClick(Sender: TObject); -var - folder: string; begin - folder := fldLocation.Text; + var folder: string := fldLocation.Text; if vcl.FileCtrl.SelectDirectory('Select Install Location', '', Folder, [sdNewUI, sdNewFolder], Self) then begin fldLocation.Text := folder; @@ -77,13 +103,11 @@ procedure TfrmInstallLocation.btnCancelClick(Sender: TObject); end; procedure TfrmInstallLocation.btnNextClick(Sender: TObject); -var lOKNext: boolean; - lDlgResult: word; begin - lOKNext := true; + var lOKNext := true; if not System.SysUtils.DirectoryExists(fldLocation.Text) then begin - lDlgResult := MessageDlg(format('Directory "%s" does not exist.'+#13#10+ + var lDlgResult := MessageDlg(format('Directory "%s" does not exist.'+#13#10+ 'Shall I create it for you?', [fldLocation.Text]),mtError, [mbYes, mbNo],0); if lDlgResult = mrYes then @@ -110,10 +134,97 @@ procedure TfrmInstallLocation.btnNextClick(Sender: TObject); end; end; +procedure TfrmInstallLocation.btnNoClick(Sender: TObject); +begin + pnlPreexistingCLI.Visible := false; + MessageDlg('Please remove all copies of the CLI before attempting to install the latest version.', mtInformation, [mbOk], 0); + btnCancel.Click; +end; + +procedure TfrmInstallLocation.FormActivate(Sender: TObject); +begin + OldCLIPresent.FindPreexistingCLI; + if OldCLIPresent.IsPresent then + begin + pnlPreexistingCLI.BringToFront; + pnlPreexistingCLI.Visible := true; + btnNext.Enabled := false; + end; +end; + procedure TfrmInstallLocation.FormCreate(Sender: TObject); begin NextClicked := false; + OldCLIPresent := TCLIPresent.Create; SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW); end; +procedure TfrmInstallLocation.FormDestroy(Sender: TObject); +begin + OldCLIPresent.DisposeOf; +end; + +procedure TfrmInstallLocation.LinkLabel1LinkClick(Sender: TObject; + const Link: string; LinkType: TSysLinkType); +begin + var Browser := TBrowseUrl.Create(self); + Browser.URL := Link; + Browser.Execute; + Browser.DisposeOf; +end; + +procedure TfrmInstallLocation.btnYesClick(Sender: TObject); +begin + pnlPreexistingCLI.Visible := false; + fldLocation.Text := OldCLIPresent.InstallTo; + btnNext.Enabled := True; +end; + +{ TCLIPresent } + +constructor TCLIPresent.Create; +begin + inherited; + FListOfFinds := TList.Create; +end; + +destructor TCLIPresent.Destroy; +begin + FListOfFinds.DisposeOf; + inherited; +end; + +procedure TCLIPresent.FindPreexistingCLI; +begin + var PathArray := GetPath.Split([';']); + for var aPath in PathArray do + begin + var fixedPath := aPath; + if not fixedPath.EndsWith('\') then + fixedPath := fixedPath + '\'; + var LFileToFind := fixedPath + CliFilename; + if FileExists(LFileToFind) then + FListOfFinds.Add(aPath); + end; + FNumberFound := FListOfFinds.Count; + FIsPresent := FNumberFound > 0; + FInstallTo := ifthen(FIsPresent, FListOfFinds[0]); +end; + +function TCLIPresent.GetPath: string; +begin + var reg := TRegistry.Create; + try + reg.RootKey := HKEY_CURRENT_USER; + var openResult := reg.OpenKeyReadOnly('Environment'); + if openResult then + Result := reg.ReadString('Path') + else + Result := ''; + finally + reg.CloseKey; + reg.Free; + end; +end; + end. diff --git a/Delphi/Project/Source/uUpdatePath.pas b/Delphi/Project/Source/uUpdatePath.pas index d96d0d2..05c6107 100644 --- a/Delphi/Project/Source/uUpdatePath.pas +++ b/Delphi/Project/Source/uUpdatePath.pas @@ -15,19 +15,15 @@ implementation {$endif} class function TUpdatePath.AddToPath(aDir: string): Boolean; -var - reg: TRegistry; - openResult: Boolean; - lPath: string; begin result := false; - reg := TRegistry.Create; + var reg := TRegistry.Create; try reg.RootKey := HKEY_CURRENT_USER; - openResult := reg.OpenKeyReadOnly('Environment'); + var openResult := reg.OpenKeyReadOnly('Environment'); if openResult then begin - lPath:= reg.ReadString('Path'); + var lPath:= reg.ReadString('Path'); if lPath.ToLower.Contains(aDir.ToLower) then result := true else @@ -77,27 +73,20 @@ class procedure TUpdatePath.BroadcastChange; end; class function TUpdatePath.RemoveFromPath(aDir: string): Boolean; -var - reg: TRegistry; - openResult: Boolean; - lPath: string; - lSplitPath: TArray; - lNewPath: string; - lDir: string; begin result := false; - reg := TRegistry.Create; + var reg := TRegistry.Create; try reg.RootKey := {HKEY_LOCAL_MACHINE{} HKEY_CURRENT_USER{}; - openResult := reg.OpenKeyReadOnly('Environment'); + var openResult := reg.OpenKeyReadOnly('Environment'); if openResult then begin - lPath:= reg.ReadString('Path'); + var lPath:= reg.ReadString('Path'); if lPath.ToLower.Contains(aDir.ToLower) then begin - lSplitPath := lPath.Split([';']); - lNewPath := ''; - for lDir in lSplitPath do + var lSplitPath: TArray := lPath.Split([';']); + var lNewPath := ''; + for var lDir in lSplitPath do begin if lDir.ToLower <> aDir.ToLower then if lNewPath.IsEmpty then