Development

unit Main;

interface

{ Please add "..\Library" to project search path }

{$I IMI.INC}

// If you receive "Class not registered" when you click over LogOn button
// please install CDO Library

(*
  About CDO

  Where to acquire the CDO Libraries (all versions)

  Please visit:
  http://support.microsoft.com/kb/171440

*)

uses
  Classes, Controls, Forms, ComCtrls, ExtCtrls, ImgList, MAPI_TLB, StdCtrls,
  Buttons, Menus;

type
  TFormMain = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    Panel2: TPanel;
    ListView1: TListView;
    Label3: TLabel;
    btLogOn: TSpeedButton;
    btGetFolders: TSpeedButton;
    btNewMessage: TSpeedButton;
    PopupMenu1: TPopupMenu;
    Delete1: TMenuItem;
    Memo1: TRichEdit;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    TreeView1: TTreeView;
    Splitter2: TSplitter;
    procedure btLogOnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btGetFoldersClick(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure ListView1Click(Sender: TObject);
    procedure btNewMessageClick(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
  private
    { Private declarations }
    procedure ClearTree;
    procedure ClearListView;
    procedure BuildTree(objParentFolder: Folder; Node: TTreeNode);
  public
    { Public declarations }
    objSession: _Session;

  end;

var
  FormMain: TFormMain;

implementation

uses
{$IFDEF DELPHI2011XE2}
UITypes,
{$ENDIF}
Variants, CreateMessage, SysUtils, Dialogs;

{$R *.DFM}

procedure TFormMain.ClearTree;
var
  Count: integer;
begin

  for Count := 0 to TreeView1.Items.Count - 1 do
    try
      if Assigned(TreeView1.Items[Count].Data) then
        IUnknown(TreeView1.Items[Count].Data)._Release;
    finally
      TreeView1.Items[Count].Data := nil;
    end;
  TreeView1.Items.Clear;
end;

procedure TFormMain.ClearListView;
var
  Count: integer;
begin
  for Count := 0 to ListView1.Items.Count - 1 do
    try
      if Assigned(ListView1.Items[Count].Data) then
        IUnknown(ListView1.Items[Count].Data)._Release;
    finally
      ListView1.Items[Count].Data := nil;
    end;
  ListView1.Items.Clear;
end;

procedure TFormMain.btLogOnClick(Sender: TObject);
var
  CurrentUser: AddressEntry;
begin

  try
    if not Assigned(objSession) then
      objSession := CoSession.Create;
  except
    on e: Exception do
    begin
      ShowMessage(e.Message);
      objSession := nil;
      exit;
    end;
  end;

  try
    // We will Log On to the MAPI system

    { Syntax
      objSession.Logon([profileName][,profilePassword][,showDialog][,newSession][,parentWindow][,NoMail][,ProfileInfo])

      objSession
      Required. The Session object.
      profileName
      Optional. String. Specifies the profile name to use. To prompt the user to select a profile name, omit profileName and set showDialog to True. The default value is an empty string. The profileName parameter is ignored if the ProfileInfo parameter is supplied.
      profilePassword
      Optional. String. Specifies the profile password. To prompt the user to enter a profile password, omit profilePassword and set showDialog to True. The default value is an empty string.
      showDialog
      Optional. Boolean. If True, displays a Choose Profile dialog box. The default value is True.
      newSession
      Optional. Boolean. Determines whether the application opens a new MAPI session or uses the current shared MAPI session. The default value is True. If a shared MAPI session does not exist, newSession is ignored and a new session is opened. If a shared MAPI session does exist, this parameter governs the following actions: Value  Action
      True  - Opens a new MAPI session (default).
      False - Uses the current shared MAPI session.
      parentWindow
      Optional. Long. Specifies the parent window handle for the logon dialog box. A value of zero (the default) specifies that the dialog box should be application-modal. A value of 1 specifies that the currently active window is to be used as the parent window. The parentWindow parameter is ignored unless showDialog is True.
      NoMail
      Optional. Boolean. Determines whether the session should be registered with the MAPI spooler. This parameter governs the following actions: Value  Action
      True  - The MAPI spooler is not informed of the sessions existence, and no messages can be sent or received except through a tightly coupled message store and transport.
      False - The session is registered with the MAPI spooler and can send and receive messages through spooling (default).

      ProfileInfo
      Optional. String. Contains the server and mailbox names that Logon should use to create a new profile for this session. The profile is deleted after logon is completed or terminated. The ProfileInfo parameter is only used by applications interfacing with Microsoft Exchange Server. The profileName parameter is ignored if ProfileInfo is supplied.
    }

    objSession.Logon(EmptyParam, EmptyParam, True, True,
      OleVariant(Application.Handle), False, EmptyParam);

    // The CurrentUser property returns the active user as an AddressEntry object.
    // Read-only.

    CurrentUser := AddressEntry(TVarData(objSession.CurrentUser).VDispatch);

    // The Name property returns or sets the display name or alias of the AddressEntry object.
    Label1.Caption := Label1.Caption + ' ' + VarToStr(CurrentUser.Name);

    // The Address property specifies the messaging address
    Label2.Caption := Label2.Caption + ' ' + VarToStr(CurrentUser.Address);

    btLogOn.Enabled := False;
    btGetFolders.Enabled := True;
    btNewMessage.Enabled := True;
  except
    raise
  end;

end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  btGetFolders.Enabled := False;
  btNewMessage.Enabled := False;
  Delete1.Enabled := False;
{$IF DEFINED (WIN64)}
  Self.Caption := Self.Caption + ' - WIN64';
  // !!!!
  Collaboration Data Objects(CDO)1.2.1 is not supported with Outlook 2010
    Please, see http: // support.microsoft.com/kb/2028411
  // !!!!
{$ELSE}
  Self.Caption := Self.Caption + ' - WIN32';
{$IFEND}
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Memo1.Clear;
  ClearListView;
  ClearTree;

  {
    The Logoff method logs off from the MAPI system.

    Syntax
    objSession.Logoff
  }
  try
    if Assigned(objSession) then
      objSession.Logoff;
  finally
    objSession := nil;
  end;
end;

procedure TFormMain.btGetFoldersClick(Sender: TObject);
var
  Count: integer;
  objInfoStore: InfoStore;
  objInfoStores: InfoStores;
  Node: TTreeNode;
  objRootFolder: Folder;
begin
  ClearTree;

  if Assigned(objSession) then
    try
      {
        The InfoStores property returns a single InfoStore object
        or an InfoStores collection available to this session.
        The InfoStore object provides access to the folder hierarchy
        of a message store.
        Read-only.
      }

      objInfoStores := InfoStores(TVarData(objSession.InfoStores).VDispatch);

      // We will build Mailbox Tree (hierarchy)
      for Count := 1 to objInfoStores.Count do
      begin
        objInfoStore := InfoStore(TVarData(objInfoStores.Item[Count])
          .VDispatch);
        Node := TreeView1.Items.AddObject(nil, objInfoStore.Name + ' :' +
          objInfoStore.ProviderName, Pointer(objInfoStore));
        IUnknown(Node.Data)._AddRef;
        // Force _AddRef - TTreeNode use Pointer for Data
        try
          // The RootFolder property returns a Folder object representing
          // the root of the IPM subtree for the InfoStore object. Read-only.
          objRootFolder := Folder(TVarData(objInfoStore.RootFolder).VDispatch);
          if Assigned(objRootFolder) then
            BuildTree(objRootFolder, Node);
        except
        end;
      end;

      btGetFolders.Enabled := False;
    except
      ClearTree;
      btGetFolders.Enabled := True;
      raise;
    end;
end;

procedure TFormMain.BuildTree(objParentFolder: Folder; Node: TTreeNode);
var
  objFoldersColl: Folders; // the child Folders collection
  objSubfolder: Folder; // a single Folder object
  ChildNode: TTreeNode;
begin
  try
    if Assigned(objParentFolder) then
    begin
      // The Folders property returns a Folders collection of subfolders within the folder. Read-only.
      objFoldersColl := Folders(IUnknown(objParentFolder.Folders));

      if Assigned(objFoldersColl) then // loop through all
      begin
        // The Class_ property returns the object class of the object. Read-only.

        if ((Folder(IUnknown(objParentFolder.Parent)).Class_ <> CdoInfoStore)
          and (Folder(IUnknown(objParentFolder.Parent)).Class_ <> CdoInfoStores))
        then
        begin
          ChildNode := TreeView1.Items.AddChildObject(Node,
            objParentFolder.Name, Pointer(objParentFolder));
          IUnknown(ChildNode.Data)._AddRef;
          // Force _AddRef - TTreeNode use Pointer for Data
        end
        else
          ChildNode := Node;

        // The GetFirst method returns the first Folder object in the Folders collection.
        // It returns nil if no first object exists.
        objSubfolder := Folder(IUnknown(objFoldersColl.GetFirst));
        while Assigned(objSubfolder) do
        begin
          BuildTree(objSubfolder, ChildNode);
          // The GetNext method returns the next Folder object in the Folders collection.
          // It returns nil if no next object exists
          objSubfolder := Folder(IUnknown(objFoldersColl.GetNext));
        end;
      end;
    end;
  except
    ClearTree;
    raise;
  end;
end;

procedure TFormMain.TreeView1Click(Sender: TObject);
var
  objFolder: Folder;
  objMessages: Messages;
  objMessage: Message;
  iCount, jCount: integer;
  ListItem: TListItem;
  objSender: AddressEntry;
begin
  Memo1.Lines.Clear;

  if Assigned(TreeView1.Selected) then
  begin
    objFolder := Folder(TreeView1.Selected.Data);
    if objFolder.Class_ = CdoFolder then
      // The Messages property returns a Messages collection object within the folder. Read-only.
      objMessages := Messages(TVarData(objFolder.Messages).VDispatch);

    if Assigned(objMessages) then
    begin
      ClearListView;
      // The Count property returns the number of AppointmentItem, MeetingItem,
      // or GroupHeader and Message objects in the collection,
      // or  $7FFFFFFF if the exact count is not available
      Label3.Caption := 'Messages: ' + VarToStr(objMessages.Count);

      if (objMessages.Count > 0) and (objMessages.Count <> $7FFFFFFF) then
      begin
        jCount := objMessages.Count;
        for iCount := 1 to jCount do
        begin
          objMessage := Message(TVarData(objMessages.Item[iCount]).VDispatch);
          ListItem := ListView1.Items.Add;
          try
            try
              objSender := AddressEntry(TVarData(objMessage.Sender).VDispatch);
              if Assigned(objSender) then
                ListItem.Caption := objSender.Address;
            except
              ListItem.Caption := 'MESSAGE ' + IntToStr(iCount);
            end;

            try
              ListItem.SubItems.Add(objMessage.Subject);
              try
                ListItem.SubItems.Add(VarToStr(objMessage.TimeSent));
              except
                ListItem.SubItems.Add('');
              end;
              try
                ListItem.SubItems.Add(VarToStr(objMessage.TimeReceived));
              except
                ListItem.SubItems.Add('');
              end;
            finally
              ListItem.Data := Pointer(objMessage);
            end;

            if objMessage.Unread then
              ListItem.StateIndex := 2
            else
              ListItem.StateIndex := 1;
          finally
            if Assigned(ListItem.Data) then
              IUnknown(ListItem.Data)._AddRef;
          end;
        end;
      end; // for
    end; // if Assigned(objMessages)
  end; // if Assigned(TreeView1.Selected)
end;

procedure TFormMain.ListView1Click(Sender: TObject);
var
  objMessage: Message;
begin
  Memo1.Lines.Clear;
  if Assigned(ListView1.Selected) then
  begin
    Delete1.Enabled := True;

    objMessage := IUnknown(ListView1.Selected.Data) as Message;
    Memo1.Lines.Add(VarToStr(objMessage.Text));
    objMessage.Unread := False;
    if objMessage.Unread then
      ListView1.Selected.StateIndex := 2
    else
      ListView1.Selected.StateIndex := 1;
    objMessage.UPDATE(True, True);
    Memo1.SelStart := 0;
  end;

end;

procedure TFormMain.btNewMessageClick(Sender: TObject);
begin
  FormNewMessage := TFormNewMessage.Create(Self);
  FormNewMessage.ShowModal;
  FormNewMessage.Free;
end;

procedure TFormMain.Delete1Click(Sender: TObject);
var
  objMessage: Message;
begin
  if Assigned(ListView1.Selected) then
    if MessageDLG('Delete now?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      try
        objMessage := IUnknown(ListView1.Selected.Data) as Message;
        IUnknown(ListView1.Selected.Data)._Release;
        ListView1.Selected.Data := nil;
        objMessage.Delete(True);
        objMessage := nil;
        ListView1.Selected.Delete;
        Memo1.Clear;
      except
      end;
end;

end.

unit CreateMessage;

interface

{$I IMI.INC}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}

uses
  Classes, Controls, Forms, StdCtrls;

type
  TFormNewMessage = class(TForm)
    ebSubject: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ebTo: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    ObjTemp, ObjTemp2, ObjTemp3: olevariant;
  public
    { Public declarations }
  end;

var
  FormNewMessage: TFormNewMessage;

implementation

uses Variants, SysUtils, Main, Dialogs, MAPI_TLB;

{$R *.DFM}

procedure TFormNewMessage.Button1Click(Sender: TObject);
begin

  if Assigned(Recipient(TVarData(ObjTemp3).VDispatch)) then
  begin
    if Trim(ebTo.Text) = '' then
      Recipient(TVarData(ObjTemp3).VDispatch).Name := 'user'
    else
      Recipient(TVarData(ObjTemp3).VDispatch).Name := ebTo.Text;

    Recipient(TVarData(ObjTemp3).VDispatch).Resolve(True);
    ebTo.Text := VarToStr(Recipient(TVarData(ObjTemp3).VDispatch)
      .AddressEntry.Name);
    ebTo.Enabled := False;
    Button2.Enabled := True;
  end;
end;

procedure TFormNewMessage.FormCreate(Sender: TObject);
begin
  Button2.Enabled := False;
  ObjTemp := FormMain.objSession.Outbox.Messages.Add;
  ObjTemp2 := Message(TVarData(ObjTemp).VDispatch).Recipients;
  ObjTemp3 := Recipients(TVarData(ObjTemp2).VDispatch).Add(EmptyParam, EmptyParam, CDOTo, EmptyParam);
end;

procedure TFormNewMessage.Button2Click(Sender: TObject);
begin
  Recipient(TVarData(ObjTemp3).VDispatch).Type_ := CDOTo;
  Recipients(TVarData(ObjTemp2).VDispatch).Resolve(True);
  if Trim(ebSubject.Text) = '' then
    Message(TVarData(ObjTemp).VDispatch).Subject := 'Subject'
  else
    Message(TVarData(ObjTemp).VDispatch).Subject := ebSubject.Text;
  if Trim(Memo1.Text) = '' then
    Message(TVarData(ObjTemp).VDispatch).Text := 'Body'
  else
    Message(TVarData(ObjTemp).VDispatch).Text := Memo1.Text;
  try
    Message(TVarData(ObjTemp).VDispatch).Update(True, False);

    Message(TVarData(ObjTemp).VDispatch).Send(CheckBox1.Checked, False, 0);

    ShowMessage('The message has been sent');
  except
    ShowMessage('The message is not sent');
  end;
  ModalResult := mrOk;
end;
end.