Development

Request # 5

How to implement Extended MAPI in NT Service Application with DELPHI

In this example we will implement NT Service using Extended MAPI in itself. There are two specific characteristics of using Extended MAPI in this case:

the first is a special flag that informs the MAPI Subsystems hat we are going to work in a service environment
the second is the fact that when the service works with the rights of a user other than the interactive one, we need to create a MAPI Profile dynamically and erase it once we have completed the session through MAPILogonEx.

Our service will register the new incoming messages in a certain mailbox in NT Event Log.
You may of course change the functionality of the example according to your needs.

Creating of temporary MAPI profile at run-time.
Log On to Exchange Server from NT Service with temporary MAPI profile.
Implements an Advise method to receive notification registrations.
Implements an Unadvise method to receive notification cancellations.
Generates notifications of the appropriate type to the appropriate advise sink objects that have registered by calling their IMAPIAdviseSink.OnNotify methods and write it to NT Event Log.
Implementing an Advise Sink Object

Download Request #5 as Compiled Application

Download Project (DELPHI 10.4) ZIP file

Source Code: In package

Code Snippets:

unit unAdvice;

interface

{$I IMI.INC}

uses Comobj, ExtendedMAPI, Windows;

const
  // We create a NEW GUID for our own COM Object
  CLSID_MAPIAdviseSink: TGUID = '{B9197B72-6070-11D4-9E24-0000B45AB267}';

type
  TMAPIAdviseSink = class(TCOMObject, IMAPIAdviseSink)
    function OnNotify(cbNotif: ULONG; lpNotifications: PNOTIFICATION): ULONG; stdcall;
  end;

  TMailNotifier = class(TObject)
  private
    FRegistered: boolean;
    hr: HRESULT;
    Inbox: IMAPIFolder;
    FNewMailSink: IMAPIAdviseSink;
    FMsgStoreTable: IMsgStore;
    ContentsTable: IMapiTable;
  public
    MAPISession: IMAPISession;
    function Register: Bool; safecall;
    function UnRegister: Bool; safecall;
    constructor Create(Session: IMAPISession);
    destructor Destroy; override;
  end;

var
  MailNotifier: TMailNotifier = nil;

implementation

uses ActiveX, Comserv, EDK, MAPIMacros, MAPIUtils, SysUtils, unMainServ;

var
  FNewMailConnection: ULONG_PTR = 0;

function TMAPIAdviseSink.OnNotify(cbNotif: ULONG; lpNotifications: PNOTIFICATION):ULONG;
var
  hr: HRESULT;
  ObjType: ULONG;
  MAPIMessage: IMessage;
  MessagePropTagArray: PSPropTagArray;
  MessagePropValueArray: PSPropValue;
  StringMessage: string;
  iCount: Integer;
