MS Exchange API

Previous  Top  Next

    
 

 

 

 

MS Exchange API via CDO (Collaboration Data Objects)

 

CDO (Collaboration Data Objects) Base Library.

( Talking to MS-Exchange server.)

 

This is a vast subject that is beyond the scope of this article to detail all here. This library provides the basic building blocks for someone who wants to develop using CDO. There are many references on the Net, but your best source is the CDO.HLP file that ships on the Exchange CD or site http://www.cdolive.com/start.htmhttp://www.cdolive.com/start.htm. The cdolive.com site is an excellent reference site which discusses all aspects including installation, versions and also downloads. (CDO.HLP is downloadable from here)

 

My basic class provides the following functionality ..

 

Utility functions and methods

 

Code:

   function CdoNothing(Obj : OleVariant) : boolean;

   function CdoDefaultProfile : string;

   function VarNothing : IDispatch;

 

   procedure CdoDisposeList(WorkList : TList);

   procedure CdoDisposeObjects(WorkStrings : TStrings);

   procedure CdoDisposeNodes(WorkData : TTreeNodes);

 

 

 

Create constructors that allow Default profile logon,Specific profile logon and an Impersonated user logon with profile. (This is required for successful logon in Windows Service Applications)

Code:

  constructor Create; overload;

  constructor Create(const Profile : string); overload;

  constructor Create(const Profile : string;

                      const UserName : string;

                      const Domain : string;

                      const Password : string); overload;

 

 

 

Methods for loading stringlists, treeviews etc. and Object iteration.

Code:

  function LoadAddressList(StringList : TStrings) : boolean;

  function LoadObjectList(const FolderOle : OleVariant;

                          List : TList) : boolean;

  function LoadEMailTree(TV : TTreeView;

                         Expand1stLevel : boolean = false;

                         SubjectMask : string = '') : boolean;

  function LoadContactList(const FolderOle : OleVariant;

                           Items : TStrings) : boolean; overload;

  function LoadContactList(const FolderName : string;

                           Items : TStrings) : boolean; overload;

  procedure ShowContactDetails(Contact : OleVariant);

 

 

 

The above load various lists into stringlists,lists or treeviews. Freeing of lists,object constructs within these data structures are freed at each successive call to the load, however the final Deallocation is the responsibility of the developer, You can do this yourself or use the utility functions CdoDisposeXXX(). See code documentation for further understanding.

Code:

 

  function First(const FolderOle : OleVariant;

                 out ItemOle : OleVariant) : boolean;

  function Last(const FolderOle : OleVariant;

                out ItemOle : OleVariant) : boolean;

  function Next(const FolderOle : OleVariant;

                out ItemOle : OleVariant) : boolean;

  function Prior(const FolderOle : OleVariant;

                 out ItemOle : OleVariant) : boolean;

  function AsString(const ItemOle : Olevariant;

                    const FieldIdConstant : DWORD) : string;

 

The above provide iterations thru object such as Inbox,Contacts etc. The AsString returns a fields value from the object such as Email Address,Name,Company Name etc. (There are miriads of these defined in the CONST section "Field Tags").

 

Properties

Code:

    property CurrentUser : OleVariant read FCurrentUser;

    property Connected : boolean read FConnected;

    property LastErrorMess : string read FlastError;

    property LastErrorCode : DWORD read FlastErrorCode;

    property InBox : OleVariant read FOleInBox;

    property OutBox : OleVariant read FOleOutBox;

    property DeletedItems : Olevariant read FOleDeletedItems;

    property SentItems : Olevariant read FOleSentItems;

    property GlobalAddressList : Olevariant read FOleGlobalAddressList;

    property Contacts : Olevariant read FOleContacts;

    property Session : OleVariant read FOleSession;

    property Version : string read GetFVersion;

    property MyName : string read FMyName;

    property MyEMailAddress : string read FMyEMailAddress;

 

 

 

The Create constructor sets up the predefined objects InBox, OutBox, DeletedItems, SentItems, GlobalAddressList, Session and Contacts. The other properties are self explanatary.

 

As I mentioned earlier the functionality of CDO is vast as objects such as InBox have many methods and properties that included Updating,Inserting Deleting etc. The CDO.HLP file will help to expose these for you. My class is the base of CDO to help simplify building applications and is probably best demonstrated by code snippet examples. Believe me a whole book could be written on this subject, but it is well worth studying as a faster alternative to using MS Outlook API.

Code:

uses Cdo_Lib;

var

Cdo: TcdoSession;

MailItem: OleVariant;

 

// Iterate thru Emails in InBox

begin

Cdo := TCdoSession.Create;

 

if Cdo.Active then

begin

   Cdo.First(Cdo.InBox, MailItem);

 

   while true do

   begin

     if not Cdo.Nothing(MailItem) then

     begin

       Subject := MailItem.Subject;

 

       EMailAddress := Cdo.AsString(MailItem.Sender, CdoPR_EMAIL_AT_ADDRESS);

       EMailName := MailItem.Sender.Name;

       BodyText := MailItem.Text;

 

       // Do something with data and delete the EMail

       MailItem.Delete;

       // Get the next Email

     end;

 

     MailItem := Cdo.Next(Cdo.Inbox.MailItem);

   end;

end;

Cdo.Free;

end;

 

Code:

// Example of loading emails into a treeview and displaying on treeview click

 

unit UBrowse;

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, ToolWin, Menus, ExtCtrls, StdCtrls, Buttons, ImgList,

CDO_Lib;

 

type

