Update to CEF 99.2.9

Added a certificate selection form to the MiniBrowser VCL demo

demos/Delphi_VCL/MiniBrowser/MiniBrowser.dpr

@@ -42,16 +42,19 @@ program MiniBrowser;
 
 uses
   {$IFDEF DELPHI16_UP}
-  Vcl.Forms, WinApi.Windows,
+  Winapi.Windows,
+  Vcl.Forms,
   {$ELSE}
-  Forms, Windows,
+  Forms,
+  Windows,
   {$ENDIF }
   uCEFApplication,
   uMiniBrowser in 'uMiniBrowser.pas' {MiniBrowserFrm},
   uPreferences in 'uPreferences.pas' {PreferencesFrm},
   uSimpleTextViewer in 'uSimpleTextViewer.pas' {SimpleTextViewerFrm},
   uFindFrm in 'uFindFrm.pas' {FindFrm},
-  uDirectorySelector in 'uDirectorySelector.pas' {DirectorySelectorFrm};
+  uDirectorySelector in 'uDirectorySelector.pas' {DirectorySelectorFrm},
+  uSelectCertForm in 'uSelectCertForm.pas' {SelectCertForm};
 
 {$R *.res}
 

demos/Delphi_VCL/MiniBrowser/MiniBrowser.dproj

@@ -151,7 +151,9 @@
         </DCCReference>
         <DCCReference Include="uDirectorySelector.pas">
             <Form>DirectorySelectorFrm</Form>
-            <FormType>dfm</FormType>
+        </DCCReference>
+        <DCCReference Include="uSelectCertForm.pas">
+            <Form>SelectCertForm</Form>
         </DCCReference>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>

demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm

@@ -163,6 +163,9 @@ object MiniBrowserFrm: TMiniBrowserFrm
           'https://www.youtube.com'
           'https://html5demos.com/drag/'
           'https://frames-per-second.appspot.com/'
+          
+            'https://www.sede.fnmt.gob.es/certificados/persona-fisica/verific' +
+            'ar-estado'
           'chrome://version/'
           'chrome://net-internals/'
           'chrome://tracing/'
@@ -288,6 +291,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
     OnBeforeClose = Chromium1BeforeClose
     OnClose = Chromium1Close
     OnCertificateError = Chromium1CertificateError
+    OnSelectClientCertificate = Chromium1SelectClientCertificate
     OnBeforeResourceLoad = Chromium1BeforeResourceLoad
     OnResourceResponse = Chromium1ResourceResponse
     OnFileDialog = Chromium1FileDialog

demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas

@@ -72,6 +72,7 @@ const
   MINIBROWSER_PREFS_AVLBL      = WM_APP + $10D;
   MINIBROWSER_DTDATA_AVLBL     = WM_APP + $10E;
   MINIBROWSER_SHOWFILEDLG      = WM_APP + $10F;
+  MINIBROWSER_SELECTCERT       = WM_APP + $110;
 
   MINIBROWSER_HOMEPAGE = 'https://www.google.com';
 
@@ -180,6 +181,7 @@ type
     procedure Chromium1ZoomPctAvailable(Sender: TObject; const aZoomPct: Double);
     procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
     procedure Chromium1FileDialog(Sender: TObject; const browser: ICefBrowser; mode: Cardinal; const title, defaultFilePath: ustring; const acceptFilters: TStrings; selectedAcceptFilter: Integer; const callback: ICefFileDialogCallback; out Result: Boolean);
+    procedure Chromium1SelectClientCertificate(Sender: TObject; const browser: ICefBrowser; isProxy: Boolean; const host: ustring; port: Integer; certificatesCount: NativeUInt; const certificates: TCefX509CertificateArray; const callback: ICefSelectClientCertificateCallback; var aResult: Boolean);
 
     procedure BackBtnClick(Sender: TObject);
     procedure ForwardBtnClick(Sender: TObject);
@@ -213,12 +215,14 @@ type
     procedure SaveasMHTML1Click(Sender: TObject);
 
   protected
-    FDevToolsMsgID     : integer;
-    FScreenshotMsgID   : integer;
-    FMHTMLMsgID        : integer;
-    FDevToolsMsgValue  : ustring;
-    FShutdownReason    : string;
-    FHasShutdownReason : boolean;
+    FDevToolsMsgID      : integer;
+    FScreenshotMsgID    : integer;
+    FMHTMLMsgID         : integer;
+    FDevToolsMsgValue   : ustring;
+    FShutdownReason     : string;
+    FHasShutdownReason  : boolean;
+    FSelectCertCallback : ICefSelectClientCertificateCallback;
+    FCertificates       : TCefX509CertificateArray;
 
     FResponse   : TStringList;
     FRequest    : TStringList;