begin
  MAPIMessage := nil;
  hr := HRSUCCESS;
  Result := hr;

  for iCount := 0 to Integer(cbNotif) - 1 do
    if (PNOTIFICATIONArray(lpNotifications)[iCount].ulEventType = fnevNewMail)
    then
    begin
      try
        hr := MailNotifier.MAPISession.OpenEntry
          (PNOTIFICATIONArray(lpNotifications)[iCount].info.newmail.cbEntryID,
          PNOTIFICATIONArray(lpNotifications)[iCount].info.newmail.EntryID,
          @IID_IMessage, MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType,
          IUnknown(MAPIMessage));

        if (hr = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER=hr) then
          hr := MailNotifier.MAPISession.OpenEntry
            (PNOTIFICATIONArray(lpNotifications)[iCount].info.newmail.cbEntryID,
            PNOTIFICATIONArray(lpNotifications)[iCount].info.newmail.EntryID,
            @IID_IMessage, MAPI_BEST_ACCESS, ObjType, IUnknown(MAPIMessage));

        if Failed(hr) then
        begin
          MessageBox(0, PChar(GetMAPIError(MailNotifier.MAPISession, hr)),
            'IMI Mail Notification', MB_OK or MB_ICONERROR or
            MB_SERVICE_NOTIFICATION);
          Exit;
        end;

        MessagePropTagArray := nil;
        ObjType := 0;
        // Allocate Buffer for Message Properties
        hr := SizedSPropTagArray([PR_SUBJECT, PR_SENDER_EMAIL_ADDRESS],
          MessagePropTagArray);
        if Failed(hr) then
        begin
          DMAPIService.LogMessage('MAPI Error');
          Exit;
        end;

        MessagePropValueArray := nil;

        hr := MAPIMessage.GetProps(MessagePropTagArray, 0, ObjType,
          MessagePropValueArray);
        if Failed(hr) then
        begin
          DMAPIService.LogMessage(GetMAPIError(MAPIMessage, hr));
          Exit;
        end;

        StringMessage := 'Any post was there!';

        if Assigned(MessagePropValueArray) then
        begin
          if PSPropValueArray(MessagePropValueArray)[0].ulPropTag = PR_SUBJECT
          then
            if Assigned(PSPropValueArray(MessagePropValueArray)[0].Value.lpsz)
            then
              StringMessage := StringMessage + #13#10 + 'Subject:' +
                StrPas(PSPropValueArray(MessagePropValueArray)[0].Value.lpsz);

          if PSPropValueArray(MessagePropValueArray)[1].ulPropTag = PR_SENDER_EMAIL_ADDRESS
          then
            if Assigned(PSPropValueArray(MessagePropValueArray)[1].Value.lpsz)
            then
              StringMessage := StringMessage + #13#10 + 'From:' +
                StrPas(PSPropValueArray(MessagePropValueArray)[1].Value.lpsz);
        end;

        DMAPIService.LogMessage(StringMessage, EVENTLOG_WARNING_TYPE)

      finally
        if Assigned(MessagePropValueArray) then
          MAPIFreeBuffer(MessagePropValueArray);
        if Assigned(MessagePropTagArray) then
          MAPIFreeBuffer(MessagePropTagArray);
        if Assigned(MAPIMessage) then
          MAPIMessage := nil;

        Result := hr;
      end;
    end;
end;

constructor TMailNotifier.Create(Session: IMAPISession);
begin
  inherited Create;
  MAPISession := Session;
  Register;
end;

destructor TMailNotifier.Destroy;
begin
  if FRegistered then
    UnRegister;
  if Assigned(FMsgStoreTable) then
    FMsgStoreTable := nil;
end;

function TMailNotifier.Register: Bool; safecall;
var
  PropTagArray: PSPropTagArray;
  Values: ULONG;
  PropValueArray: PSPropValue;
  SortCriteria: TSSortOrderSet;
  RowSet: PSRowSet;
