Development

unit ExMAPIFormViewer;

interface

{$I IMI.INC}

uses ActiveX, ExtendedMAPI, Windows;

type
  TMAPIFormViewer = class(TInterfacedObject, IMAPIMessageSite, IMAPIViewContext, IMAPIViewAdviseSink)
    // IMAPIViewAdviseSink
    function OnShutdown: HResult; stdcall;
    function OnNewMessage: HResult; stdcall;
    function OnPrint(PageNumber: ULONG; Status: HResult): HResult; stdcall;
    function OnSubmitted: HResult; stdcall;
    function OnSaved: HResult; stdcall;
    // IMAPIMessageSite
    function GetLastError(Error: HResult; Flags: ULONG; out MAPIError: PMAPIERROR): HResult; stdcall;
    function GetSession(out Session: IMAPISession): HResult; stdcall;
    function GetStore(out Store: IMsgStore): HResult; stdcall;
    function GetFolder(out Folder: IMAPIFolder): HResult; stdcall;
    function GetMessage(out Msg: IMessage): HResult; stdcall;
    function GetFormManager(out FormMgr: IMAPIFormMgr): HResult; stdcall;
    function NewMessage(ComposeInFolder: BOOL; FolderFocus: IMAPIFolder; PersistMessage: IPersistMessage; out Message: IMessage;
      out MessageSite: IMAPIMessageSite; out ViewContext: IMAPIViewContext): HResult; stdcall;
    function CopyMessage(FolderDestination: IMAPIFolder): HResult; stdcall;
    function MoveMessage(FolderDestination: IMAPIFolder; ViewContext: IMAPIViewContext; PosRect: PRECT): HResult; stdcall;
    function DeleteMessage(ViewContext: IMAPIViewContext; PosRect: PRECT): HResult; stdcall;
    function SaveMessage: HResult; stdcall;
    function SubmitMessage(Flags: ULONG): HResult; stdcall;
    function GetSiteStatus(out Status: ULONG): HResult; stdcall;
    // IMAPIViewContext
    function SetAdviseSink(pmvns: IMAPIFormAdviseSink): HResult; stdcall;
    function ActivateNext(Direction: ULONG; PosRect: PRECT): HResult; stdcall;
    function GetPrintSetup(Flags: ULONG; out FormPrintSetup: PFORMPRINTSETUP): HResult; stdcall;
    function GetSaveStream(out Flags: ULONG; out StreamFormat: ULONG; out Stream: IStream): HResult; stdcall;
    function GetViewStatus(out Status: ULONG): HResult; stdcall;
    // Self declarations
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function SetForm(MapiForm: IMAPIForm): HResult; stdcall;
    function SetPersist(PersistMessage: IPersistMessage): HResult; stdcall;
  private
    FFolder: IMAPIFolder;
    FMessage: IMessage;
    FMapiFormAdviseSink: IMAPIFormAdviseSink;
    FPersistMessage: IPersistMessage;
    FMessageEID: TSBinary;
    FConnection: ULONG_PTR;
    FMDB: IMsgStore;
    FMAPISession: IMAPISession;
    HR: HResult;
  public
    constructor Create(MDB: IMsgStore; MAPISession: IMAPISession;
      Folder: IMAPIFolder; Message: IMessage; MessageEID: PSBinary);
    destructor Destroy; override;
  end;

implementation

uses EDK, MainUnit, MAPIMacros, MAPIUtils;

constructor TMAPIFormViewer.Create(MDB: IMsgStore; MAPISession: IMAPISession; Folder: IMAPIFolder; Message: IMessage; MessageEID: PSBinary);
var
  Prop: PSPropValue;
begin
  inherited Create;
  Prop := nil;
  FMAPISession := MAPISession;
  FMDB := MDB;

  FFolder := Folder;
  FMessage := Message;

  if Assigned(MessageEID) then
    FMessageEID := MAPICloneTSBinary(MessageEID^)
  else
  begin
    HR := HrGetOneProp(FMessage, PR_ENTRYID, Prop);
    if failed(HR) then
    begin
      FMessage.SaveChanges(KEEP_OPEN_READWRITE);
      HR := HrGetOneProp(FMessage, PR_ENTRYID, Prop);
    end;

    FMessageEID := MAPICloneTSBinary(Prop.Value.bin);
    if Assigned(Prop) then
      MAPIFreeBuffer(Prop);
  end;

  FPersistMessage := nil;
  FMapiFormAdviseSink := nil;
  FConnection := 0;