@@ -231,6 +235,7 @@ type
     FClosing  : boolean;  // Set to True in the CloseQuery event.
 
     procedure AddURL(const aURL : string);
+    procedure DestroyCertificates;
 
     procedure ShowDevTools(aPoint : TPoint); overload;
     procedure ShowDevTools; overload;
@@ -246,7 +251,6 @@ type
     function  ShowOpenFolderDialog(var aFilePaths : TStringList) : boolean;
     function  ShowSaveFileDialog(var aFilePaths : TStringList) : boolean;
 
-
     procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
     procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
     procedure ShowDevToolsMsg(var aMessage : TMessage); message MINIBROWSER_SHOWDEVTOOLS;
@@ -264,6 +268,7 @@ type
     procedure PreferencesAvailableMsg(var aMessage : TMessage); message MINIBROWSER_PREFS_AVLBL;
     procedure DevToolsDataAvailableMsg(var aMessage : TMessage); message MINIBROWSER_DTDATA_AVLBL;
     procedure ShowFileDialogMsg(var aMessage : TMessage); message MINIBROWSER_SHOWFILEDLG;
+    procedure SelectCertificateMsg(var aMessage : TMessage); message MINIBROWSER_SELECTCERT;
     procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
     procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
     procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
@@ -286,7 +291,7 @@ implementation
 
 uses
   uPreferences, uCefStringMultimap, uCEFMiscFunctions, uSimpleTextViewer,
-  uCEFClient, uFindFrm, uCEFDictionaryValue, uDirectorySelector;
+  uCEFClient, uFindFrm, uCEFDictionaryValue, uDirectorySelector, uSelectCertForm;
 
 // Destruction steps
 // =================
@@ -763,6 +768,38 @@ begin
   TempFilePaths.Free;
 end;
 
+procedure TMiniBrowserFrm.SelectCertificateMsg(var aMessage : TMessage);
+var
+  TempSelector : TSelectCertForm;
+  TempInfo : string;
+  i : integer;
+begin
+  if assigned(FCertificates) and assigned(FSelectCertCallback) then
+    try
+      TempSelector := TSelectCertForm.Create(self);
+
+      i := 0;
+      while (i < length(FCertificates)) do
+        begin
+          TempInfo := FCertificates[i].GetSubject.GetDisplayName + ' - ' +
+                      'Valid until : ' + DateToStr(CefTimeToDateTime(FCertificates[i].GetValidExpiry));
+
+          TempSelector.Certificates.Add(TempInfo);
+          inc(i);
+        end;
+
+      TempSelector.ShowModal;
+
+      if TempSelector.Selected >= 0 then
+        FSelectCertCallback.Select(FCertificates[TempSelector.Selected])
+       else
+        FSelectCertCallback.Select(nil);
+    finally
+      DestroyCertificates;
+      FreeAndNil(TempSelector);
+    end;
+end;
+
 procedure TMiniBrowserFrm.Chromium1FullScreenModeChange(Sender: TObject;
   const browser: ICefBrowser; fullscreen: Boolean);
 begin                    
@@ -1117,6 +1154,30 @@ begin
   Chromium1.StopLoad;
 end;
 
+procedure TMiniBrowserFrm.Chromium1SelectClientCertificate(Sender: TObject;
+  const browser: ICefBrowser; isProxy: Boolean; const host: ustring;
+  port: Integer; certificatesCount: NativeUInt;
+  const certificates: TCefX509CertificateArray;
+  const callback: ICefSelectClientCertificateCallback; var aResult: Boolean);
+var
+  i : integer;
+begin
+  if assigned(callback) and assigned(certificates) and (length(certificates) > 0) then
+    begin
+      aResult             := True;
+      FSelectCertCallback := callback;
+
+      SetLength(FCertificates, length(certificates));
+
+      for i := 0 to pred(length(certificates)) do
+        FCertificates[i] := certificates[i];
+
+      PostMessage(Handle, MINIBROWSER_SELECTCERT, 0, 0);
+    end
+   else
+    aResult := False;
+end;
+
 procedure TMiniBrowserFrm.Chromium1StatusMessage(Sender: TObject;
   const browser: ICefBrowser; const value: ustring);
 begin
@@ -1188,6 +1249,8 @@ begin
   FResponse            := TStringList.Create;
   FRequest             := TStringList.Create;
   FNavigation          := TStringList.Create;
+  FSelectCertCallback  := nil;
+  FCertificates        := nil;
 
   FDevToolsMsgID       := 0;
 
@@ -1213,6 +1276,9 @@ begin
   if FHasShutdownReason then
     ShutdownBlockReasonDestroy(Application.Handle);
 
+  DestroyCertificates;
+
+  FSelectCertCallback  := nil;
   FResponse.Free;
   FRequest.Free;
   FNavigation.Free;
