Development

unit IMIMailNotifier;

interface

{$I IMI.INC}

uses Comobj, Windows, ExtendedMAPI;

const

  (*
   To get a unique COM object, you have to generate our own GUID.
   You can do this with the Ctrl+Shift+G buttons in Delphi.
   *)

  CLSID_MAPIAdviseSink: TGUID = '{B9197B72-6070-11D4-9E24-0000B45AB267}';

  (*
   As you can see, the declaration of our COM object is very simple but sufficient
   *)

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

  (*
   The entire performance of the MAPI session,
   the registration of AdviseSink for notification will be performed by
   the TMailNotifier object
   *)

  TMailNotifier = class(TObject)
  private
    FMAPIInitialized, FMAPILoged, FRegistered: boolean;
    hr: HRESULT;
  private
    MsgStoreTable: IMsgStore;
    Inbox: IMAPIFolder;
    ContentsTable: IMapiTable;
    MAPISession: IMAPISession;
    NewMailSink: IMAPIAdviseSink;
    NewMailConnection: ULONG_PTR;
  public
    function Logon: boolean;
    procedure Logoff;
    function Register: boolean;
    function UnRegister: boolean;
    destructor Destroy; override;
  end;

var
  MailNotifier: TMailNotifier = nil;

implementation

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

(*
 CallBack function through which the MAPI SubSystem notifies our program
 of the events that have occurred.

 The function has two parameters:
 cbNotif  that contains the number of received notification, and
 lpNotifications - a Pointer containing a structure with the information
 of the changes that have occurred.
 Since we will look for new messages,
 we will define a variable of the Imessage type that we will study.
*)

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;

  (*
   We have registered to receive notifications of the receipt of new messages.
   In other words, we will be interested in the NEWMAIL_NOTIFICATION version part
   of the lpNotifications - lpNotifications.info.newmail.

   Part of what the NEWMAIL_NOTIFICATION structure provides is
   cbEntryID - number of bytes in ENTRYID
   ENTRYID   - unique identifier of the incoming message
   cbParentID - number of bytes in ParentID
   ParentID -  unique identifier of the folder into which the message is received.

   There are two options - to get an interface to the MAPI folder
   into which the incoming message is received and from there
   to get an interface to IMessage,
   or
   to directly "force" the MAPISession object to provide us with
   access to the IMessage object.

   Since we are not interested in which folder the incoming message is received
   and we won't do anything with this folder, e.g. deleting the message or moving it
   to another location, we will chose the second option - force the MAPISession.
   *)

  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, ObjType, IUnknown(MAPIMessage));
        if Failed(hr) then
        begin
          MessageBox(0, PChar(GetMAPIError(MailNotifier.MAPISession, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
          Exit;
        end;

        MessagePropTagArray := nil;
        ObjType := 0;

        (*
         We will take only two of the incoming message properties - SUBJECT and sender.
         There is no restriction as to the number of properties that you can require,
         however, for our simple example we will enter only the above two properties,
         since a PopUp MessageBox pops up.

         We will construct a PropTagArray with these Properties.
         *)

        hr := SizedSPropTagArray([PR_SUBJECT, PR_SENDER_EMAIL_ADDRESS], MessagePropTagArray);
        if Failed(hr) then
        begin
          MessageBox(0, PChar(GetMAPIError(nil, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
          Exit;
        end;

        MessagePropValueArray := nil;

        (*
         Taking the properties
         *)

        hr := MAPIMessage.GetProps(MessagePropTagArray, 0, ObjType, MessagePropValueArray);
        if Failed(hr) then
        begin
          MessageBox(0, PChar(GetMAPIError(MAPIMessage, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
          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;
        MessageBox(Application.Handle, PChar(StringMessage), 'IMI Mail Notification', MB_OK or MB_ICONINFORMATION);
      finally
        (*
         Freeing memory that we have allocated
         *)

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

        Result := hr;
      end;
    end;

end;

destructor TMailNotifier.Destroy;
begin
  Logoff;
  inherited Destroy;
end;

function TMailNotifier.Logon: boolean;
begin
  Result := False;
  (*
   We will use a very simple code a new Session with MAPI SubSystems
   *)

  try
    FMAPIInitialized := Succeeded(MAPIInitialize(nil));
    if not FMAPIInitialized then
    begin
      MessageBox(0, 'I cannot initialize MAPI Session!', 'IMI Mail Notification', MB_OK or MB_ICONERROR);
      Exit;
    end;
    FMAPILoged := Succeeded(MAPILogonEx(Application.Handle, nil, nil, MAPI_LOGON_UI or MAPI_EXTENDED or MAPI_NEW_SESSION, MAPISession));
    if not FMAPILoged then
      MessageBox(0, 'I can''t open the MAPI Session!', 'IMI Mail Notification', MB_OK or MB_ICONERROR);
  finally
    Result := FMAPILoged;
  end;
end;

procedure TMailNotifier.Logoff;
var
  flag: ULONG;
begin
  try
    if FRegistered then
      UnRegister;

    if Assigned(MsgStoreTable) then
    begin
      flag := LOGOFF_NO_WAIT;
      MsgStoreTable.StoreLogoff(flag);
      MsgStoreTable := nil;
    end;

    if FMAPILoged then
      MAPISession.Logoff(Application.Handle, MAPI_LOGOFF_UI, 0);
    MAPISession := nil;

    if FMAPIInitialized then
      MAPIUninitialize;

  finally
    FMAPILoged := False;
    FMAPIInitialized := False;
  end;
end;

(*
 In the next function we will perform the basic steps of IMAPIAdviseSink registration
*)
function TMailNotifier.Register: boolean;
var
  MessageStoreENTRYID: TSBinary;
  cbEID: Integer;
  TagArray: PSPropTagArray;
  cValues: ULONG;
  ValueArray: PSPropValue;
  SortCriteria: TSSortOrderSet;
  // RowSet: PSRowSet;    Microsoft Exchange Server 2010 bug-bug ??
begin
  Result := False;
  hr := ERROR_CAN_NOT_COMPLETE;

  if FRegistered then
    Exit;

  // Creating our Delphi MAPIAdviseSink object
  NewMailSink := TMAPIAdviseSink.Create;

  ZeroMemory(@MessageStoreENTRYID, SizeOf(MessageStoreENTRYID));

  (* We can look for the incoming New Mail in a defined folder or
    in the entire Mailbox. We will choose the second option.
    Not because it is more specific, but simply because we chose to do it this way.

    Using the EDK function HrMAPIFindDefaultMsgStore,
    we will take EntryID of the Default MsgStor�, and we will get an interface to
    the MsgStor� object via MapiSession
    *)
  hr := HrMAPIFindDefaultMsgStore(MAPISession, MessageStoreENTRYID.cb, PENTRYID(MessageStoreENTRYID.lpb));
  if Failed(hr) then
  begin
    MessageBox(Application.Handle, PChar('I cannot find Store!' + #13#10 + GetMAPIError(MAPISession, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    Exit;
  end;

  hr := MAPISession.OpenMsgStore(Application.Handle, MessageStoreENTRYID.cb, PENTRYID(MessageStoreENTRYID.lpb), @IID_IMsgStore,
    MAPI_BEST_ACCESS or MDB_NO_DIALOG or MAPI_NO_CACHE, MsgStoreTable);

  if (hr = MAPI_E_UNKNOWN_FLAGS)  or (MAPI_E_FAILONEPROVIDER=hr)  then
    hr := MAPISession.OpenMsgStore(Application.Handle, MessageStoreENTRYID.cb, PENTRYID(MessageStoreENTRYID.lpb), @IID_IMsgStore,
      MAPI_BEST_ACCESS or MDB_NO_DIALOG, MsgStoreTable);

  if Failed(hr) then
  begin
    MessageBox(Application.Handle, PChar('I cannot open Store!' + #13#10 + GetMAPIError(MAPISession, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    Exit;
  end;

  if Assigned(MessageStoreENTRYID.lpb) then
    MAPIFreeBuffer(MessageStoreENTRYID.lpb);

  (*
   Since some MAPI MsgStore cache the query to the MAPI, we will have to force MsgStore.

   This means that an application cannot simply call Advise and wait for
   notifications to appear. It must call Advise and then, for example,
   call IMAPIProps.GetProps on a property known not to be cached on the client.
   This GetProps call can be executed on any object, such as the information store itself.

   An RPC can initiate the return of notifications,
   but an Advise call itself does not force an RPC.

   We should to force notification. For this, we will create some RPC trafic
   *)

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

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

  if Failed(hr) then
  begin
    MessageBox(Application.Handle, PChar(GetMAPIError(MsgStoreTable, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    Exit;
  end;

  hr := Inbox.GetContentsTable(0, ContentsTable);
  if Failed(hr) then
  begin
    MessageBox(Application.Handle, PChar(GetMAPIError(Inbox, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    Exit;
  end;

  hr := ContentsTable.GetRowCount(0, cValues);
  if Failed(hr) then
  begin
    MessageBox(Application.Handle, PChar(GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    Exit;
  end;

  (*
   Well, let's hope that the above rows have generated enough RPC traffic

   Now we will perform the "hooking" to the  MsgStore and we will wait for
   a New Mail notification.
   For this purpose we set the  fnevNewMail as an "EventMask" property.
   Defining 0 and NIL in the first two parameters, we will force the notification
   to be for the entire MsgStore. If we set a valid ENTRYID of a folder as a parameter,
   we may monitor the changes in it.

   As a fourth parameter "AdviseSink" we set our DELPHI AdviseSink object.
   In the last parameter - "Connection", in case of a successful connection,
   MAPI SubSystem will produce a unique number of the connection.

   If we use the same AdviseSink object to look for other changes and/or objects,
   we may identify from which object the notification comes from by this unique number.
   *)

  NewMailConnection := 0;

  hr := MsgStoreTable.Advise(0, nil, fnevNewMail, NewMailSink, NewMailConnection);

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

  (*
   In order to "wake up" the MAPI Subsystem, and ignore the caching,
   we will again force RPC traffic, this time a little more intensely.
   All this is necessary when our MsgStore is on an Exchange Server.
   When we have a local MsgStore, it will suffice to only take some property
   through the function
   HrGetOneProp(lpMapiProp: IMAPIPROP; ulPropTag: ULONG; out lppProp: PSPropValue): HResult
   that generates the necessary RPC traffic
   *)

  hr := Inbox.GetPropList(0, TagArray);

  if Failed(hr) then
  begin
    if Assigned(TagArray) then
      MAPIFreeBuffer(TagArray);
    TagArray := nil;
    if Assigned(ValueArray) then
      MAPIFreeBuffer(ValueArray);
    ValueArray := nil;
    Exit;
  end;

  hr := Inbox.GetProps(TagArray, 0, cValues, ValueArray);
  if Failed(hr) then
  begin
    MessageBox(0, PChar(GetMAPIError(Inbox, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    NewMailSink := nil;
    Exit;
  end;

  if Assigned(TagArray) then
    MAPIFreeBuffer(TagArray);
  TagArray := nil;
  if Assigned(ValueArray) then
    MAPIFreeBuffer(ValueArray);
  ValueArray := nil;

  hr := MAPIAllocateBuffer(CbNewSPropTagArray(2), Pointer(TagArray));
  if Failed(hr) then
  begin
    MessageBox(0, PChar(GetMAPIError(nil, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    NewMailSink := nil;
    Exit;
  end;

  TagArray.cValues := 2;
  TagArray.aulPropTag[0] := PR_ENTRYID;
  TagArray.aulPropTag[TagArray.cValues - 1] := PR_PRIORITY;
  hr := ContentsTable.SetColumns(TagArray, TBL_BATCH);
  MAPIFreeBuffer(TagArray);

  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(GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    NewMailSink := nil;
    Exit;
  end;

  cbEID := 0;
  hr := ContentsTable.SeekRow(BOOKMARK_BEGINNING, 0, cbEID);
  if Failed(hr) then
  begin
    MessageBox(0, PChar(GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    NewMailSink := nil;
    Exit;
  end;

  hr := ContentsTable.GetRowCount(0, cValues);
  if Failed(hr) then
  begin
    MessageBox(0, PChar(GetMAPIError(ContentsTable, hr)), 'IMI Mail Notification', MB_OK or MB_ICONERROR);
    NewMailSink := nil;
    Exit;
  end;
  (*
   End of forcing
   *)

  Result := hr = HRSUCCESS;
  FRegistered := Result;
end;

function TMailNotifier.UnRegister: boolean;
var
  hr: HRESULT;
begin
  Result := True;
  if not FRegistered then
    Exit;
  if Assigned(ContentsTable) then
    ContentsTable := nil;
  if Assigned(Inbox) then
    Inbox := nil;
  hr := MsgStoreTable.Unadvise(NewMailConnection);
  FRegistered := Failed(hr);
  Result := Succeeded(hr);
  if Result then
    NewMailSink := nil;
end;

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

finalization
 CoUnInitialize;

end.