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.' 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