Send Signed Email

procedure TForm1.btnSendClick(Sender: TObject);
var
  certificate: TclCertificate;
begin
  //build message

  clSMimeMessage1.BuildMessage(memText.Lines.Text, '');

  clSMimeMessage1.Subject := edtSubject.Text;
  clSMimeMessage1.From.FullAddress := edtFrom.Text;
  clSMimeMessage1.ToList.EmailAddresses := edtRecipient.Text;

  if (cbSign.Checked) then
  begin
  //validate certificate

    if (cbCertificate.ItemIndex < 0) then
    begin
      raise Exception.Create('The signing certificate is not specified');
    end;

    certificate := clCertificateStore1.Items[cbCertificate.ItemIndex];

    if (certificate.Email <> clSMimeMessage1.From.Email) then
    begin
      if (MessageDlg('The signing certificate E-mail address does not match the E-mail sender. Continue anyway?',
        mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
      begin
        Exit;
      end;
    end;

    if not clCertificateStore1.Verify(certificate) then
    begin
      if (MessageDlg('The certificate is not suitable for signing. Continue anyway?',
        mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
      begin
        Exit;
      end;
    end;

  //sign message

    clSMimeMessage1.Sign();
  end;

  //send message

  clSmtp1.Server := edtSmtpHost.Text;
  clSmtp1.Port := StrToInt(edtSmtpPort.Text);
  clSmtp1.UserName := edtSmtpUser.Text;
  clSmtp1.Password := edtSmtpPassword.Text;

  ProgressBar1.Position := 0;

  clSmtp1.Open();
  try
    clSmtp1.Send(clSMimeMessage1);
  finally
    clSmtp1.Close();
  end;

  ProgressBar1.Position := 100;

  ShowMessage('The E-mail was sent successfully.');
end;

procedure TForm1.btnLoadCertificateClick(Sender: TObject);
var
  i: Integer;
begin
  clCertificateStore1.Close();
  cbCertificate.Clear();

  case cbCertificateSource.ItemIndex of
    0: clCertificateStore1.ImportFromPFX(edtCertificateFileName.Text, edtCertificatePassword.Text);
    1: clCertificateStore1.Open('MY');
  end;

  for i := 0 to clCertificateStore1.Items.Count - 1 do
  begin
    if (clCertificateStore1.Items[i].FriendlyName <> '') then
    begin
      cbCertificate.Items.Add(clCertificateStore1.Items[i].FriendlyName);
    end else
    begin
      cbCertificate.Items.Add(clCertificateStore1.Items[i].IssuedTo);
    end;
  end;

  if (cbCertificate.Items.Count > 0) then
  begin
    cbCertificate.ItemIndex := 0;
  end;
end;

procedure TForm1.clSMimeMessage1GetSigningCertificate(Sender: TObject;
  var ACertificate: TclCertificate; AExtraCerts: TclCertificateList;
  var Handled: Boolean);
begin
  ACertificate := clCertificateStore1.Items[cbCertificate.ItemIndex];
  Handled := True;
end;