Development

Request # 15

Fast E-mail Agent

Very often we receives a requests for a code by which a few lines written in Delphi can sent e-mail using Microsoft Exchange Server as e-mail server. This example covers exactly that.

procedure TfrmMain.LogonAndSend;
var
  StoreLogoffFlag: Cardinal;
  OutboxEntryID: TSBinary;
  ObjType: Cardinal;
  SentMailEID: PSPropValue;
  TempString: String;
begin
  ZeroMemory(@OutboxEntryID, SizeOf(OutboxEntryID));
  SentMailEID := nil;

  try
    // Establish Session
    hr := MAPILogonEx(Application.Handle, // Parent Window
      nil, // Profile name
      nil, // Profile password - newer used
      MAPI_EXTENDED or { /* Extended MAPI Logon */ }
      MAPI_NEW_SESSION or { /* Don't use shared session */ }
      MAPI_SERVICE_UI_ALWAYS or MAPI_ALLOW_OTHERS or
      { /* Make this a shared session */ }
      MAPI_LOGON_UI, { /* Dialog box should be displayed */ }
      FMAPISession);

    if failed(hr) then
    begin
      FMAPISession := nil;
      raise Exception.Create(GetMAPIError(nil, hr));
    end;

    // NOT NEED REALLY, BUT I LIKE TO KNOW MAPI VERSION
    StatusBar.SimpleText := '  MAPIVersion:' + GetMAPIVersion;

    // Get interface to Address Book
    hr := FMAPISession.OpenAddressBook(Self.Handle, nil, 0, FAddressBook);
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMAPISession, hr));

    // Get interface to Mailbox
    hr := HrOpenExchangePrivateStore(FMAPISession, FMailbox);
    if failed(hr) then
      raise Exception.Create('Can not find/open Exchange Private Store!' +
        #13#10 + GetMAPIError(FMAPISession, hr));

    // Get Entry ID of Outbox folder
    hr := HrMAPIFindOutbox(FMailbox, OutboxEntryID.cb,
      PEntryID(OutboxEntryID.lpb));
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMailbox, hr));

    // Get Interface to Outbox folder
    hr := FMailbox.OpenEntry(OutboxEntryID.cb, PEntryID(OutboxEntryID.lpb),
      @IID_IMAPIFolder, MAPI_MODIFY or MAPI_NO_CACHE, ObjType,
      IUnknown(FOutbox));

    if (MAPI_E_UNKNOWN_FLAGS = hr) or (MAPI_E_FAILONEPROVIDER=hr) then // Outlook Version < 2003
      hr := FMailbox.OpenEntry(OutboxEntryID.cb, PEntryID(OutboxEntryID.lpb),
        @IID_IMAPIFolder, MAPI_MODIFY, ObjType, IUnknown(FOutbox));
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMailbox, hr));

    // Get Sent Items Folder - we will move message to this folder after submit
    // not mandatory - see below
    hr := HrGetOneProp(FMailbox, PR_IPM_SENTMAIL_ENTRYID, SentMailEID);
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMailbox, hr));
    SentMailEID.ulPropTag := PR_SENTMAIL_ENTRYID;

    // Create a new empty message
    hr := FOutbox.CreateMessage(nil, 0, FMAPIMessage);
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FOutbox, hr));

    // Set Message Class
    hr := HrMAPISetPropString(FMAPIMessage, PR_MESSAGE_CLASS,
      Pointer(PChar('IPM.Note')));
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMAPIMessage, hr));

    // Set Sent Items Entry ID - not mandatory
    hr := HrSetOneProp(FMAPIMessage, SentMailEID);
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMAPIMessage, hr));

    // Set Message Subject
    TempString := Trim(ebSubject.Text);
    if TempString = '' then
      TempString := 'Test Message';
    hr := HrMAPISetPropString(FMAPIMessage, PR_SUBJECT,
      Pointer(PChar(TempString)));
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMAPIMessage, hr));

    // Set Message Body
    TempString := Trim(BodyMemo.Text);
    if Length(TempString) > 254 then
      SetLargeBody
    else if Length(TempString) > 0 then
    begin
      hr := HrMAPISetPropString(FMAPIMessage, PR_BODY,
        Pointer(PChar(TempString)));
      if failed(hr) then
        raise Exception.Create(GetMAPIError(FMAPIMessage, hr));
    end;

    // Set Recipients
    Resolve;

    // Save all changes
    hr := FMAPIMessage.SaveChanges(KEEP_OPEN_READWRITE);
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMAPIMessage, hr));

    // Send Message
    hr := FMAPIMessage.SubmitMessage(0);
    if failed(hr) then
      raise Exception.Create(GetMAPIError(FMAPIMessage, hr));

    ShowMessage('The message is going out...');

  finally
    // Clear Sent Item Entry ID
    if Assigned(SentMailEID) then
      MAPIFreeBuffer(SentMailEID);
    // Clear Outbox EntryID
    if Assigned(OutboxEntryID.lpb) then
      MAPIFreeBuffer(OutboxEntryID.lpb);
    // Clear Outbox Interface
    FOutbox := nil;
    // Clear Message Interface
    FMAPIMessage := nil;

    FAddressBook := nil;
    if Assigned(FMailbox) then
    begin
      StoreLogoffFlag := LOGOFF_NO_WAIT;
      FMailbox.StoreLogoff(StoreLogoffFlag);
      FMailbox := nil;
    end;
    if Assigned(FMAPISession) then
      FMAPISession.Logoff(Application.Handle, MAPI_LOGOFF_UI, 0); // always 0
    FMAPISession := nil;
  end;

end;