Pascal (Lazarus/Delphi)

IMAP Download and Verify Signed MIME

See more IMAP Examples

Downloads the original MIME of a digitally signed email and saves the .p7s signature along with other MIME parts. It then imports the email into a Chilkat email object to unwrap the S/MIME and verify the signature, and subsequently saves the attachments if they haven't been saved already. 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.StringTable,
  Chilkat.Imap,
  Chilkat.Email,
  Chilkat.StringBuilder,
  Chilkat.Mime,
  Chilkat.Cert;

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

procedure RunDemo;
var
  success: Boolean;
  imap: TImap;
  sbMime: TStringBuilder;
  mime: TMime;
  alreadySavedParts: Boolean;
  st: TStringTable;
  numFiles: Integer;
  i: Integer;
  email: TEmail;
  cert: TCert;

begin
  success := False;

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

  imap := TImap.Create;

  //  Connect to an IMAP server.
  //  Use TLS
  imap.Ssl := True;
  imap.Port := 993;
  success := imap.Connect('imap.example.com');
  if (success = False) then
    begin
      WriteLn(imap.LastErrorText);
      Exit;
    end;

  success := imap.Login('myLogin','myPassword');
  if (success = False) then
    begin
      WriteLn(imap.LastErrorText);
      Exit;
    end;

  //  Select an IMAP mailbox
  success := imap.SelectMailbox('Inbox');
  if (success = False) then
    begin
      WriteLn(imap.LastErrorText);
      Exit;
    end;

  //  Download the 1st email (as MIME) in the Inbox by sequence number.
  sbMime := TStringBuilder.Create;
  success := imap.FetchSingleAsMimeSb(1,False,sbMime);
  if (success = False) then
    begin
      WriteLn(imap.LastErrorText);
      Exit;
    end;

  //  Load it into a MIME object and check to see if it is signed
  mime := TMime.Create;
  mime.LoadMimeSb(sbMime);
  alreadySavedParts := False;
  if (mime.ContainsSignedParts() = True) then
    begin

      //  This will save the .p7s and other parts...
      st := TStringTable.Create;
      success := mime.PartsToFiles('c:/temp/qa_output',st);
      if (success = True) then
        begin
          numFiles := st.Count;
          i := 0;
          while i < numFiles do
            begin
              WriteLn('Created: ' + st.StringAt(i));
              i := i + 1;
            end;

          alreadySavedParts := True;
        end;
    end;

  //  Load the MIME into an Email object.  This unwraps the security layers and verifies signatures.
  email := TEmail.Create;
  email.SetFromMimeSb(sbMime);

  if (email.ReceivedSigned = True) then
    begin

      WriteLn('This email was signed.');

      //  Check to see if the signatures were verified.
      if (email.SignaturesValid = True) then
        begin
          WriteLn('Digital signature(s) verified.');

          WriteLn('Signer: ' + email.SignedBy);

          //  The certificate used for signing may be obtained
          //  by calling email.GetSignedByCert.
          cert := TCert.Create;
          success := email.LastSignerCert(i,cert);
          if (success = False) then
            begin
              WriteLn('Failed to get signing certificate object.');
            end
          else
            begin
              WriteLn('Signing cert: ' + cert.SubjectCN);
            end;
        end;

    end
  else
    begin
      WriteLn('Digital signature verification failed.');
    end;

  if (alreadySavedParts <> True) then
    begin
      email.SaveAllAttachments('c:/temp/qa_output');
    end;


  imap.Free;
  sbMime.Free;
  mime.Free;
      st.Free;
  email.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.