Pascal (Lazarus/Delphi)

Create CMS (PKCS7) Detached MIME Signature

Demonstrates how to add a CMS detached signature to MIME. Pascal (Lazarus/Delphi)

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.Cert,
  Chilkat.Mime;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  mime: TMime;
  cert: TCert;

begin
  success := False;

  //  This example assumes the Chilkat API to have been previously unlocked.
  //  See Global Unlock Sample for sample code.

  mime := TMime.Create;

  //  Load a certificate w/ private key for signing.
  cert := TCert.Create;
  success := cert.LoadPfxFile('qa_data/pfx/ecc256_12345.p12','12345');
  if (success <> True) then
    begin
      WriteLn(cert.LastErrorText);
      Exit;
    end;

  WriteLn('Cert: ' + cert.SubjectDN);

  //  Create a simple MIME message to be signed:
  mime.AddHeaderField('Subject','This is a test');
  mime.AddHeaderField('MyCustomHeader','abc123');
  mime.ContentType := 'text/plain';
  mime.SetBody('This is a plain-text body.');

  //  Examine the MIME prior to signing:
  WriteLn('--- MIME prior to signing ---');
  WriteLn(mime.GetMime());

  //  The MIME prior to signing looks like this:

  //  Subject: This is a test
  //  MyCustomHeader: abc123
  //  Content-Type: text/plain; format=flowed
  //  
  //  This is a plain-text body.

  //  Use SHA256 as the hash algorithm in the CMS signature.
  mime.SigningHashAlg := 'SHA256';

  //  Add a detached signature:
  success := mime.AddDetachedSignature(cert);
  if (success = False) then
    begin
      WriteLn(mime.LastErrorText);
      Exit;
    end;

  //  Examine the MIME with detached signature:
  WriteLn('--- MIME with detached signature ---');
  WriteLn(mime.GetMime());

  //  Content-Type: multipart/signed; boundary="----=_NextPart_6e3_c655_9641494d.b4f00501";
  //   protocol="application/x-pkcs7-signature";
  //   micalg=sha256
  //  
  //  ------=_NextPart_6e3_c655_9641494d.b4f00501
  //  Subject: This is a test
  //  MyCustomHeader: abc123
  //  Content-Type: text/plain; format=flowed
  //  
  //  This is a plain-text body.
  //  ------=_NextPart_6e3_c655_9641494d.b4f00501
  //  Content-Transfer-Encoding: base64
  //  Content-Type: application/x-pkcs7-signature; name="smime.p7s"
  //  Content-Disposition: attachment; filename="smime.p7s"
  //  
  //  MIID7AYJKoZIhvcNAQcCoIID3TCCA9kCAQExDzANBglghkgBZQMEAgEFADALBgkqhkiG9w0BBwGg
  //  ggJxMIICbTCCAhOgAwIBAgIJAJuS2kgOoyr+MAkGByqGSM49BAEwWzELMAkGA1UEBhMCQVUxEzAR
  //  BgNVBAgTClNvbWUtU3RhdGUxITAfBgNVBAoTGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIG
  //  A1UEAxMLZWNjMjU2LXRlc3QwHhcNMTYwODIzMTU0OTM5WhcNNDQwMTA4MTU0OTM5WjBbMQswCQYD
  //  VQQGEwJBVTETMBEGA1UECBMKU29tZS1TdGF0ZTEhMB8GA1UEChMYSW50ZXJuZXQgV2lkZ2l0cyBQ
  //  dHkgTHRkMRQwEgYDVQQDEwtlY2MyNTYtdGVzdDBZMBMGByqGSM49AgEGCCqGSM49AwEHA0IABARy
  //  Hd86A7+qQ4DlIfKynZaFGdGLpkU3GlQwqaVD6GIJg3QIDhaWEksYtZ9OWjNHn9a6+i/P9o5/NrdI
  //  SP0VWDWjgcAwgb0wHQYDVR0OBBYEFGmd2DfK4c3VBTVn8ebKH2BTmRicMIGNBgNVHSMEgYUwgYKA
  //  FGmd2DfK4c3VBTVn8ebKH2BTmRicoV+kXTBbMQswCQYDVQQGEwJBVTETMBEGA1UECBMKU29tZS1T
  //  dGF0ZTEhMB8GA1UEChMYSW50ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMRQwEgYDVQQDEwtlY2MyNTYt
  //  dGVzdIIJAJuS2kgOoyr+MAwGA1UdEwQFMAMBAf8wCQYHKoZIzj0EAQNJADBGAiEAhuiwGy0lZKtK
  //  LA13Ffc8AMTK7NsePPSfs0clXlZUR78CIQDXsJXpYsJ7tlTeockrK+6099sG/gGFTRPiQYU8juyf
  //  LzGCAT8wggE7AgEBMGgwWzELMAkGA1UEBhMCQVUxEzARBgNVBAgTClNvbWUtU3RhdGUxITAfBgNV
  //  BAoTGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIGA1UEAxMLZWNjMjU2LXRlc3QCCQCbktpI
  //  DqMq/jANBglghkgBZQMEAgEFAKBpMBgGCSqGSIb3DQEJAzELBgkqhkiG9w0BBwEwHAYJKoZIhvcN
  //  AQkFMQ8XDTIyMDUwODE0MzM1NFowLwYJKoZIhvcNAQkEMSIEIMvNpYuymLvF68aFFe+l3NEQTdkB
  //  7T8U6/j+Y5FgDlIUMAoGCCqGSM49BAMCBEYwRAIgQ6migEn3Le9ciIVUP/qc2JZAJZWjpulJXY9Q
  //  IZJ3XK0CIGZwpLOgiv7ES8958hqT9a/q7aPc1xmkaZHtsat/k+Ki
  //  
  //  ------=_NextPart_6e3_c655_9641494d.b4f00501--


  mime.Free;
  cert.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.