11unit uInstallLocationFrm;
2- { _define SimTLSCheckFailure}
3- { $define SkipTLSCheck}
42interface
53
64uses
75 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
86 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uTypes, Vcl.StdCtrls, Vcl.ExtCtrls,
9- Vcl.Imaging.pngimage, System.UITypes;
7+ Vcl.Imaging.pngimage, System.Generics.Collections, System. UITypes, Vcl.Buttons ;
108
119type
10+ TCLIPresent = class ;
11+
1212 TfrmInstallLocation = class (TForm)
1313 Panel1: TPanel;
1414 Label1: TLabel;
@@ -23,24 +23,53 @@ TfrmInstallLocation = class(TForm)
2323 Image1: TImage;
2424 imgV2Logo: TImage;
2525 LinkLabel1: TLinkLabel;
26+ pnlPreexistingCLI: TPanel;
27+ Label6: TLabel;
28+ Label7: TLabel;
29+ btnYes: TButton;
30+ btnNo: TButton;
2631 procedure btnCancelClick (Sender: TObject);
2732 procedure btnNextClick (Sender: TObject);
2833 procedure btnBrowseClick (Sender: TObject);
2934 procedure FormCreate (Sender: TObject);
3035 procedure LinkLabel1LinkClick (Sender: TObject; const Link: string;
3136 LinkType: TSysLinkType);
37+ procedure FormDestroy (Sender: TObject);
38+ procedure FormActivate (Sender: TObject);
39+ procedure btnYesClick (Sender: TObject);
40+ procedure btnNoClick (Sender: TObject);
3241 private
3342 { Private declarations }
43+ OldCLIPresent: TCLIPresent;
3444 public
3545 { Public declarations }
3646 NextClicked: boolean;
3747 end ;
3848
49+ TCLIPresent = class
50+ strict private
51+ const
52+ CliFilename = ' exercism.exe' ;
53+ var
54+ FInstallTo: string;
55+ FListOfFinds: TList<string>;
56+ FIsPresent: Boolean;
57+ FNumberFound: Integer;
58+ function GetPath : string;
59+ public
60+ constructor Create;
61+ destructor Destroy; override;
62+ procedure FindPreexistingCLI ;
63+ property InstallTo: string read FInstallTo;
64+ property IsPresent: Boolean read FIsPresent;
65+ property NumberFound: Integer read FNumberFound;
66+ end ;
67+
3968 function ShowInstallLocationForm (var aInstallInfo: TInstallInfo): TResultStatus;
4069
4170implementation
4271uses
43- Vcl.FileCtrl, Vcl.ExtActns;
72+ StrUtils, Vcl.FileCtrl, Vcl.ExtActns, Registry ;
4473{ $R *.dfm}
4574
4675function ShowInstallLocationForm (var aInstallInfo: TInstallInfo): TResultStatus;
@@ -105,12 +134,36 @@ procedure TfrmInstallLocation.btnNextClick(Sender: TObject);
105134 end ;
106135end ;
107136
137+ procedure TfrmInstallLocation.btnNoClick (Sender: TObject);
138+ begin
139+ pnlPreexistingCLI.Visible := false;
140+ MessageDlg(' Please remove all copies of the CLI before attempting to install the latest version.' , mtInformation, [mbOk], 0 );
141+ btnCancel.Click;
142+ end ;
143+
144+ procedure TfrmInstallLocation.FormActivate (Sender: TObject);
145+ begin
146+ OldCLIPresent.FindPreexistingCLI;
147+ if OldCLIPresent.IsPresent then
148+ begin
149+ pnlPreexistingCLI.BringToFront;
150+ pnlPreexistingCLI.Visible := true;
151+ btnNext.Enabled := false;
152+ end ;
153+ end ;
154+
108155procedure TfrmInstallLocation.FormCreate (Sender: TObject);
109156begin
110157 NextClicked := false;
158+ OldCLIPresent := TCLIPresent.Create;
111159 SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW);
112160end ;
113161
162+ procedure TfrmInstallLocation.FormDestroy (Sender: TObject);
163+ begin
164+ OldCLIPresent.DisposeOf;
165+ end ;
166+
114167procedure TfrmInstallLocation.LinkLabel1LinkClick (Sender: TObject;
115168 const Link: string; LinkType: TSysLinkType);
116169begin
@@ -120,4 +173,58 @@ procedure TfrmInstallLocation.LinkLabel1LinkClick(Sender: TObject;
120173 Browser.DisposeOf;
121174end ;
122175
176+ procedure TfrmInstallLocation.btnYesClick (Sender: TObject);
177+ begin
178+ pnlPreexistingCLI.Visible := false;
179+ fldLocation.Text := OldCLIPresent.InstallTo;
180+ btnNext.Enabled := True;
181+ end ;
182+
183+ { TCLIPresent }
184+
185+ constructor TCLIPresent.Create;
186+ begin
187+ inherited ;
188+ FListOfFinds := TList<string>.Create;
189+ end ;
190+
191+ destructor TCLIPresent.Destroy;
192+ begin
193+ FListOfFinds.DisposeOf;
194+ inherited ;
195+ end ;
196+
197+ procedure TCLIPresent.FindPreexistingCLI ;
198+ begin
199+ var PathArray := GetPath.Split([' ;' ]);
200+ for var aPath in PathArray do
201+ begin
202+ var fixedPath := aPath;
203+ if not fixedPath.EndsWith(' \' ) then
204+ fixedPath := fixedPath + ' \' ;
205+ var LFileToFind := fixedPath + CliFilename;
206+ if FileExists(LFileToFind) then
207+ FListOfFinds.Add(aPath);
208+ end ;
209+ FNumberFound := FListOfFinds.Count;
210+ FIsPresent := FNumberFound > 0 ;
211+ FInstallTo := ifthen(FIsPresent, FListOfFinds[0 ]);
212+ end ;
213+
214+ function TCLIPresent.GetPath : string;
215+ begin
216+ var reg := TRegistry.Create;
217+ try
218+ reg.RootKey := HKEY_CURRENT_USER;
219+ var openResult := reg.OpenKeyReadOnly(' Environment' );
220+ if openResult then
221+ Result := reg.ReadString(' Path' )
222+ else
223+ Result := ' ' ;
224+ finally
225+ reg.CloseKey;
226+ reg.Free;
227+ end ;
228+ end ;
229+
123230end .
0 commit comments