Vérifier la validité d’un certificat HTTPS

procedure TForm1.Log(const Msg: string);
begin
  Memo.Lines.Add(FormatDateTime('hh:nn:ss', Now) + '  ' + Msg);
end;

procedure TForm1.ValidateServerCert(const Sender: TObject;
  const ARequest: TURLRequest; const Certificate: TCertificate;
  var Accepted: Boolean);
begin
  Accepted := True;

  Log('--- Certificat serveur ---');
  Log('Sujet     : ' + Certificate.Subject);
  Log('Émetteur  : ' + Certificate.Issuer);
  Log('Valide du : ' + DateTimeToStr(Certificate.Start));
  Log('Valide au : ' + DateTimeToStr(Certificate.Expiry));
end;

procedure TForm1.buttonClick(Sender: TObject);
var
  Client: THTTPClient;
  Resp: IHTTPResponse;
  Url: string;
begin
  Memo.Clear;
  Url := Trim(Edit.Text);

  if Url = '' then
  begin
    ShowMessage('Veuillez saisir une URL HTTPS');
    Exit;
  end;

  Client := THTTPClient.Create;
  try
    Client.OnValidateServerCertificate := ValidateServerCert;
    Log('Connexion à : ' + Url);

    Resp := Client.Head(Url);

    Log(Format('HTTP %d %s', [Resp.StatusCode, Resp.StatusText]));
    Log('Certificat TLS VALIDE');
    ShowMessage('Certificat TLS VALIDE');
  except
    on E: ENetHTTPClientException do
    begin
      Log('Erreur TLS / Certificat invalide ou connexion impossible');
      Log(E.ClassName + ' : ' + E.Message);
      ShowMessage('Certificat TLS INVALIDE (ou erreur TLS)');
    end;
    on E: Exception do
    begin
      Log('Erreur : ' + E.Message);
      ShowMessage('Erreur : ' + E.Message);
    end;
  end;

  Client.Free;
end;