diff --git a/.gitignore b/.gitignore index a2c9090..62b6338 100644 --- a/.gitignore +++ b/.gitignore @@ -264,3 +264,5 @@ paket-files/ *.vlb *.dsk + +*.~dsk diff --git a/Delphi/Project/ExercismCLIInstaller.dproj b/Delphi/Project/ExercismCLIInstaller.dproj index f809d06..5926f87 100644 --- a/Delphi/Project/ExercismCLIInstaller.dproj +++ b/Delphi/Project/ExercismCLIInstaller.dproj @@ -1,7 +1,7 @@  {F8605FE1-AB97-4531-9853-D43F5A666830} - 18.3 + 18.4 VCL ExercismCLIInstaller.dpr True @@ -93,8 +93,8 @@ true true true - CompanyName=Exercism;FileDescription=$(MSBuildProjectName);FileVersion=2.0.1.14;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=2.0.1.0;Comments= - 14 + CompanyName=Exercism;FileDescription=$(MSBuildProjectName);FileVersion=2.0.1.15;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=2.0.1.0;Comments= + 15 1 @@ -109,9 +109,9 @@ true 2 true - CompanyName=Exercism;FileDescription=$(MSBuildProjectName);FileVersion=2.0.2.11;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=2.0.2.0;Comments= + CompanyName=Exercism;FileDescription=$(MSBuildProjectName);FileVersion=2.0.2.14;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=2.0.2.0;Comments= img\ExercismCLIInstaller_Icon.ico - 11 + 14 2 diff --git a/Delphi/Project/Source/uInstallLocationFrm.dfm b/Delphi/Project/Source/uInstallLocationFrm.dfm index 3f117c3..885ffb2 100644 --- a/Delphi/Project/Source/uInstallLocationFrm.dfm +++ b/Delphi/Project/Source/uInstallLocationFrm.dfm @@ -1,7 +1,6 @@ object frmInstallLocation: TfrmInstallLocation Left = 0 Top = 0 - ActiveControl = btnNext BorderIcons = [] BorderStyle = bsDialog Caption = 'Exercism CLI Install' @@ -15,6 +14,7 @@ object frmInstallLocation: TfrmInstallLocation Font.Style = [] OldCreateOrder = False Position = poScreenCenter + OnActivate = FormActivate OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 @@ -70,6 +70,29 @@ object frmInstallLocation: TfrmInstallLocation ShowHint = True Transparent = True end + object lblUpdateTLS: TOvcURL + Left = 189 + Top = 248 + Width = 262 + Height = 13 + Hint = + 'https://support.microsoft.com/en-us/help/3140245/update-to-enabl' + + 'e-tls-1-1-and-tls-1-2-as-a-default-secure-protocols-in' + Caption = 'Microsoft instructions for updating default TLS settings' + URL = + 'https://support.microsoft.com/en-us/help/3140245/update-to-enabl' + + 'e-tls-1-1-and-tls-1-2-as-a-default-secure-protocols-in' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsUnderline] + ParentFont = False + ParentShowHint = False + ShowHint = True + Transparent = True + Visible = False + end object Panel1: TPanel Left = 0 Top = 0 @@ -185,6 +208,7 @@ object frmInstallLocation: TfrmInstallLocation Width = 75 Height = 25 Caption = '&Next >' + Enabled = False TabOrder = 2 OnClick = btnNextClick end @@ -211,4 +235,28 @@ object frmInstallLocation: TfrmInstallLocation TabOrder = 4 OnClick = btnBrowseClick end + object rcCheckTLSVersion: TRESTClient + Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,' + AcceptCharset = 'UTF-8, *;q=0.8' + BaseURL = 'https://www.howsmyssl.com/a/check' + Params = <> + HandleRedirects = True + RaiseExceptionOn500 = False + Left = 248 + Top = 48 + end + object rrCheckTLSVersion: TRESTRequest + Client = rcCheckTLSVersion + Params = <> + Response = rResponseCheckTLSVersion + SynchronizedEvents = False + Left = 328 + Top = 52 + end + object rResponseCheckTLSVersion: TRESTResponse + ContentType = 'application/json' + RootElement = 'tls_version' + Left = 416 + Top = 48 + end end diff --git a/Delphi/Project/Source/uInstallLocationFrm.pas b/Delphi/Project/Source/uInstallLocationFrm.pas index 7cb81ff..ccf545f 100644 --- a/Delphi/Project/Source/uInstallLocationFrm.pas +++ b/Delphi/Project/Source/uInstallLocationFrm.pas @@ -5,9 +5,43 @@ 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.UITypes, ovcurl, IPPeerClient, REST.Client, + Data.Bind.Components, Data.Bind.ObjectScope; type + ICheckTLS = interface(IInvokable) + ['{2AED8C0C-BF88-4A06-A3B2-418799CD28EF}'] + function GetTLSOK: boolean; + function GetStatusCode: integer; + function GetTLSVersion: string; + function GetMessageStr: string; + property TLSok: boolean read GetTLSOK; + property StatusCode: integer read GetStatusCode; + property TLSVersion: string read GetTLSVersion; + property ErrMessage: string read GetMessageStr; + end; + + TCheckTLS = class(TInterfacedObject, ICheckTLS) + strict private + const + cDesiredVersion: double = 1.2; + var + fTLSVersion: string; + fTLSOK: boolean; + fStatusCode: integer; + fMessageStr: string; + function GetTLSOK: boolean; + function GetStatusCode: integer; + function GetTLSVersion: string; + function GetMessageStr: string; + public + constructor Create(aRESTRequest: TRestRequest; aRESTResponse: TRESTResponse); + property TLSok: boolean read GetTLSOK; + property StatusCode: integer read GetStatusCode; + property TLSVersion: string read GetTLSVersion; + property ErrMessage: string read GetMessageStr; + end; + TfrmInstallLocation = class(TForm) Panel1: TPanel; Label1: TLabel; @@ -21,10 +55,15 @@ TfrmInstallLocation = class(TForm) Label5: TLabel; OvcURL4: TOvcURL; Image1: TImage; + rcCheckTLSVersion: TRESTClient; + rrCheckTLSVersion: TRESTRequest; + rResponseCheckTLSVersion: TRESTResponse; + lblUpdateTLS: TOvcURL; procedure btnCancelClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure btnBrowseClick(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure FormActivate(Sender: TObject); private { Private declarations } public @@ -110,10 +149,73 @@ procedure TfrmInstallLocation.btnNextClick(Sender: TObject); end; end; +procedure TfrmInstallLocation.FormActivate(Sender: TObject); +var + CheckTLS: ICheckTLS; +begin + CheckTLS := TCheckTLS.Create(rrCheckTLSVersion, rResponseCheckTLSVersion); + btnNext.Enabled := CheckTLS.TLSok; + if not btnNext.Enabled then + begin + lblUpdateTLS.Visible := true; + MessageDlg(CheckTLS.ErrMessage,mtError,[mbok],0); + end; +end; + procedure TfrmInstallLocation.FormCreate(Sender: TObject); begin NextClicked := false; SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW); end; +{ TCheckTLS } + +constructor TCheckTLS.Create(aRESTRequest: TRestRequest; aRESTResponse: TRESTResponse); +var + splitVersion: TArray; + actualVersion: double; +begin + aRESTRequest.Execute; + fStatusCode := aRESTResponse.StatusCode; + fMessageStr := ''; + fTLSOK := false; + fTLSVersion := ''; + if fStatusCode = 200 then + begin + fTLSVersion := aRESTResponse.JSONText.Replace('"',''); + splitVersion := fTLSVersion.Split([' ']); + actualVersion := splitVersion[1].ToDouble; + fTLSOK := actualVersion >= cDesiredVersion; + if not fTLSOK then + fMessageStr := format('TLS Version = %s, must be %0.1f or greater.'+#13#10+ + 'GitHub requires at least version 1.2'+#13#10+ + 'Please follow the link to Microsoft for instructions on updating Windows.',[splitVersion[1],cDesiredVersion]); + end + else + begin + fMessageStr := format('Err: REST Status Code %d', [fStatusCode]); + fTLSOk := false; + end; +end; + +function TCheckTLS.GetMessageStr: string; +begin + result := fMessageStr; +end; + +function TCheckTLS.GetStatusCode: integer; +begin + result := fStatusCode; +end; + +function TCheckTLS.GetTLSOK: boolean; +begin + result := fTLSOk; +end; + +function TCheckTLS.GetTLSVersion: string; +begin + result := fTLSVersion; +end; + end.