end;

destructor TMAPIFormViewer.Destroy;
begin
  if Assigned(FMessageEID.lpb) then
    MAPIFreeBuffer(FMessageEID.lpb);
  Pointer(FPersistMessage) := nil;
  FMessage := nil;
  FMapiFormAdviseSink := nil;
  FFolder := nil;
  FMDB := nil;
  FMAPISession := nil;
  inherited Destroy;
end;

///////////////////////////////////////////////////////////////////////////////
// IMAPIViewAdviseSink implementation
///////////////////////////////////////////////////////////////////////////////
function TMAPIFormViewer.OnShutdown: HResult;
var
  MapiForm: IMAPIForm;
begin
  HR := S_OK;
  MapiForm := nil;
  Result := HR;
  try
    HR := FPersistMessage.QueryInterface(IID_IMAPIForm, Pointer(MapiForm));
    if failed(HR) then
      exit;

    HR := MapiForm.Unadvise(FConnection);
    if failed(HR) then
      exit;

  finally
    MapiForm := nil;
    Result := HR;
  end;

end;

function TMAPIFormViewer.OnNewMessage: HResult;
begin
  Result := S_OK;
end;

function TMAPIFormViewer.OnPrint(PageNumber: ULONG; Status: HResult): HResult;
begin
  Result := S_OK;
end;

function TMAPIFormViewer.OnSubmitted: HResult; stdcall;
begin
  Result := S_OK;
end;

function TMAPIFormViewer.OnSaved: HResult; stdcall;
begin
  Result := S_OK;
end;

///////////////////////////////////////////////////////////////////////////////
// IMAPIMessageSite implementation
///////////////////////////////////////////////////////////////////////////////

function TMAPIFormViewer.GetSession(out Session: IMAPISession)
  : HResult; stdcall;
begin
  Session := FMAPISession;
  Result := S_OK;
end;

function TMAPIFormViewer.GetStore(out Store: IMsgStore): HResult; stdcall;
begin
  Store := FMDB;
  Result := S_OK;
end;

function TMAPIFormViewer.GetFolder(out Folder: IMAPIFolder): HResult; stdcall;
begin
  Folder := FFolder;
  Result := S_OK;
end;

function TMAPIFormViewer.GetMessage(out Msg: IMessage): HResult; stdcall;
begin
  if Assigned(FMessage) then
  begin
    Msg := FMessage;
    Result := S_OK;
  end
  else
  begin
    Msg := nil;
    Result := S_FALSE;
  end;
end;

function TMAPIFormViewer.GetFormManager(out FormMgr: IMAPIFormMgr)
  : HResult; stdcall;
begin
  Result := MAPIOpenFormMgr(FMAPISession, FormMgr);
end;

function TMAPIFormViewer.NewMessage(ComposeInFolder: BOOL; FolderFocus: IMAPIFolder; PersistMessage: IPersistMessage;
  out Message: IMessage; out MessageSite: IMAPIMessageSite; out ViewContext: IMAPIViewContext): HResult; stdcall;
var
  MAPIFormViewer: TMAPIFormViewer;
begin
  HR := S_OK;
  Result := HR;

  if ((BOOL(ComposeInFolder) = False) or Assigned(FolderFocus) = False) then
    FolderFocus := FFolder;

  try
    HR := FFolder.CreateMessage(nil, 0, Message);

    if failed(HR) then
      exit;

    MAPIFormViewer := TMAPIFormViewer.Create(FMDB, FMAPISession, FolderFocus, Message, nil);

    HR := MAPIFormViewer.SetPersist(PersistMessage);
    if failed(HR) then
      exit;

    MessageSite := MAPIFormViewer;

    HR := MessageSite.QueryInterface(IID_IMAPIViewContext, ViewContext);
    if failed(HR) then
      exit;
  finally
    Result := HR;
  end;