TFBrowse = class(TForm)

   Panel1: TPanel;

   Panel3: TPanel;

   Label1: TLabel;

   Label2: TLabel;

   lbFrom: TLabel;

   lbDate: TLabel;

   Memo1: TMemo;

   Panel2: TPanel;

   OKBtn: TBitBtn;

   tvCalls: TTreeView;

   ImageList1: TImageList;

   StatusBar1: TStatusBar;

   procedure FormShow(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

   procedure tvCallsClick(Sender: TObject);

   procedure btnPrintClick(Sender: TObject);

private

   { Private declarations }

   Doc: OleVariant;

   Cdo: TCdoMapiSession;

public

   { Public declarations }

end;

 

var

FBrowse: TFBrowse;

 

implementation

 

{$R *.DFM}

 

procedure TFBrowse.FormShow(Sender: TObject);

var

TN: TTreeNode;

begin

Screen.Cursor := crHourGlass;

Application.ProcessMessages;

Cdo := TCdoMapiSession.Create;

Cdo.LoadEMailTree(tvCalls, true, '*Support ---*');

tvCalls.SortType := stText;

TN := tvCalls.Items[0];

TN.Expand(false);

tvCalls.SetFocus;

Screen.Cursor := crDefault;

end;

 

procedure TFBrowse.FormClose(Sender: TObject; var Action: TCloseAction);

begin

CdoDisposeNodes(TvCalls.Items);

Cdo.Free;

end;

 

procedure TFBrowse.tvCallsClick(Sender: TObject);

var

TN: TTreeNode;

begin

TN := tvCalls.Selected;

Memo1.Clear;

lbFrom.Caption := '';

lbDate.Caption := '';

 

if TN.Data <> nil then

begin

   Doc := TOleVarPtr(TN.Data)^;

   btnPrint.Enabled := true;

   Memo1.Text := Doc.Text;

   lbFrom.Caption := Doc.Sender.Name;

   lbDate.Caption := FormatDateTime('dd/mm/yyyy hh:nn', Doc.TimeSent);

end;

end;

 

end.

 

Code:

unit CDO_Lib;

 

// =============================================================================

// CDO and MAPI Library (See CDO.HLP)

//

// The object model for the CDO Library is hierarchical. The following table

// shows the containment hierarchy. Each indented object is a child of the

// object under which it is indented. An object is the parent of every object

// at the next level of indentation under it. For example, an Attachments

// collection and a Recipients collection are both child objects of a

// Message object, and a Messages collection is a parent object of a

// Message object. However, a Messages collection is not a parent object of a

// Recipients collection.

//

//  Session

//        AddressLists collection

//              AddressList

//                    Fields collection

//                          Field

//                    AddressEntries collection

//                          AddressEntry

//                                Fields collection

//                                      Field

//                          AddressEntryFilter

//                                Fields collection

//                                      Field

//        Folder (Inbox or Outbox)

//              Fields collection

//                    Field

//              Folders collection

//                    Folder

//                          Fields collection

//                                Field

//                          [ Folders ... Folder ... ]

//                          Messages collection

//                                AppointmentItem

//                                      RecurrencePattern

//                                GroupHeader

//                                MeetingItem

//                                Message

//                                      Attachments collection

//                                            Attachment

//                                                  Fields collection

//                                                        Field

//                                      Fields collection

//                                            Field

//                                      Recipients collection

//                                            Recipient

//                                                  AddressEntry

//                                                        Fields collection

//                                                              Field

//                                MessageFilter

//                                      Fields collection

//                                            Field

//        InfoStores collection

//              InfoStore

//                    Fields collection

//                          Field

//                    Folder [as expanded under Folders]

//

//  The notation "[ Folders ... Folder ... ]" signifies that any Folder object

//  can contain a Folders collection of subfolders, and each subfolder can

//  contain a Folders collection of more subfolders, nested to an

//  arbitrary level.

// =============================================================================

 

interface

 

uses Forms, Windows, SysUtils, Classes, Registry, ComObj, Variants, ComCtrls,

Controls, Masks;

 

const

// MAPI Property Tags

 

// Field Tags

CdoPR_7BIT_DISPLAY_NAME = $39FF001E;

CdoPR_AB_DEFAULT_DIR = $3D060102;

CdoPR_AB_DEFAULT_PAB = $3D070102;

CdoPR_AB_PROVIDER_ID = $36150102;

CdoPR_AB_PROVIDERS = $3D010102;

CdoPR_AB_SEARCH_PATH = $3D051102;

CdoPR_AB_SEARCH_PATH_UPDATE = $3D110102;

CdoPR_ACCESS = $0FF40003;

CdoPR_ACCESS_LEVEL = $0FF70003;

CdoPR_ACCOUNT = $3A00001E;

CdoPR_ACKNOWLEDGEMENT_MODE = $00010003;

CdoPR_ADDRTYPE = $3002001E;

CdoPR_ALTERNATE_RECIPIENT = $3A010102;

CdoPR_ALTERNATE_RECIPIENT_ALLOWED = $0002000B;

CdoPR_ANR = $360C001E;

CdoPR_ASSISTANT = $3A30001E;

CdoPR_ASSISTANT_TELEPHONE_NUMBER = $3A2E001E;

CdoPR_ASSOC_CONTENT_COUNT = $36170003;

CdoPR_ATTACH_ADDITIONAL_INFO = $370F0102;

CdoPR_ATTACH_DATA_BIN = $37010102;

CdoPR_ATTACH_DATA_OBJ = $3701000D;

CdoPR_ATTACH_ENCODING = $37020102;

CdoPR_ATTACH_EXTENSION = $3703001E;

CdoPR_ATTACH_FILENAME = $3704001E;

CdoPR_ATTACH_LONG_FILENAME = $3707001E;

CdoPR_ATTACH_LONG_PATHNAME = $370D001E;

CdoPR_ATTACH_METHOD = $37050003;

CdoPR_ATTACH_MIME_TAG = $370E001E;

CdoPR_ATTACH_NUM = $0E210003;

CdoPR_ATTACH_PATHNAME = $3708001E;

CdoPR_ATTACH_RENDERING = $37090102;

CdoPR_ATTACH_SIZE = $0E200003;

CdoPR_ATTACH_TAG = $370A0102;

CdoPR_ATTACH_TRANSPORT_NAME = $370C001E;

CdoPR_ATTACHMENT_X400_PARAMETERS = $37000102;

CdoPR_AUTHORIZING_USERS = $00030102;

CdoPR_AUTO_FORWARD_COMMENT = $0004001E;

CdoPR_AUTO_FORWARDED = $0005000B;

CdoPR_BEEPER_TELEPHONE_NUMBER = $3A21001E;

CdoPR_BIRTHDAY = $3A420040;

CdoPR_BODY = $1000001E;

CdoPR_BODY_CRC = $0E1C0003;

CdoPR_BUSINESS_ADDRESS_CITY = $3A27001E;

CdoPR_BUSINESS_ADDRESS_COUNTRY = $3A26001E;

CdoPR_BUSINESS_ADDRESS_POST_OFFICE_BOX = $3A2B001E;

CdoPR_BUSINESS_ADDRESS_POSTAL_CODE = $3A2A001E;

CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE = $3A28001E;

CdoPR_BUSINESS_ADDRESS_STREET = $3A29001E;

CdoPR_BUSINESS_FAX_NUMBER = $3A24001E;

CdoPR_BUSINESS_HOME_PAGE = $3A51001E;

CdoPR_BUSINESS_TELEPHONE_NUMBER = $3A08001E;

CdoPR_BUSINESS2_TELEPHONE_NUMBER = $3A1B001E;

CdoPR_CALLBACK_TELEPHONE_NUMBER = $3A02001E;

CdoPR_CAR_TELEPHONE_NUMBER = $3A1E001E;

CdoPR_CELLULAR_TELEPHONE_NUMBER = $3A1C001E;

CdoPR_CHILDRENS_NAMES = $3A58101E;

CdoPR_CLIENT_SUBMIT_TIME = $00390040;

CdoPR_COMMENT = $3004001E;

CdoPR_COMMON_VIEWS_ENTRYID = $35E60102;

CdoPR_COMPANY_MAIN_PHONE_NUMBER = $3A57001E;

CdoPR_COMPANY_NAME = $3A16001E;

CdoPR_COMPUTER_NETWORK_NAME = $3A49001E;

CdoPR_CONTACT_ADDRTYPES = $3A54101E;

CdoPR_CONTACT_DEFAULT_ADDRESS_INDEX = $3A550003;

CdoPR_CONTACT_EMAIL_ADDRESSES = $3A56101E;

CdoPR_CONTACT_ENTRYIDS = $3A531102;

CdoPR_CONTACT_VERSION = $3A520048;

CdoPR_CONTAINER_CLASS = $3613001E;

CdoPR_CONTAINER_CONTENTS = $360F000D;

CdoPR_CONTAINER_FLAGS = $36000003;

CdoPR_CONTAINER_HIERARCHY = $360E000D;

CdoPR_CONTAINER_MODIFY_VERSION = $36140014;

CdoPR_CONTENT_CONFIDENTIALITY_ALGORITHM_ID = $00060102;

CdoPR_CONTENT_CORRELATOR = $00070102;

CdoPR_CONTENT_COUNT = $36020003;

CdoPR_CONTENT_IDENTIFIER = $0008001E;

CdoPR_CONTENT_INTEGRITY_CHECK = $0C000102;

CdoPR_CONTENT_LENGTH = $00090003;

CdoPR_CONTENT_RETURN_REQUESTED = $000A000B;

CdoPR_CONTENT_UNREAD = $36030003;

CdoPR_CONTENTS_SORT_ORDER = $360D1003;

CdoPR_CONTROL_FLAGS = $3F000003;

CdoPR_CONTROL_ID = $3F070102;

CdoPR_CONTROL_STRUCTURE = $3F010102;

CdoPR_CONTROL_TYPE = $3F020003;

CdoPR_CONVERSATION_INDEX = $00710102;

CdoPR_CONVERSATION_KEY = $000B0102;

CdoPR_CONVERSATION_TOPIC = $0070001E;

CdoPR_CONVERSION_EITS = $000C0102;

CdoPR_CONVERSION_PROHIBITED = $3A03000B;

CdoPR_CONVERSION_WITH_LOSS_PROHIBITED = $000D000B;

CdoPR_CONVERTED_EITS = $000E0102;

CdoPR_CORRELATE = $0E0C000B;

CdoPR_CORRELATE_MTSID = $0E0D0102;

CdoPR_COUNTRY = $3A26001E;

CdoPR_CREATE_TEMPLATES = $3604000D;

CdoPR_CREATION_TIME = $30070040;

CdoPR_CREATION_VERSION = $0E190014;

CdoPR_CURRENT_VERSION = $0E000014;

CdoPR_CUSTOMER_ID = $3A4A001E;

CdoPR_DEF_CREATE_DL = $36110102;

CdoPR_DEF_CREATE_MAILUSER = $36120102;

CdoPR_DEFAULT_PROFILE = $3D04000B;

CdoPR_DEFAULT_STORE = $3400000B;

CdoPR_DEFAULT_VIEW_ENTRYID = $36160102;

CdoPR_DEFERRED_DELIVERY_TIME = $000F0040;

CdoPR_DELEGATION = $007E0102;

CdoPR_DELETE_AFTER_SUBMIT = $0E01000B;

CdoPR_DELIVER_TIME = $00100040;

CdoPR_DELIVERY_POINT = $0C070003;

CdoPR_DELTAX = $3F030003;

CdoPR_DELTAY = $3F040003;

CdoPR_DEPARTMENT_NAME = $3A18001E;

CdoPR_DEPTH = $30050003;

CdoPR_DETAILS_TABLE = $3605000D;

CdoPR_DISC_VAL = $004A000B;

CdoPR_DISCARD_REASON = $00110003;

CdoPR_DISCLOSE_RECIPIENTS = $3A04000B;

CdoPR_DISCLOSURE_OF_RECIPIENTS = $0012000B;

CdoPR_DISCRETE_VALUES = $0E0E000B;

CdoPR_DISPLAY_BCC = $0E02001E;

CdoPR_DISPLAY_CC = $0E03001E;

CdoPR_DISPLAY_NAME = $3001001E;

CdoPR_DISPLAY_NAME_PREFIX = $3A45001E;

CdoPR_DISPLAY_TO = $0E04001E;

CdoPR_DISPLAY_TYPE = $39000003;

CdoPR_DL_EXPANSION_HISTORY = $00130102;

CdoPR_DL_EXPANSION_PROHIBITED = $0014000B;

CdoPR_EMAIL_ADDRESS = $3003001E;

CdoPR_EMAIL_AT_ADDRESS = $39FE001E;

CdoPR_END_DATE = $00610040;

CdoPR_ENTRYID = $0FFF0102;

CdoPR_EXPIRY_TIME = $00150040;

CdoPR_EXPLICIT_CONVERSION = $0C010003;

CdoPR_FILTERING_HOOKS = $3D080102;

CdoPR_FINDER_ENTRYID = $35E70102;

CdoPR_FOLDER_ASSOCIATED_CONTENTS = $3610000D;

CdoPR_FOLDER_TYPE = $36010003;

CdoPR_FORM_CATEGORY = $3304001E;

CdoPR_FORM_CATEGORY_SUB = $3305001E;

CdoPR_FORM_CLSID = $33020048;

CdoPR_FORM_CONTACT_NAME = $3303001E;

CdoPR_FORM_DESIGNER_GUID = $33090048;

CdoPR_FORM_DESIGNER_NAME = $3308001E;

CdoPR_FORM_HIDDEN = $3307000B;

CdoPR_FORM_HOST_MAP = $33061003;

CdoPR_FORM_MESSAGE_BEHAVIOR = $330A0003;

CdoPR_FORM_VERSION = $3301001E;

CdoPR_FTP_SITE = $3A4C001E;

CdoPR_GENDER = $3A4D0002;

CdoPR_GENERATION = $3A05001E;

CdoPR_GIVEN_NAME = $3A06001E;

CdoPR_GOVERNMENT_ID_NUMBER = $3A07001E;

CdoPR_HASATTACH = $0E1B000B;

CdoPR_HEADER_FOLDER_ENTRYID = $3E0A0102;

CdoPR_HOBBIES = $3A43001E;

CdoPR_HOME_ADDRESS_CITY = $3A59001E;

CdoPR_HOME_ADDRESS_COUNTRY = $3A5A001E;

CdoPR_HOME_ADDRESS_POST_OFFICE_BOX = $3A5E001E;

CdoPR_HOME_ADDRESS_POSTAL_CODE = $3A5B001E;

CdoPR_HOME_ADDRESS_STATE_OR_PROVINCE = $3A5C001E;

CdoPR_HOME_ADDRESS_STREET = $3A5D001E;

CdoPR_HOME_FAX_NUMBER = $3A25001E;

CdoPR_HOME_TELEPHONE_NUMBER = $3A09001E;

CdoPR_HOME2_TELEPHONE_NUMBER = $3A2F001E;

CdoPR_ICON = $0FFD0102;

CdoPR_IDENTITY_DISPLAY = $3E00001E;

CdoPR_IDENTITY_ENTRYID = $3E010102;

CdoPR_IDENTITY_SEARCH_KEY = $3E050102;

CdoPR_IMPLICIT_CONVERSION_PROHIBITED = $0016000B;

CdoPR_IMPORTANCE = $00170003;

CdoPR_INCOMPLETE_COPY = $0035000B;

CdoPR_INITIAL_DETAILS_PANE = $3F080003;

CdoPR_INITIALS = $3A0A001E;

CdoPR_INSTANCE_KEY = $0FF60102;

CdoPR_INTERNET_APPROVED = $1030001E;

CdoPR_INTERNET_ARTICLE_NUMBER = $0E230003;

CdoPR_INTERNET_CONTROL = $1031001E;

CdoPR_INTERNET_DISTRIBUTION = $1032001E;

CdoPR_INTERNET_FOLLOWUP_TO = $1033001E;

CdoPR_INTERNET_LINES = $10340003;

CdoPR_INTERNET_MESSAGE_ID = $1035001E;

CdoPR_INTERNET_NEWSGROUPS = $1036001E;

CdoPR_INTERNET_NNTP_PATH = $1038001E;

CdoPR_INTERNET_ORGANIZATION = $1037001E;

CdoPR_INTERNET_PRECEDENCE = $1041001E;

CdoPR_INTERNET_REFERENCES = $1039001E;

CdoPR_IPM_ID = $00180102;

CdoPR_IPM_OUTBOX_ENTRYID = $35E20102;

CdoPR_IPM_OUTBOX_SEARCH_KEY = $34110102;

CdoPR_IPM_RETURN_REQUESTED = $0C02000B;

CdoPR_IPM_SENTMAIL_ENTRYID = $35E40102;

CdoPR_IPM_SENTMAIL_SEARCH_KEY = $34130102;

CdoPR_IPM_SUBTREE_ENTRYID = $35E00102;

CdoPR_IPM_SUBTREE_SEARCH_KEY = $34100102;

CdoPR_IPM_WASTEBASKET_ENTRYID = $35E30102;

CdoPR_IPM_WASTEBASKET_SEARCH_KEY = $34120102;

CdoPR_ISDN_NUMBER = $3A2D001E;

CdoPR_KEYWORD = $3A0B001E;

CdoPR_LANGUAGE = $3A0C001E;

CdoPR_LANGUAGES = $002F001E;

CdoPR_LAST_MODIFICATION_TIME = $30080040;

CdoPR_LATEST_DELIVERY_TIME = $00190040;

CdoPR_LOCALITY = $3A27001E;

CdoPR_LOCATION = $3A0D001E;

CdoPR_MAIL_PERMISSION = $3A0E000B;

CdoPR_MANAGER_NAME = $3A4E001E;

CdoPR_MAPPING_SIGNATURE = $0FF80102;

CdoPR_MDB_PROVIDER = $34140102;

CdoPR_MESSAGE_ATTACHMENTS = $0E13000D;

CdoPR_MESSAGE_CC_ME = $0058000B;

CdoPR_MESSAGE_CLASS = $001A001E;

CdoPR_MESSAGE_DELIVERY_ID = $001B0102;

CdoPR_MESSAGE_DELIVERY_TIME = $0E060040;

CdoPR_MESSAGE_DOWNLOAD_TIME = $0E180003;

CdoPR_MESSAGE_FLAGS = $0E070003;

CdoPR_MESSAGE_RECIP_ME = $0059000B;

CdoPR_MESSAGE_RECIPIENTS = $0E12000D;

CdoPR_MESSAGE_SECURITY_LABEL = $001E0102;

CdoPR_MESSAGE_SIZE = $0E080003;

CdoPR_MESSAGE_SUBMISSION_ID = $00470102;

CdoPR_MESSAGE_TO_ME = $0057000B;

CdoPR_MESSAGE_TOKEN = $0C030102;

CdoPR_MHS_COMMON_NAME = $3A0F001E;

CdoPR_MIDDLE_NAME = $3A44001E;

CdoPR_MINI_ICON = $0FFC0102;

CdoPR_MOBILE_TELEPHONE_NUMBER = $3A1C001E;

CdoPR_MODIFY_VERSION = $0E1A0014;

CdoPR_MSG_STATUS = $0E170003;

CdoPR_NDR_DIAG_CODE = $0C050003;

CdoPR_NDR_REASON_CODE = $0C040003;

CdoPR_NEWSGROUP_NAME = $0E24001E;

CdoPR_NICKNAME = $3A4F001E;

CdoPR_NNTP_XREF = $1040001E;

CdoPR_NON_RECEIPT_NOTIFICATION_REQUESTED = $0C06000B;

CdoPR_NON_RECEIPT_REASON = $003E0003;

CdoPR_NORMALIZED_SUBJECT = $0E1D001E;

CdoPR_OBJECT_TYPE = $0FFE0003;

CdoPR_OBSOLETED_IPMS = $001F0102;

CdoPR_OFFICE_LOCATION = $3A19001E;

CdoPR_OFFICE_TELEPHONE_NUMBER = $3A08001E;

CdoPR_OFFICE2_TELEPHONE_NUMBER = $3A1B001E;

CdoPR_ORGANIZATIONAL_ID_NUMBER = $3A10001E;

CdoPR_ORIG_MESSAGE_CLASS = $004B001E;

CdoPR_ORIGIN_CHECK = $00270102;

CdoPR_ORIGINAL_AUTHOR_ADDRTYPE = $0079001E;

CdoPR_ORIGINAL_AUTHOR_EMAIL_ADDRESS = $007A001E;

CdoPR_ORIGINAL_AUTHOR_ENTRYID = $004C0102;

CdoPR_ORIGINAL_AUTHOR_NAME = $004D001E;

CdoPR_ORIGINAL_AUTHOR_SEARCH_KEY = $00560102;

CdoPR_ORIGINAL_DELIVERY_TIME = $00550040;

CdoPR_ORIGINAL_DISPLAY_BCC = $0072001E;

CdoPR_ORIGINAL_DISPLAY_CC = $0073001E;

CdoPR_ORIGINAL_DISPLAY_NAME = $3A13001E;

CdoPR_ORIGINAL_DISPLAY_TO = $0074001E;

CdoPR_ORIGINAL_EITS = $00210102;

CdoPR_ORIGINAL_ENTRYID = $3A120102;

CdoPR_ORIGINAL_SEARCH_KEY = $3A140102;

CdoPR_ORIGINAL_SENDER_ADDRTYPE = $0066001E;

CdoPR_ORIGINAL_SENDER_EMAIL_ADDRESS = $0067001E;

CdoPR_ORIGINAL_SENDER_ENTRYID = $005B0102;

CdoPR_ORIGINAL_SENDER_NAME = $005A001E;

CdoPR_ORIGINAL_SENDER_SEARCH_KEY = $005C0102;

CdoPR_ORIGINAL_SENSITIVITY = $002E0003;

CdoPR_ORIGINAL_SENT_REPRESENTING_ADDRTYPE = $0068001E;

CdoPR_ORIGINAL_SENT_REPRESENTING_EMAIL_ADDR = $0069001E;

CdoPR_ORIGINAL_SENT_REPRESENTING_ENTRYID = $005E0102;

CdoPR_ORIGINAL_SENT_REPRESENTING_NAME = $005D001E;

CdoPR_ORIGINAL_SENT_REPRESENTING_SEARCH_KEY = $005F0102;

CdoPR_ORIGINAL_SUBJECT = $0049001E;

CdoPR_ORIGINAL_SUBMIT_TIME = $004E0040;

CdoPR_ORIGINALLY_INTENDED_RECIP_ADDRTYPE = $007B001E;

CdoPR_ORIGINALLY_INTENDED_RECIP_EMAIL_ADDR = $007C001E;

CdoPR_ORIGINALLY_INTENDED_RECIP_ENTRYID = $10120102;

CdoPR_ORIGINALLY_INTENDED_RECIPIENT_NAME = $00200102;

CdoPR_ORIGINATING_MTA_CERTIFICATE = $0E250102;

CdoPR_ORIGINATOR_AND_DL_EXPANSION_HISTORY = $10020102;

CdoPR_ORIGINATOR_CERTIFICATE = $00220102;

CdoPR_ORIGINATOR_DELIVERY_REPORT_REQUESTED = $0023000B;

CdoPR_ORIGINATOR_NON_DELIVERY_REPORT_REQ = $0C08000B;

CdoPR_ORIGINATOR_REQUESTED_ALTERNATE_RECIP = $0C090102;

CdoPR_ORIGINATOR_RETURN_ADDRESS = $00240102;

CdoPR_OTHER_ADDRESS_CITY = $3A5F001E;

CdoPR_OTHER_ADDRESS_COUNTRY = $3A60001E;

CdoPR_OTHER_ADDRESS_POST_OFFICE_BOX = $3A64001E;

CdoPR_OTHER_ADDRESS_POSTAL_CODE = $3A61001E;

CdoPR_OTHER_ADDRESS_STATE_OR_PROVINCE = $3A62001E;

CdoPR_OTHER_ADDRESS_STREET = $3A63001E;

CdoPR_OTHER_TELEPHONE_NUMBER = $3A1F001E;

CdoPR_OWN_STORE_ENTRYID = $3E060102;

CdoPR_OWNER_APPT_ID = $00620003;

CdoPR_PAGER_TELEPHONE_NUMBER = $3A21001E;

CdoPR_PARENT_DISPLAY = $0E05001E;

CdoPR_PARENT_ENTRYID = $0E090102;

CdoPR_PARENT_KEY = $00250102;

CdoPR_PERSONAL_HOME_PAGE = $3A50001E;

CdoPR_PHYSICAL_DELIVERY_BUREAU_FAX_DELIVERY = $0C0A000B;

CdoPR_PHYSICAL_DELIVERY_MODE = $0C0B0003;

CdoPR_PHYSICAL_DELIVERY_REPORT_REQUEST = $0C0C0003;

CdoPR_PHYSICAL_FORWARDING_ADDRESS = $0C0D0102;

CdoPR_PHYSICAL_FORWARDING_ADDRESS_REQUESTED = $0C0E000B;

CdoPR_PHYSICAL_FORWARDING_PROHIBITED = $0C0F000B;

CdoPR_PHYSICAL_RENDITION_ATTRIBUTES = $0C100102;

CdoPR_POST_FOLDER_ENTRIES = $103B0102;

CdoPR_POST_FOLDER_NAMES = $103C001E;

CdoPR_POST_OFFICE_BOX = $3A2B001E;

CdoPR_POST_REPLY_DENIED = $103F0102;

CdoPR_POST_REPLY_FOLDER_ENTRIES = $103D0102;

CdoPR_POST_REPLY_FOLDER_NAMES = $103E001E;

CdoPR_POSTAL_ADDRESS = $3A15001E;

CdoPR_POSTAL_CODE = $3A2A001E;

CdoPR_PREFERRED_BY_NAME = $3A47001E;

CdoPR_PREPROCESS = $0E22000B;

CdoPR_PRIMARY_CAPABILITY = $39040102;

CdoPR_PRIMARY_FAX_NUMBER = $3A23001E;

CdoPR_PRIMARY_TELEPHONE_NUMBER = $3A1A001E;

CdoPR_PRIORITY = $00260003;

CdoPR_PROFESSION = $3A46001E;

CdoPR_PROFILE_NAME = $3D12001E;

CdoPR_PROOF_OF_DELIVERY = $0C110102;

CdoPR_PROOF_OF_DELIVERY_REQUESTED = $0C12000B;

CdoPR_PROOF_OF_SUBMISSION = $0E260102;

CdoPR_PROOF_OF_SUBMISSION_REQUESTED = $0028000B;

CdoPR_PROVIDER_DISPLAY = $3006001E;

CdoPR_PROVIDER_DLL_NAME = $300A001E;

CdoPR_PROVIDER_ORDINAL = $300D0003;

CdoPR_PROVIDER_SUBMIT_TIME = $00480040;

CdoPR_PROVIDER_UID = $300C0102;

CdoPR_RADIO_TELEPHONE_NUMBER = $3A1D001E;

CdoPR_RCVD_REPRESENTING_ADDRTYPE = $0077001E;

CdoPR_RCVD_REPRESENTING_EMAIL_ADDRESS = $0078001E;

CdoPR_RCVD_REPRESENTING_ENTRYID = $00430102;

CdoPR_RCVD_REPRESENTING_NAME = $0044001E;

CdoPR_RCVD_REPRESENTING_SEARCH_KEY = $00520102;

CdoPR_READ_RECEIPT_ENTRYID = $00460102;

CdoPR_READ_RECEIPT_REQUESTED = $0029000B;

CdoPR_READ_RECEIPT_SEARCH_KEY = $00530102;

CdoPR_RECEIPT_TIME = $002A0040;

CdoPR_RECEIVE_FOLDER_SETTINGS = $3415000D;

CdoPR_RECEIVED_BY_ADDRTYPE = $0075001E;

CdoPR_RECEIVED_BY_EMAIL_ADDRESS = $0076001E;

CdoPR_RECEIVED_BY_ENTRYID = $003F0102;

CdoPR_RECEIVED_BY_NAME = $0040001E;

CdoPR_RECEIVED_BY_SEARCH_KEY = $00510102;

CdoPR_RECIPIENT_CERTIFICATE = $0C130102;

CdoPR_RECIPIENT_NUMBER_FOR_ADVICE = $0C14001E;

CdoPR_RECIPIENT_REASSIGNMENT_PROHIBITED = $002B000B;

CdoPR_RECIPIENT_STATUS = $0E150003;

CdoPR_RECIPIENT_TYPE = $0C150003;

CdoPR_RECORD_KEY = $0FF90102;

CdoPR_REDIRECTION_HISTORY = $002C0102;

CdoPR_REFERRED_BY_NAME = $3A47001E;

CdoPR_REGISTERED_MAIL_TYPE = $0C160003;

CdoPR_RELATED_IPMS = $002D0102;

CdoPR_REMOTE_PROGRESS = $3E0B0003;

CdoPR_REMOTE_PROGRESS_TEXT = $3E0C001E;

CdoPR_REMOTE_VALIDATE_OK = $3E0D000B;

CdoPR_RENDERING_POSITION = $370B0003;

CdoPR_REPLY_RECIPIENT_ENTRIES = $004F0102;

CdoPR_REPLY_RECIPIENT_NAMES = $0050001E;

CdoPR_REPLY_REQUESTED = $0C17000B;

CdoPR_REPLY_TIME = $00300040;

CdoPR_REPORT_ENTRYID = $00450102;

CdoPR_REPORT_NAME = $003A001E;

CdoPR_REPORT_SEARCH_KEY = $00540102;

CdoPR_REPORT_TAG = $00310102;

CdoPR_REPORT_TEXT = $1001001E;

CdoPR_REPORT_TIME = $00320040;

CdoPR_REPORTING_DL_NAME = $10030102;

CdoPR_REPORTING_MTA_CERTIFICATE = $10040102;

CdoPR_REQUESTED_DELIVERY_METHOD = $0C180003;

CdoPR_RESOURCE_FLAGS = $30090003;

CdoPR_RESOURCE_METHODS = $3E020003;

CdoPR_RESOURCE_PATH = $3E07001E;

CdoPR_RESOURCE_TYPE = $3E030003;

CdoPR_RESPONSE_REQUESTED = $0063000B;

CdoPR_RESPONSIBILITY = $0E0F000B;

CdoPR_RETURNED_IPM = $0033000B;

CdoPR_ROW_TYPE = $0FF50003;

CdoPR_ROWID = $30000003;

CdoPR_RTF_COMPRESSED = $10090102;

CdoPR_RTF_IN_SYNC = $0E1F000B;

CdoPR_RTF_SYNC_BODY_COUNT = $10070003;

CdoPR_RTF_SYNC_BODY_CRC = $10060003;

CdoPR_RTF_SYNC_BODY_TAG = $1008001E;

CdoPR_RTF_SYNC_PREFIX_COUNT = $10100003;

CdoPR_RTF_SYNC_TRAILING_COUNT = $10110003;

CdoPR_SEARCH = $3607000D;

CdoPR_SEARCH_KEY = $300B0102;

CdoPR_SECURITY = $00340003;

CdoPR_SELECTABLE = $3609000B;

CdoPR_SEND_INTERNET_ENCODING = $3A710003;

CdoPR_SEND_RICH_INFO = $3A40000B;

CdoPR_SENDER_ADDRTYPE = $0C1E001E;

CdoPR_SENDER_EMAIL_ADDRESS = $0C1F001E;

CdoPR_SENDER_ENTRYID = $0C190102;

CdoPR_SENDER_NAME = $0C1A001E;

CdoPR_SENDER_SEARCH_KEY = $0C1D0102;

CdoPR_SENSITIVITY = $00360003;

CdoPR_SENT_REPRESENTING_ADDRTYPE = $0064001E;

CdoPR_SENT_REPRESENTING_EMAIL_ADDRESS = $0065001E;

CdoPR_SENT_REPRESENTING_ENTRYID = $00410102;

CdoPR_SENT_REPRESENTING_NAME = $0042001E;

CdoPR_SENT_REPRESENTING_SEARCH_KEY = $003B0102;

CdoPR_SENTMAIL_ENTRYID = $0E0A0102;

CdoPR_SERVICE_DELETE_FILES = $3D10101E;

CdoPR_SERVICE_DLL_NAME = $3D0A001E;

CdoPR_SERVICE_ENTRY_NAME = $3D0B001E;

CdoPR_SERVICE_EXTRA_UIDS = $3D0D0102;

CdoPR_SERVICE_NAME = $3D09001E;

CdoPR_SERVICE_SUPPORT_FILES = $3D0F101E;

CdoPR_SERVICE_UID = $3D0C0102;

CdoPR_SERVICES = $3D0E0102;

CdoPR_SPOOLER_STATUS = $0E100003;

CdoPR_SPOUSE_NAME = $3A48001E;

CdoPR_START_DATE = $00600040;

CdoPR_STATE_OR_PROVINCE = $3A28001E;

CdoPR_STATUS = $360B0003;

CdoPR_STATUS_CODE = $3E040003;

CdoPR_STATUS_STRING = $3E08001E;

CdoPR_STORE_ENTRYID = $0FFB0102;

CdoPR_STORE_PROVIDERS = $3D000102;

CdoPR_STORE_RECORD_KEY = $0FFA0102;

CdoPR_STORE_STATE = $340E0003;

CdoPR_STORE_SUPPORT_MASK = $340D0003;

CdoPR_STREET_ADDRESS = $3A29001E;

CdoPR_SUBFOLDERS = $360A000B;

CdoPR_SUBJECT = $0037001E;

CdoPR_SUBJECT_IPM = $00380102;

CdoPR_SUBJECT_PREFIX = $003D001E;

CdoPR_SUBMIT_FLAGS = $0E140003;

CdoPR_SUPERSEDES = $103A001E;

CdoPR_SUPPLEMENTARY_INFO = $0C1B001E;

CdoPR_SURNAME = $3A11001E;

CdoPR_TELEX_NUMBER = $3A2C001E;

CdoPR_TEMPLATEID = $39020102;

CdoPR_TITLE = $3A17001E;

CdoPR_TNEF_CORRELATION_KEY = $007F0102;

CdoPR_TRANSMITABLE_DISPLAY_NAME = $3A20001E;

CdoPR_TRANSPORT_KEY = $0E160003;

CdoPR_TRANSPORT_MESSAGE_HEADERS = $007D001E;

CdoPR_TRANSPORT_PROVIDERS = $3D020102;

CdoPR_TRANSPORT_STATUS = $0E110003;

CdoPR_TTYTDD_PHONE_NUMBER = $3A4B001E;

CdoPR_TYPE_OF_MTS_USER = $0C1C0003;

CdoPR_USER_CERTIFICATE = $3A220102;

CdoPR_USER_X509_CERTIFICATE = $3A701102;

CdoPR_VALID_FOLDER_MASK = $35DF0003;

CdoPR_VIEWS_ENTRYID = $35E50102;

CdoPR_WEDDING_ANNIVERSARY = $3A410040;

CdoPR_X400_CONTENT_TYPE = $003C0102;

CdoPR_X400_DEFERRED_DELIVERY_CANCEL = $3E09000B;

CdoPR_XPOS = $3F050003;

CdoPR_YPOS = $3F060003;

 

// General

PR_IPM_PUBLIC_FOLDERS_ENTRYID = $66310102;

CdoDefaultFolderCalendar = 0;

CdoDefaultFolderContacts = 5;

CdoDefaultFolderDeletedItems = 4;

CdoDefaultFolderInbox = 1;

CdoDefaultFolderJournal = 6;

CdoDefaultFolderNotes = 7;

CdoDefaultFolderOutbox = 2;

CdoDefaultFolderSentItems = 3;

CdoDefaultFolderTasks = 8;

 

// Message Recipients

CdoTo = 1;

CdoCc = 2;

CdoBcc = 3;

 

// Attachment Types

CdoFileData = 1;

CdoFileLink = 2;

CdoOLE = 3;

CdoEmbeddedMessage = 4;

 

// AddressEntry DisplayType

CdoUser = 0; //        A local messaging user.

CdoDistList = 1; //        A public distribution list.

CdoForum = 2; //        A forum, such as a bulletin board or a public folder.

CdoAgent = 3; //        An automated agent, such as Quote-of-the-Day.

CdoOrganization = 4;

//        A special address entry defined for large groups, such as a helpdesk.

CdoPrivateDistList = 5; //        A private, personally administered distribution list.

CdoRemoteUser = 6; //        A messaging user in a remote messaging system.

 

// Error Codes

CdoE_OK = 0;

CdoE_ACCOUNT_DISABLED = $80040124;

CdoE_AMBIGUOUS_RECIP = $80040700;

CdoE_BAD_CHARWIDTH = $80040103;

CdoE_BAD_COLUMN = $80040118;

CdoE_BAD_VALUE = $80040301;

CdoE_BUSY = $8004010B;

CdoE_CALL_FAILED = $80004005;

CdoE_CANCEL = $80040501;

CdoE_COLLISION = $80040604;

CdoE_COMPUTED = $8004011A;

CdoE_CORRUPT_DATA = $8004011B;

CdoE_CORRUPT_STORE = $80040600;

CdoE_DECLINE_COPY = $80040306;

CdoE_DISK_ERROR = $80040116;

CdoE_END_OF_SESSION = $80040200;

CdoE_EXTENDED_ERROR = $80040119;

CdoE_FAILONEPROVIDER = $8004011D;

CdoE_FOLDER_CYCLE = $8004060B;

CdoE_HAS_FOLDERS = $80040609;

CdoE_HAS_MESSAGES = $8004060A;

CdoE_INTERFACE_NOT_SUPPORTED = $80004002;

CdoE_INVALID_ACCESS_TIME = $80040123;

CdoE_INVALID_BOOKMARK = $80040405;

CdoE_INVALID_ENTRYID = $80040107;

CdoE_INVALID_OBJECT = $80040108;

CdoE_INVALID_PARAMETER = $80070057;

CdoE_INVALID_TYPE = $80040302;

CdoE_INVALID_WORKSTATION_ACCOUNT = $80040122;

CdoE_LOGON_FAILED = $80040111;

CdoE_MISSING_REQUIRED_COLUMN = $80040202;

CdoE_NETWORK_ERROR = $80040115;

CdoE_NO_ACCESS = $80070005;

CdoE_NO_RECIPIENTS = $80040607;

CdoE_NO_SUPPORT = $80040102;

CdoE_NO_SUPPRESS = $80040602;

CdoE_NON_STANDARD = $80040606;

CdoE_NOT_ENOUGH_DISK = $8004010D;

CdoE_NOT_ENOUGH_MEMORY = $8007000E;

CdoE_NOT_ENOUGH_RESOURCES = $8004010E;

CdoE_NOT_FOUND = $8004010F;

CdoE_NOT_IN_QUEUE = $80040601;

CdoE_NOT_INITIALIZED = $80040605;

CdoE_NOT_ME = $80040502;

CdoE_OBJECT_CHANGED = $80040109;

CdoE_OBJECT_DELETED = $8004010A;

CdoE_PASSWORD_CHANGE_REQUIRED = $80040120;

CdoE_PASSWORD_EXPIRED = $80040121;

CdoE_SESSION_LIMIT = $80040112;

CdoE_STRING_TOO_LONG = $80040105;

CdoE_SUBMITTED = $80040608;

CdoE_TABLE_EMPTY = $80040402;

CdoE_TABLE_TOO_BIG = $80040403;

CdoE_TIMEOUT = $80040401;

CdoE_TOO_BIG = $80040305;

CdoE_TOO_COMPLEX = $80040117;

CdoE_TYPE_NO_SUPPORT = $80040303;

CdoE_UNABLE_TO_ABORT = $80040114;

CdoE_UNABLE_TO_COMPLETE = $80040400;

CdoE_UNCONFIGURED = $8004011C;

CdoE_UNEXPECTED_ID = $80040307;

CdoE_UNEXPECTED_TYPE = $80040304;

CdoE_UNKNOWN_CPID = $8004011E;

CdoE_UNKNOWN_ENTRYID = $80040201;

CdoE_UNKNOWN_FLAGS = $80040106;

CdoE_UNKNOWN_LCID = $8004011F;

CdoE_USER_CANCEL = $80040113;

CdoE_VERSION = $80040110;

CdoE_WAIT = $80040500;

CdoW_APPROX_COUNT = $00040482;

CdoW_CANCEL_MESSAGE = $00040580;

CdoW_ERRORS_RETURNED = $00040380;

CdoW_NO_SERVICE = $00040203;

CdoW_PARTIAL_COMPLETION = $00040680;

CdoW_POSITION_CHANGED = $00040481;

 

type

TOleVarPtr = ^OleVariant;

 

TCdoMapiSession = class(TObject)

private

   FImpersonated: boolean;

   FLastErrorCode: DWORD;

   FMyName,

     FMyEMailAddress,

     FLastError: string;

   FCurrentUser,

     FOleGlobalAddressList,

     FOleDeletedItems,

     FOleOutBox, FOleSentItems,

     FOleInbox, FOleContacts,

     FOleSession: OleVariant;

   FConnected: boolean;

   function GetFVersion: string;

protected

   procedure SetOleFolders;

public

   // System

   constructor Create; overload;

   constructor Create(const Profile: string); overload;

   constructor Create(const Profile: string;

     const UserName: string;

     const Domain: string;

     const Password: string); overload;

   destructor Destroy; override;

 

   // User

   function LoadAddressList(StringList: TStrings): boolean;

   function LoadObjectList(const FolderOle: OleVariant; List: TList): boolean;

   function LoadEMailTree(TV: TTreeView; Expand1stLevel: boolean = false;

     SubjectMask: string = ''): boolean;

   function LoadContactList(const FolderOle: OleVariant;

     Items: TStrings): boolean; overload;

   function LoadContactList(const FolderName: string;

     Items: TStrings): boolean; overload;

   procedure ShowContactDetails(Contact: OleVariant);

 

   function First(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;

   function Last(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;

   function Next(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;

   function Prior(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;

   function AsString(const ItemOle: Olevariant; const FieldIdConstant: DWORD):

     string;

 

   // Properties

   property CurrentUser: OleVariant read FCurrentUser;

   property Connected: boolean read FConnected;

   property LastErrorMess: string read FlastError;

   property LastErrorCode: DWORD read FlastErrorCode;

   property InBox: OleVariant read FOleInBox;

   property OutBox: OleVariant read FOleOutBox;

   property DeletedItems: Olevariant read FOleDeletedItems;

   property SentItems: Olevariant read FOleSentItems;

   property GlobalAddressList: Olevariant read FOleGlobalAddressList;

   property Contacts: Olevariant read FOleContacts;

   property Session: OleVariant read FOleSession;

   property Version: string read GetFVersion;

   property MyName: string read FMyName;

   property MyEMailAddress: string read FMyEMailAddress;

end;

 

// Function Prototypes

function CdoNothing(Obj: OleVariant): boolean;

function CdoDefaultProfile: string;

procedure CdoDisposeList(WorkList: TList);

procedure CdoDisposeObjects(WorkStrings: TStrings);

procedure CdoDisposeNodes(WorkData: TTreeNodes);

 

function VarNothing: IDispatch;

 

// -----------------------------------------------------------------------------

implementation

 

// ===================================

// Emulate VB function IS NOTHING

// ===================================

 

function CdoNothing(Obj: OleVariant): boolean;

begin

Result := IDispatch(Obj) = nil;

end;

 

// ============================================

// Emulate VB function VarX := Nothing

// ============================================

 

function VarNothing: IDispatch;

var

Retvar: IDispatch;

begin

Retvar := nil;

Result := Retvar;

end;

 

// ============================================

// Get Default Message profile from registry

// ============================================

 

function CdoDefaultProfile: string;

var

WinReg: TRegistry;

Retvar: string;

begin

Retvar := '';

WinReg := TRegistry.Create;

 

if

   WinReg.OpenKey('\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles', false) then

begin

   Retvar := WinReg.ReadString('DefaultProfile');

   WinReg.CloseKey;

end;

 

WinReg.Free;

Result := Retvar;

end;

 

// =================================================

// Disposes of any memory allocations in a TList

// =================================================

 

procedure CdoDisposeList(WorkList: TList);

var

i: integer;

begin

if WorkList <> nil then

   for i := 0 to WorkList.Count - 1 do

     if WorkList[i] <> nil then

       dispose(WorkList[i]);

end;

 

// ====================================================

// Disposes of any memory allocations in a TStringList

// ====================================================

 

procedure CdoDisposeObjects(WorkStrings: TStrings);

var

i: integer;

begin

if WorkStrings <> nil then

   for i := 0 to WorkStrings.Count - 1 do

     if WorkStrings.Objects[i] <> nil then

       dispose(TOleVarPtr(WorkStrings.Objects[i]));

end;

 

// ====================================================

// Disposes of any memory allocations in a TTreeView

// ====================================================

 

procedure CdoDisposeNodes(WorkData: TTreeNodes);

var

i: integer;

TN: TTreeNode;

begin

if WorkData <> nil then

begin

   for i := 0 to WorkData.Count - 1 do

   begin

     TN := WorkData[i];

     if TN.Data <> nil then

       dispose(TOleVarPtr(TN.Data));

   end;

end;

end;

 

// -----------------------------------------------------------------------------

// TCdoMapiSession

// -----------------------------------------------------------------------------

 

// ================

// Default Profile

// ================

 

constructor TCdoMapiSession.Create;

begin

FImpersonated := false;

FLastError := '';

FLastErrorCode := CdoE_OK;

try

   FOleSession := CreateOleObject('MAPI.Session');

   FOleSession.Logon(CdoDefaultProfile);

   SetOleFolders;

except

   on E: Exception do

   begin

     FLastError := E.Message;

     FLastErrorCode := CdoE_LOGON_FAILED;

     FConnected := false;

   end;

end;

end;

 

// ===========================

// With Specified Profile

// ===========================

 

constructor TCdoMapiSession.Create(const Profile: string);

begin

FImpersonated := false;

try

   FOleSession := CreateOleObject('MAPI.Session');

   FOleSession.Logon(Profile);

   SetOleFolders;

except

   on E: Exception do

   begin

     FLastError := E.Message;

     FLastErrorCode := CdoE_LOGON_FAILED;

     FConnected := false;

   end;

end;

end;

 

// ======================================================

// Impersonate amother user and use specified profile

// ======================================================

 

constructor TCdoMapiSession.Create(const Profile: string;

const UserName: string;

const Domain: string;

const Password: string);

var

SecurityH: THandle;

begin

FImpersonated := false;

try

   LogonUser(PChar(UserName), PChar(Domain), PChar(Password),

     LOGON32_LOGON_SERVICE,

     LOGON32_PROVIDER_DEFAULT, SecurityH);

   FImpersonated := ImpersonateLoggedOnUser(SecurityH);

   FOleSession := CreateOleObject('MAPI.Session');

   FOleSession.Logon(Profile, Password, false, true);

   SetOleFolders;

except

   on E: Exception do

   begin

     FLastError := E.Message;

     FLastErrorCode := CdoE_LOGON_FAILED;

     FConnected := false;

   end;

end;

end;

 

// ======================

// Free and Clean up

// ======================

 

destructor TCdoMapiSession.Destroy;

begin

if FConnected then

   FOleSession.LogOff;

FCurrentUser := Unassigned;

FOleGlobalAddressList := Unassigned;

FOleSentItems := Unassigned;

FOleContacts := Unassigned;

FOleOutBox := Unassigned;

FOleDeletedItems := Unassigned;

FOleInBox := Unassigned;

FOleSession := Unassigned;

if FImpersonated then

   RevertToSelf;

inherited Destroy;

end;

 

// =======================================================

// Addition initialization called by Create() oveloads

// =======================================================

 

procedure TCdoMapiSession.SetOleFolders;

begin

try

   FOleGlobalAddressList :=

     FOleSession.AddressLists['Global Address List'].AddressEntries;

except

   FOleGlobalAddressList := VarNothing;

end;

 

try

   FOleContacts := FOleSession.AddressLists['Contacts'].AddressEntries;

except

   FOleContacts := VarNothing;

end;

 

try

   FOleInBox := FOleSession.InBox.Messages;

except

   FOleInBox := VarNothing;

end;

 

try

   FOleOutBox := FOleSession.OutBox.Messages;

except

   FOleOutBox := VarNothing;

end;

 

try

   FOleDeletedItems :=

     FOleSession.GetDefaultFolder(CdoDefaultFolderDeletedItems).Messages;

except

   FOleDeletedItems := VarNothing;

end;

 

try

   FOleSentItems := FOleSession.GetDefaultFolder(CdoDefaultFolderSentItems).Messages;

except

   FOleSentItems := VarNothing;

end;

 

try

   FCurrentUser := FOleSession.CurrentUser;

   FMyName := FCurrentUser.Name;

except

   FCurrentUser := VarNothing;

end;

 

FConnected := true;

FMyEMailAddress := AsString(FCurrentUser, CdoPR_EMAIL_AT_ADDRESS);

end;

 

// ======================

// Return CDO Version

// ======================

 

function TCdoMapiSession.GetFVersion: string;

begin

if FConnected then

   Result := FOleSession.Version

else

   Result := 'Not Connected';

end;

 

// ========================================================

// Fill a string list with all available address lists

// ========================================================

 

function TCdoMapiSession.LoadAddressList(StringList: TStrings): boolean;

var

Addr: OleVariant;

i: integer;

Retvar: boolean;

begin

Retvar := false;

 

if FConnected then

begin

   StringList.Clear;

   try

     Addr := FOleSession.AddressLists;

     for i := 1 to Addr.Count do

       StringList.Add(Addr.Item[i].Name);

     Retvar := true;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_NOT_FOUND;

     end;

   end;

 

   Addr := Unassigned;

end;

 

Result := Retvar;

end;

 

// =================================================

// Iteration functions

// =================================================

 

function TCdoMapiSession.First(const FolderOle: OleVariant;

out ItemOle: OleVariant): boolean;

var

Retvar: boolean;

begin

Retvar := true;

 

if FConnected then

begin

   try

     ItemOle := FolderOle.GetFirst;

     if CdoNothing(ItemOle) then

     begin

       Retvar := false;

     end;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_NOT_FOUND;

       Retvar := false;

     end;

   end;

end

else

   Retvar := false;

 

Result := Retvar;

end;

 

function TCdoMapiSession.Last(const FolderOle: OleVariant;

out ItemOle: OleVariant): boolean;

var

Retvar: boolean;

begin

Retvar := true;

 

if FConnected then

begin

   try

     ItemOle := FolderOle.GetLast;

     if CdoNothing(ItemOle) then

     begin

       Retvar := false;

     end;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_NOT_FOUND;

       Retvar := false;

     end;

   end;

end

else

   Retvar := false;

 

Result := Retvar;

end;

 

function TCdoMapiSession.Next(const FolderOle: OleVariant;

out ItemOle: OleVariant): boolean;

var

Retvar: boolean;

begin

Retvar := true;

 

if FConnected then

begin

   try

     ItemOle := FolderOle.GetNext;

     if CdoNothing(ItemOle) then

     begin

       Retvar := false;

     end;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_NOT_FOUND;

       Retvar := false;

     end;

   end;

end

else

   Retvar := false;

 

Result := Retvar;

end;

 

function TCdoMapiSession.Prior(const FolderOle: OleVariant;

out ItemOle: OleVariant): boolean;

var

Retvar: boolean;

begin

Retvar := true;

 

if FConnected then

begin

   try

     ItemOle := FolderOle.GetPrior;

     if CdoNothing(ItemOle) then

     begin

       Retvar := false;

     end;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_NOT_FOUND;

       Retvar := false;

     end;

   end;

end

else

   Retvar := false;

 

Result := Retvar;

end;

 

// =========================

// Field Get Routines

// =========================

 

function TCdoMapiSession.AsString(const ItemOle: Olevariant;

const FieldIdConstant: DWORD): string;

var

Retvar: string;

begin

if FConnected then

begin

   // Special case for EMail Address - Resolve to normal form

   if FieldIdConstant = CdoPR_EMAIL_AT_ADDRESS then

   begin

     try

       RetVar := ItemOle.Fields[CdoPR_EMAIL_AT_ADDRESS];

     except

       try

         Retvar := ItemOle.Fields[CdoPR_EMAIL_ADDRESS];

       except

         on E: Exception do

         begin

           FLastError := E.Message;

           FLastErrorCode := CdoE_INVALID_OBJECT;

           Retvar := '';

         end;

       end;

     end;

   end

   else

   begin

     try

       RetVar := ItemOle.Fields[FieldIdConstant];

     except

       on E: Exception do

       begin

         FLastError := E.Message;

         FLastErrorCode := CdoE_INVALID_OBJECT;

         Retvar := '';

       end;

     end;

   end;

end

else

   Retvar := '';

 

Result := Retvar;

end;

 

// ================================================

// Load EMail folders Messages into a TTreeView

// Allocations in Nodes are freed at each call to

// LoadEMailTree, but you are responsible to call

// CdoDisposeNodes or dispose of the allocations

// yourself at Application end

// ================================================

 

function TCdoMapiSession.LoadEMailTree(TV: TTreeView;

Expand1stLevel: boolean = false;

SubjectMask: string = ''): boolean;

var

DocPtr: TOleVarPtr;

Item: OleVariant;

TN, RN, XN: TTreeNode;

Retvar,

   Images: boolean;

 

procedure AddTree(const Name: string; Folder: Olevariant);

begin

   if First(Folder, Item) then

   begin

     TN := TV.Items.AddChildObject(RN, Name, nil);

     if Images then

     begin

       TN.ImageIndex := 0;

       TN.SelectedIndex := 0;

     end;

 

     while true do

     begin

       if (SubjectMask = '') or (MatchesMask(Item.Subject, SubjectMask)) then

       begin

         New(DocPtr);

         DocPtr^ := Item;

         if Item.Subject = '' then

           XN := TV.Items.AddChildObject(TN, '<No Subject> - ' + Item.Sender.Name,

             DocPtr)

         else

           XN := TV.Items.AddChildObject(TN, Item.Subject, DocPtr);

 

         if Images then

         begin

           XN.ImageIndex := 1;

           XN.SelectedIndex := 1;

         end;

       end;

 

       if not Next(Folder, Item) then

         break;

     end;

   end;

end;

 

begin

Retvar := false;

 

if FConnected then

begin

   Screen.Cursor := crHourGlass;

   Application.ProcessMessages;

   CdoDisposeNodes(TV.Items);

   TV.Items.Clear;

   TV.Items.BeginUpdate;

   TN := nil;

   RN := nil;

   RN := TV.Items.AddObject(RN, 'Personal Folders', nil);

   Images := (TV.Images <> nil) and (TV.Images.Count >= 2);

   if Images then

   begin

     RN.ImageIndex := 0;

     RN.SelectedIndex := 0;

   end;

 

   try

     AddTree('Inbox', InBox);

     AddTree('Outbox', OutBox);

     AddTree('Sent Items', SentItems);

     AddTree('Deleted Items', DeletedItems);

     Retvar := true;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_CALL_FAILED;

     end;

   end;

 

   if Expand1stLevel then

     TV.Items[0].Expand(false);

   TV.Items.EndUpdate;

   Screen.Cursor := crDefault;

   Item := Unassigned;

   Screen.Cursor := crDefault;

end;

 

Result := Retvar;

end;

 

// =============================================================

// Load Contact list into a TStringList

// Allocations in Objects are freed at each call to

// LoadEMailTree, but you are responsible to call

// CdoDisposeObjects or dispose of the allocations yourself at

// Application end.

//

// Format "[LastName FirstName]EMailAddress"

// ===============================================================

 

function TCdoMapiSession.LoadContactList(const FolderOle: OleVariant;

Items: TStrings): boolean;

var

ContactPtr: TOleVarPtr;

Contact: OleVariant;

AddrType,

   FullName,

   LastName, FirstName, Email: string;

Retvar: boolean;

begin

Retvar := false;

 

if FConnected then

begin

   Screen.Cursor := crHourGlass;

   Application.ProcessMessages;

   CdoDisposeObjects(Items);

   Items.Clear;

   Items.BeginUpdate;

 

   try

     if First(FolderOle, Contact) then

     begin

       while true do

       begin

         LastName := trim(AsString(Contact, CdoPR_SURNAME));

         FirstName := trim(AsString(Contact, CdoPR_GIVEN_NAME));

         EMail := AsString(Contact, CdoPR_EMAIL_AT_ADDRESS);

         AddrType := AsString(Contact, CdoPR_ADDRTYPE);

 

         if (EMail <> '') and (AddrType <> 'FAX') then

         begin

           New(ContactPtr);

           ContactPtr^ := Contact;

           FullName := trim(LastName + ' ' + FirstName);

           Items.AddObject('[' + FullName + ']' + EMail, TObject(ContactPtr));

         end;

 

         if not Next(FolderOle, Contact) then

           break;

       end;

 

       Retvar := true;

     end;

   except

     on E: Exception do

     begin

       FLastError := E.Message;

       FLastErrorCode := CdoE_CALL_FAILED;

     end;

   end;

 

   Items.EndUpdate;

   Contact := Unassigned;

   Screen.Cursor := crDefault;

end;

 

Result := Retvar;

end;

 

function TCdoMapiSession.LoadContactList(const FolderName: string;

Items: TStrings): boolean;

var

Contacts: OleVariant;

Retvar: boolean;

begin

Retvar := false;

 

if FConnected then

begin

   try

     Contacts := FOleSession.AddressLists[FolderName].AddressEntries;

     if not CdoNothing(Contacts) then

     begin

       Retvar := LoadContactList(Contacts, Items);

     end;

     Contacts := Unassigned;

   except

     on E: Exception do

     begin

       CdoDisposeObjects(Items);

       Items.Clear;

       FLastError := E.Message;

       FLastErrorCode := CdoE_CALL_FAILED;

     end;

   end;

end;

 

Result := Retvar;

end;

 

// =============================================================

// Load Folder list into a TList

// Allocations in Objects are freed at each call to

// LoadObjectList, but you are responsible to call

// CdoDisposeList or dispose of the allocations yourself at

// Application end.

// ===============================================================

 

function TCdoMapiSession.LoadObjectList(const FolderOle: OleVariant;

List: TList): boolean;

var

ItemPtr: TOleVarPtr;

Item: OleVariant;

Retvar: boolean;

begin

Retvar := false;

 

if FConnected then

begin

   Screen.Cursor := crHourGlass;

   Application.ProcessMessages;

   CdoDisposeList(List);

   List.Clear;

 

   try

     if First(FolderOle, Item) then

     begin

       while true do

       begin

         New(ItemPtr);

         ItemPtr^ := Item;

         List.Add(ItemPtr);

 

         if not Next(FolderOle, Item) then

           break;

       end;

     end;

   except

     on E: Exception do

     begin

       CdoDisposeList(List);

       List.Clear;

       FLastError := E.Message;

       FLastErrorCode := CdoE_CALL_FAILED;

     end;

   end;

 

   Item := Unassigned;

   Screen.Cursor := crDefault;

end;

 

Result := Retvar;

end;

 

// =================================================================

// The CDO method Details() gives an error if cancel is pressed

// =================================================================

 

procedure TCdoMapiSession.ShowContactDetails(Contact: OleVariant);

begin

if not CdoNothing(Contact) then

try

   Contact.Details(Application.Handle);

except

   // Not interested - either a dialog appears or not

end;

end;

 

end.

 

 

©Drkb::04483

Âçÿòî ñ Delphi Knowledge Base: http://www.baltsoft.com/