@@ -1281,6 +1347,24 @@ begin
   URLCbx.Text := aURL;
 end;
 
+procedure TMiniBrowserFrm.DestroyCertificates;
+var
+  i : integer;
+begin
+  if assigned(FCertificates) then
+    begin
+      i := 0;
+      while (i < length(FCertificates)) do
+        begin
+          FCertificates[i] := nil;
+          inc(i);
+        end;
+
+      Finalize(FCertificates);
+      FCertificates := nil;
+    end;
+end;
+
 procedure TMiniBrowserFrm.akescreenshot1Click(Sender: TObject);
 begin
   inc(FDevToolsMsgID);

demos/Delphi_VCL/MiniBrowser/uSelectCertForm.dfm

@@ -0,0 +1,78 @@
+object SelectCertForm: TSelectCertForm
+  Left = 0
+  Top = 0
+  BorderIcons = [biSystemMenu]
+  Caption = 'Select a certificate'
+  ClientHeight = 441
+  ClientWidth = 612
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = 'Segoe UI'
+  Font.Style = []
+  Position = poScreenCenter
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 15
+  object ButtonPnl: TPanel
+    Left = 0
+    Top = 405
+    Width = 612
+    Height = 36
+    Align = alBottom
+    BevelOuter = bvNone
+    Padding.Left = 50
+    Padding.Right = 50
+    Padding.Bottom = 10
+    TabOrder = 0
+    object SelectBtn: TButton
+      Left = 50
+      Top = 0
+      Width = 150
+      Height = 26
+      Align = alLeft
+      Caption = 'Select'
+      Enabled = False
+      ModalResult = 1
+      TabOrder = 0
+      OnClick = SelectBtnClick
+    end
+    object CancelBtn: TButton
+      Left = 412
+      Top = 0
+      Width = 150
+      Height = 26
+      Align = alRight
+      Caption = 'Cancel'
+      ModalResult = 2
+      TabOrder = 1
+      OnClick = CancelBtnClick
+    end
+  end
+  object CertificatesPnl: TPanel
+    Left = 0
+    Top = 0
+    Width = 612
+    Height = 405
+    Align = alClient
+    BevelOuter = bvNone
+    Padding.Left = 10
+    Padding.Top = 10
+    Padding.Right = 10
+    Padding.Bottom = 10
+    TabOrder = 1
+    object CertificatesLb: TListBox
+      Left = 10
+      Top = 10
+      Width = 592
+      Height = 385
+      Align = alClient
+      ItemHeight = 15
+      TabOrder = 0
+      OnClick = CertificatesLbClick
+    end
+  end
+end

demos/Delphi_VCL/MiniBrowser/uSelectCertForm.pas

@@ -0,0 +1,76 @@
+unit uSelectCertForm;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
+  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
+  Vcl.StdCtrls, Vcl.ExtCtrls;
+
+type
+  TSelectCertForm = class(TForm)
+    ButtonPnl: TPanel;
+    SelectBtn: TButton;
+    CancelBtn: TButton;
+    CertificatesPnl: TPanel;
+    CertificatesLb: TListBox;
+
+    procedure FormShow(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+
+    procedure SelectBtnClick(Sender: TObject);
+    procedure CancelBtnClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure CertificatesLbClick(Sender: TObject);
+
+  private
+    FCertificates : TStringList;
+    FSelected     : integer;
+
+  public
+    property Certificates : TStringList read FCertificates;
+    property Selected     : integer     read FSelected;
+  end;
+
+implementation
+
+{$R *.dfm}
+
+procedure TSelectCertForm.FormCreate(Sender: TObject);
+begin
+  FCertificates := TStringList.Create;
+  FSelected     := -1;
+end;
+
+procedure TSelectCertForm.CertificatesLbClick(Sender: TObject);
+begin
+  SelectBtn.Enabled := (CertificatesLb.ItemIndex >= 0);
+end;
+
+procedure TSelectCertForm.FormDestroy(Sender: TObject);
+begin
+  if assigned(FCertificates) then
+    FreeAndNil(FCertificates);
+end;
+
+procedure TSelectCertForm.FormShow(Sender: TObject);
+begin
+  CertificatesLb.Items.Clear;
+
+  if assigned(FCertificates) and (FCertificates.Count > 0) then
+    CertificatesLb.Items.AddStrings(FCertificates);
+end;
+
+procedure TSelectCertForm.CancelBtnClick(Sender: TObject);
+begin
+  FSelected := -1;
+  close;
+end;
+
+procedure TSelectCertForm.SelectBtnClick(Sender: TObject);
+begin
+  FSelected := CertificatesLb.ItemIndex;
+  close;
+end;
+
+end.