end;

function TMAPIFormViewer.CopyMessage(FolderDestination: IMAPIFolder): HResult; stdcall;
begin
  Result := MAPI_E_NO_SUPPORT;
end;

function TMAPIFormViewer.MoveMessage(FolderDestination: IMAPIFolder; ViewContext: IMAPIViewContext; PosRect: PRECT): HResult; stdcall;
begin
  Result := MAPI_E_NO_SUPPORT;
end;

function TMAPIFormViewer.DeleteMessage(ViewContext: IMAPIViewContext; PosRect: PRECT): HResult; stdcall;
begin
  Result := MAPI_E_NO_SUPPORT;
end;

function TMAPIFormViewer.SaveMessage: HResult; stdcall;
begin
  Result := S_OK;
  try
    HR := FPersistMessage.Save(FMessage, True);
    if failed(HR) then
      exit;

    HR := FMessage.SaveChanges(KEEP_OPEN_READWRITE);
    if failed(HR) then
      exit;
  finally
    Result := HR;
  end;
end;

function TMAPIFormViewer.SubmitMessage(Flags: ULONG): HResult; stdcall;
begin
  Result := S_OK;
  try
    HR := FPersistMessage.Save(FMessage, True);
    if failed(HR) then
      exit;

    HR := FPersistMessage.HandsOffMessage();
    if failed(HR) then
      exit;

    HR := FMessage.SubmitMessage(Flags);
    if failed(HR) then
      exit;

    // Is this needed?
    FMessage := nil;

  finally
    Result := HR;
  end;
end;

function TMAPIFormViewer.GetSiteStatus(out Status: ULONG): HResult; stdcall;
begin
  Status := VCSTATUS_NEW_MESSAGE or VCSTATUS_SAVE or VCSTATUS_SUBMIT;
  Result := S_OK;
end;

function TMAPIFormViewer.GetLastError(Error: HResult; Flags: ULONG;
  out MAPIError: PMAPIERROR): HResult;
begin
  Result := S_OK;
end;


/// ////////////////////////////////////////////////////////////////////////////
// IMAPIViewContext implementation
/// ////////////////////////////////////////////////////////////////////////////
function TMAPIFormViewer.SetAdviseSink(pmvns: IMAPIFormAdviseSink): HResult; stdcall;
begin
  FMapiFormAdviseSink := nil;
  FMapiFormAdviseSink := pmvns;
  Result := S_OK;
end;

function TMAPIFormViewer.ActivateNext(Direction: ULONG; PosRect: PRECT)
  : HResult; stdcall;
var
  NextMessageEID: PSBinary; // do not free!  Why??
  NextMessage: IMessage;
  NextPersistMessage: IPersistMessage;
  MapiForm: IMAPIForm;
  MAPIViewAdviseSink: IMAPIViewAdviseSink;
  MAPIFormMgr: IMAPIFormMgr;
  ObjType, cValuesShow: ULONG;
  vaShow: PSPropValue;
  ptaShowForm: PSPropTagArray;
  Rect: TRECT;
  Flags, Status: ULONG;
  _CLASS: PAnsiChar;

type
  enum = (eFLAGS, eCLASS, eSTATUS);