begin
  PropTagArray := nil;
  PropValueArray := nil;
  RowSet := nil;

  if FRegistered then
  begin
    Result := True;
    Exit;
  end;

  FNewMailSink := TMAPIAdviseSink.Create;

  try
    hr := HrOpenExchangePrivateStore(MAPISession, FMsgStoreTable);
    if Failed(hr) then
    begin
      MessageBox(0, 'Could not open Private Store!', 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage('Could not open Private Store!');
      Exit;
    end;

    hr := FMsgStoreTable.OpenEntry(0, nil, @IID_IMAPIFolder, MAPI_BEST_ACCESS or
      MAPI_NO_CACHE, Values, IUnknown(Inbox));

    if (hr = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER=hr) then
      hr := FMsgStoreTable.OpenEntry(0, nil, @IID_IMAPIFolder, MAPI_BEST_ACCESS,
        Values, IUnknown(Inbox));

    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(FMsgStoreTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(FMsgStoreTable, hr));
      Exit;
    end;

    hr := Inbox.GetContentsTable(0, ContentsTable);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 + GetMAPIError(Inbox, hr)
        ), 'IMI Mail Notification', MB_OK or MB_ICONERROR or
        MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(Inbox, hr));
      Exit;
    end;

    hr := ContentsTable.GetRowCount(0, Values);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(ContentsTable, hr));
      Exit;
    end;

    hr := FMsgStoreTable.Advise(0, nil, fnevNewMail, FNewMailSink,
      FNewMailConnection);

    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(FMsgStoreTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(FMsgStoreTable, hr));
      Exit;
    end;

    hr := Inbox.GetPropList(0, PropTagArray);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 + GetMAPIError(Inbox, hr)
        ), 'IMI Mail Notification', MB_OK or MB_ICONERROR or
        MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(Inbox, hr));
      Exit;
    end;

    hr := Inbox.GetProps(PropTagArray, 0, Values, PropValueArray);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 + GetMAPIError(Inbox, hr)
        ), 'IMI Mail Notification', MB_OK or MB_ICONERROR or
        MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(Inbox, hr));
      Exit;
    end;

    if Assigned(PropTagArray) then
    begin
      MAPIFreeBuffer(PropTagArray);
      PropTagArray := nil;
    end;

    hr := SizedSPropTagArray([PR_ENTRYID, PR_PRIORITY], PropTagArray);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 + GetMAPIError(nil, hr)),
        'IMI Mail Notification', MB_OK or MB_ICONERROR or
        MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(nil, hr));
      Exit;
    end;

    hr := ContentsTable.SetColumns(PropTagArray, TBL_BATCH);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(ContentsTable, hr));
      Exit;
    end;

    if Assigned(PropTagArray) then
    begin
      MAPIFreeBuffer(PropTagArray);
      PropTagArray := nil;
    end;

    SortCriteria.cSorts := 1;
    SortCriteria.cCategories := 0;
    SortCriteria.cExpanded := 0;
    SortCriteria.aSort[0].ulPropTag := PR_ENTRYID;
    SortCriteria.aSort[0].ulOrder := TABLE_SORT_ASCEND;

    hr := ContentsTable.SortTable(@SortCriteria, TBL_BATCH);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(ContentsTable, hr));
      Exit;
    end;

    Values := 0;

    hr := ContentsTable.SeekRow(BOOKMARK_BEGINNING, 0, Integer(Values));
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(ContentsTable, hr));
      Exit;
    end;

    hr := ContentsTable.GetRowCount(0, Values);
    if Failed(hr) then
    begin
      MessageBox(0, PChar('Could not Advise!' + #13#10 +
        GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification',
        MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
      DMAPIService.LogMessage(GetMAPIError(ContentsTable, hr));
      Exit;
    end;
  finally
    if Assigned(PropTagArray) then
    begin
      MAPIFreeBuffer(PropTagArray);
      PropTagArray := nil;
    end;
    if Assigned(PropValueArray) then
    begin
      MAPIFreeBuffer(PropValueArray);
      PropValueArray := nil;
    end;

    if Assigned(RowSet) then
    begin
      FreePRows(RowSet);
      RowSet := nil;
    end;
    Result := hr = HRSUCCESS;
    FRegistered := Result;
    if not FRegistered then
      FNewMailSink := nil;
  end;
end;

function TMailNotifier.UnRegister: Bool;
begin
  if not FRegistered then
    Exit;

  if Assigned(ContentsTable) then
    ContentsTable := nil;

  if Assigned(Inbox) then
    Inbox := nil;

  hr := FMsgStoreTable.Unadvise(FNewMailConnection);
  FRegistered := Failed(hr);
  Result := Succeeded(hr);

  if Result then
    FNewMailSink := nil;
end;

initialization

CoInitialize(nil);
TCOMObjectFactory.Create(ComServer, TMAPIAdviseSink, CLSID_MAPIAdviseSink,
  'IMINewMailAS', 'IMIBO New Mail Advise Sink', ciMultiInstance);

finalization

CoUnInitialize;

end.