begin
  NextMessageEID := nil;
  NextMessage := nil;
  NextPersistMessage := nil;
  MapiForm := nil;
  MAPIViewAdviseSink := nil;
  MAPIFormMgr := nil;
  vaShow := nil;
  ptaShowForm := nil;

  Result := MAPI_E_NOT_FOUND;

  if not Assigned(FMDB) then
    exit;

  try
    HR := SizedSPropTagArray([PR_MESSAGE_FLAGS, PR_MESSAGE_CLASS_A, PR_MSG_STATUS], ptaShowForm);
    if failed(HR) then
      exit;

    if ((Direction and VCDIR_NEXT) = VCDIR_NEXT) then
      HR := frmMain.GetNextMessageEID(@FMessageEID, NextMessageEID)
    else if ((Direction and VCDIR_PREV) = VCDIR_PREV) then
      HR := frmMain.GetPrevMessageEID(@FMessageEID, NextMessageEID);

    if (HR = MAPI_E_NOT_FOUND) then
    begin
      HR := MAPI_E_NOT_FOUND;
      exit;
    end;

    if not Assigned(NextMessageEID) or not Assigned(FMapiFormAdviseSink) then
      exit;

    HR := FMDB.OpenEntry(NextMessageEID.cb, PENTRYID(NextMessageEID.lpb), nil,
      // default interface
      MAPI_BEST_ACCESS or MAPI_NO_CACHE, ObjType, IUnknown(NextMessage));

    if (HR = MAPI_E_UNKNOWN_FLAGS) or (MAPI_E_FAILONEPROVIDER=hr) then
      HR := FMDB.OpenEntry(NextMessageEID.cb, PENTRYID(NextMessageEID.lpb),
         nil, // default interface
        MAPI_BEST_ACCESS, ObjType, IUnknown(NextMessage));

    if failed(HR) then
      exit;

    // update the current message pointer
    FMessage := nil;
    FMessage := NextMessage;

    // update the current message EID
    if Assigned(FMessageEID.lpb) then
    begin
      HR := MAPIFreeBuffer(FMessageEID.lpb);
      if failed(HR) then
        exit;
    end;

    FMessageEID := MAPICloneTSBinary(NextMessageEID^);

    HR := FMessage.GetProps(ptaShowForm, // property tag array
      0, // flags
      cValuesShow, // Count of values returned
      vaShow); // Values returned

    if failed(HR) then
      exit;

    if not Assigned(vaShow) or (cValuesShow <= 0) then
      exit;

    if PSPropValueArray(vaShow)[Ord(eFLAGS)].ulPropTag = PR_MESSAGE_FLAGS then
      Flags := PSPropValueArray(vaShow)[Ord(eFLAGS)].Value.ul
    else
      Flags := 0;

    if PSPropValueArray(vaShow)[Ord(eSTATUS)].ulPropTag = PR_MSG_STATUS then
      Status := PSPropValueArray(vaShow)[Ord(eSTATUS)].Value.ul
    else
      Status := 0;

    if PSPropValueArray(vaShow)[Ord(eCLASS)].ulPropTag = PR_MESSAGE_CLASS_A then
      _CLASS := PSPropValueArray(vaShow)[Ord(eCLASS)].Value.lpszA
    else
      _CLASS := 'IPM.Note';

    // check to see if the current form can display the new message or find the needed form
    HR := FMapiFormAdviseSink.OnActivateNext(_CLASS, Status, // message status
      Flags, // message flags
      NextPersistMessage);

    if Succeeded(HR) then // we can handle the message ourselves
    begin
      if Assigned(NextPersistMessage) then
      begin
        // kill the old persist and use the new one
        FPersistMessage := nil;
        FPersistMessage := NextPersistMessage;
      end
      else
      begin
        // we use the current persist and dump it's old message
        HR := FPersistMessage.HandsOffMessage();
        if failed(HR) then
          exit;
      end;

      // load the new message
      HR := FPersistMessage.Load(Self, // as IMAPIMessageSite,
        FMessage, Status, // message status
        Flags); // message flags

      if failed(HR) then
        exit;

      // get a IMAPIForm interface to play with
      HR := FPersistMessage.QueryInterface(IID_IMAPIForm, Pointer(MapiForm));
      if failed(HR) then
        exit;

      HR := MapiForm.SetViewContext(Self);
      if failed(HR) then
        exit;

    end
    // We have to load the form from scratch
    else if (HR = S_FALSE) then
    begin
      // get a IMAPIForm interface so we can shut down the old form
      HR := FPersistMessage.QueryInterface(IID_IMAPIForm, Pointer(MapiForm));
      if failed(HR) then
        exit;

      HR := MapiForm.ShutdownForm(Ord(SAVEOPTS_PROMPTSAVE));
      if failed(HR) then
        exit;

      // remove the old advise sink
      if (FConnection > 0) then
      begin
        HR := MapiForm.Unadvise(FConnection);
        if failed(HR) then
          exit;
        FConnection := 0;
      end;

      MapiForm := nil;
      FPersistMessage := nil;

      // Load the new form
      HR := GetFormManager(MAPIFormMgr);
      if failed(HR) then
        exit;

      HR := MAPIFormMgr.LoadForm(0, // (ULONG) m_hWnd,
        0, // flags
        _CLASS, Status, // message status
        Flags, // message flags
        nil, // parent folder
        Self, // as IMAPIMessageSite,//message site
        NextMessage, Self, // as IMAPIViewContext,//view context
        @IID_IMAPIForm, // riid
        Pointer(MapiForm));

      if failed(HR) then
        exit;

      HR := SetForm(MapiForm);
      if failed(HR) then
        exit;

      Rect.left := 0;
      Rect.right := 500;
      Rect.top := 0;
      Rect.bottom := 400;

      HR := MapiForm.DoVerb(EXCHIVERB_OPEN, nil, // view context
        0, // parent window
        nil); // RECT structure with size
      if (HR <> S_OK) then
      begin
        HR := MapiForm.DoVerb(EXCHIVERB_OPEN, nil, // view context
          0, // parent window
          @Rect); // RECT structure with size

        if failed(HR) then
          exit;
      end;
    end;

  finally
    if Assigned(vaShow) then
      MAPIFreeBuffer(vaShow);
    if Assigned(ptaShowForm) then
      MAPIFreeBuffer(ptaShowForm);
    MAPIFormMgr := nil;
    MAPIViewAdviseSink := nil;
    MapiForm := nil;
    NextPersistMessage := nil;
    NextMessage := nil;
  end;
  Result := HR;
end;

function TMAPIFormViewer.GetPrintSetup(Flags: ULONG;
  out FormPrintSetup: PFORMPRINTSETUP): HResult; stdcall;
begin
  Result := S_OK;
end;

function TMAPIFormViewer.GetSaveStream(out Flags: ULONG;
  out StreamFormat: ULONG; out Stream: IStream): HResult; stdcall;
begin
  Result := S_OK;
end;

function TMAPIFormViewer.GetViewStatus(out Status: ULONG): HResult; stdcall;
var
  TestEID: PSBinary;
begin
  TestEID := nil;
  Status := VCSTATUS_INTERACTIVE or VCSTATUS_READONLY;

  if (MAPI_E_NOT_FOUND <> frmMain.GetNextMessageEID(@FMessageEID, TestEID)) then
    Status := Status or VCSTATUS_NEXT;
  if (MAPI_E_NOT_FOUND <> frmMain.GetPrevMessageEID(@FMessageEID, TestEID)) then
    Status := Status or VCSTATUS_PREV;

  Result := S_OK;
end;

function TMAPIFormViewer.QueryInterface(const IID: TGUID; out Obj)
  : HResult; stdcall;
begin
  Result := inherited QueryInterface(IID, Obj);
end;

function TMAPIFormViewer.SetForm(MapiForm: IMAPIForm): HResult; stdcall;
begin
  FPersistMessage := nil;
  HR := MapiForm.QueryInterface(IID_IPersistMessage, Pointer(FPersistMessage));
  HR := MapiForm.Advise(Self, FConnection);
  Result := HR;
end;

function TMAPIFormViewer.SetPersist(PersistMessage: IPersistMessage)
  : HResult; stdcall;
var
  MapiForm: IMAPIForm;
begin
  HR := S_OK;
  FPersistMessage := nil;

  FPersistMessage := PersistMessage;
  Result := HR;
  try
    HR := FPersistMessage.QueryInterface(IID_IMAPIForm, Pointer(MapiForm));
    if (failed(HR)) then
      exit;

    HR := MapiForm.Advise(Self as IMAPIViewAdviseSink, FConnection);
    if (failed(HR)) then
      exit;

  finally
    MapiForm := nil;
    Result := HR;
  end;
end;

end.