Author: Mike Heydon
MS Exchange API via CDO (Collaboration Data Objects)
Answer:
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
1 function CdoNothing(Obj : OleVariant) : boolean;
2 function CdoDefaultProfile : string;
3 function VarNothing : IDispatch;
4
5 procedure CdoDisposeList(WorkList : TList);
6 procedure CdoDisposeObjects(WorkStrings : TStrings);
7 procedure CdoDisposeNodes(WorkData : TTreeNodes);
8
9 //Create constructors that allow Default profile logon,Specific profile logon and
10 an Impersonated user logon with profile. (This is required for successful logon in
11 Windows Service Applications)
12
13 constructor Create; overload;
14 constructor Create(const Profile : string); overload;
15 constructor Create(const Profile : string;
16 const UserName : string;
17 const Domain : string;
18 const Password : string); overload;
19
20 Methods for loading stringlists, treeviews etc. and object iteration.
21
22 function LoadAddressList(StringList : TStrings) : boolean;
23 function LoadObjectList(const FolderOle : OleVariant;
24 List : TList) : boolean;
25 function LoadEMailTree(TV : TTreeView;
26 Expand1stLevel : boolean = false;
27 SubjectMask : string = '') : boolean;
28 function LoadContactList(const FolderOle : OleVariant;
29 Items : TStrings) : boolean; overload;
30 function LoadContactList(const FolderName : string;
31 Items : TStrings) : boolean; overload;
32 procedure ShowContactDetails(Contact : OleVariant);
33
34 //The above load various lists into stringlists,lists or treeviews. Freeing of
35 lists,object constructs within these data structures are freed at each successive
36 call to the load, however the final Deallocation is the responsibility of the
37 developer, You can do this yourself or use the utility functions CdoDisposeXXX().
38 See code documentation for further understanding.
39
40 function First(const FolderOle : OleVariant;
41 out ItemOle : OleVariant) : boolean;
42 function Last(const FolderOle : OleVariant;
43 out ItemOle : OleVariant) : boolean;
44 function Next(const FolderOle : OleVariant;
45 out ItemOle : OleVariant) : boolean;
46 function Prior(const FolderOle : OleVariant;
47 out ItemOle : OleVariant) : boolean;
48 function AsString(const ItemOle : Olevariant;
49 const FieldIdConstant : DWORD) : string;
50
51 //The above provide iterations thru object such as Inbox,Contacts etc. The AsString
52 returns a fields value from the object such as Email Address,Name,Company Name etc.
53 (There are miriads of these defined in the const section “Field Tags”).
54
55 //Properties
56
57 property CurrentUser : OleVariant read FCurrentUser;
58 property Connected : boolean read FConnected;
59 property LastErrorMess : string read FlastError;
60 property LastErrorCode : DWORD read FlastErrorCode;
61 property InBox : OleVariant read FOleInBox;
62 property OutBox : OleVariant read FOleOutBox;
63 property DeletedItems : Olevariant read FOleDeletedItems;
64 property SentItems : Olevariant read FOleSentItems;
65 property GlobalAddressList : Olevariant read FOleGlobalAddressList;
66 property Contacts : Olevariant read FOleContacts;
67 property Session : OleVariant read FOleSession;
68 property Version : string read GetFVersion;
69 property MyName : string read FMyName;
70 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.
71 uses Cdo_Lib;
72 var
73 Cdo: TcdoSession;
74 MailItem: OleVariant;
75
76 // Iterate thru Emails in InBox
77 begin
78 Cdo := TCdoSession.Create;
79
80 if Cdo.Active then
81 begin
82 Cdo.First(Cdo.InBox, MailItem);
83
84 while true do
85 begin
86 if not Cdo.Nothing(MailItem) then
87 begin
88 Subject := MailItem.Subject;
89
90 EMailAddress := Cdo.AsString(MailItem.Sender, CdoPR_EMAIL_AT_ADDRESS);
91 EMailName := MailItem.Sender.Name;
92 BodyText := MailItem.Text;
93
94 // Do something with data and delete the EMail
95 MailItem.Delete;
96 // Get the next Email
97 end;
98
99 MailItem := Cdo.Next(Cdo.Inbox.MailItem);
100 end;
101 end;
102 Cdo.Free;
103 end;
104
105 // Example of loading emails into a treeview and displaying on treeview click
106
107 unit UBrowse;
108 interface
109
110 uses
111 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
112 ComCtrls, ToolWin, Menus, ExtCtrls, StdCtrls, Buttons, ImgList,
113 CDO_Lib;
114
115 type
116 TFBrowse = class(TForm)
117 Panel1: TPanel;
118 Panel3: TPanel;
119 Label1: TLabel;
120 Label2: TLabel;
121 lbFrom: TLabel;
122 lbDate: TLabel;
123 Memo1: TMemo;
124 Panel2: TPanel;
125 OKBtn: TBitBtn;
126 tvCalls: TTreeView;
127 ImageList1: TImageList;
128 StatusBar1: TStatusBar;
129 procedure FormShow(Sender: TObject);
130 procedure FormClose(Sender: TObject; var Action: TCloseAction);
131 procedure tvCallsClick(Sender: TObject);
132 procedure btnPrintClick(Sender: TObject);
133 private
134 { Private declarations }
135 Doc: OleVariant;
136 Cdo: TCdoMapiSession;
137 public
138 { Public declarations }
139 end;
140
141 var
142 FBrowse: TFBrowse;
143
144 implementation
145
146 {$R *.DFM}
147
148 procedure TFBrowse.FormShow(Sender: TObject);
149 var
150 TN: TTreeNode;
151 begin
152 Screen.Cursor := crHourGlass;
153 Application.ProcessMessages;
154 Cdo := TCdoMapiSession.Create;
155 Cdo.LoadEMailTree(tvCalls, true, '*Support ---*');
156 tvCalls.SortType := stText;
157 TN := tvCalls.Items[0];
158 TN.Expand(false);
159 tvCalls.SetFocus;
160 Screen.Cursor := crDefault;
161 end;
162
163 procedure TFBrowse.FormClose(Sender: TObject; var Action: TCloseAction);
164 begin
165 CdoDisposeNodes(TvCalls.Items);
166 Cdo.Free;
167 end;
168
169 procedure TFBrowse.tvCallsClick(Sender: TObject);
170 var
171 TN: TTreeNode;
172 begin
173 TN := tvCalls.Selected;
174 Memo1.Clear;
175 lbFrom.Caption := '';
176 lbDate.Caption := '';
177
178 if TN.Data <> nil then
179 begin
180 Doc := TOleVarPtr(TN.Data)^;
181 btnPrint.Enabled := true;
182 Memo1.Text := Doc.Text;
183 lbFrom.Caption := Doc.Sender.Name;
184 lbDate.Caption := FormatDateTime('dd/mm/yyyy hh:nn', Doc.TimeSent);
185 end;
186 end;
187
188 end.
189
190 unit CDO_Lib;
191
192 // =============================================================================
193 // CDO and MAPI Library (See CDO.HLP)
194 //
195 // The object model for the CDO Library is hierarchical. The following table
196 // shows the containment hierarchy. Each indented object is a child of the
197 // object under which it is indented. An object is the parent of every object
198 // at the next level of indentation under it. For example, an Attachments
199 // collection and a Recipients collection are both child objects of a
200 // Message object, and a Messages collection is a parent object of a
201 // Message object. However, a Messages collection is not a parent object of a
202 // Recipients collection.
203 //
204 // Session
205 // AddressLists collection
206 // AddressList
207 // Fields collection
208 // Field
209 // AddressEntries collection
210 // AddressEntry
211 // Fields collection
212 // Field
213 // AddressEntryFilter
214 // Fields collection
215 // Field
216 // Folder (Inbox or Outbox)
217 // Fields collection
218 // Field
219 // Folders collection
220 // Folder
221 // Fields collection
222 // Field
223 // [ Folders ... Folder ... ]
224 // Messages collection
225 // AppointmentItem
226 // RecurrencePattern
227 // GroupHeader
228 // MeetingItem
229 // Message
230 // Attachments collection
231 // Attachment
232 // Fields collection
233 // Field
234 // Fields collection
235 // Field
236 // Recipients collection
237 // Recipient
238 // AddressEntry
239 // Fields collection
240 // Field
241 // MessageFilter
242 // Fields collection
243 // Field
244 // InfoStores collection
245 // InfoStore
246 // Fields collection
247 // Field
248 // Folder [as expanded under Folders]
249 //
250 // The notation "[ Folders ... Folder ... ]" signifies that any Folder object
251 // can contain a Folders collection of subfolders, and each subfolder can
252 // contain a Folders collection of more subfolders, nested to an
253 // arbitrary level.
254 // =============================================================================
255
256 interface
257
258 uses Forms, Windows, SysUtils, Classes, Registry, ComObj, Variants, ComCtrls,
259 Controls, Masks;
260
261 const
262 // MAPI Property Tags
263
264 // Field Tags
265 CdoPR_7BIT_DISPLAY_NAME = $39FF001E;
266 CdoPR_AB_DEFAULT_DIR = $3D060102;
267 CdoPR_AB_DEFAULT_PAB = $3D070102;
268 CdoPR_AB_PROVIDER_ID = $36150102;
269 CdoPR_AB_PROVIDERS = $3D010102;
270 CdoPR_AB_SEARCH_PATH = $3D051102;
271 CdoPR_AB_SEARCH_PATH_UPDATE = $3D110102;
272 CdoPR_ACCESS = $0FF40003;
273 CdoPR_ACCESS_LEVEL = $0FF70003;
274 CdoPR_ACCOUNT = $3A00001E;
275 CdoPR_ACKNOWLEDGEMENT_MODE = $00010003;
276 CdoPR_ADDRTYPE = $3002001E;
277 CdoPR_ALTERNATE_RECIPIENT = $3A010102;
278 CdoPR_ALTERNATE_RECIPIENT_ALLOWED = $0002000B;
279 CdoPR_ANR = $360C001E;
280 CdoPR_ASSISTANT = $3A30001E;
281 CdoPR_ASSISTANT_TELEPHONE_NUMBER = $3A2E001E;
282 CdoPR_ASSOC_CONTENT_COUNT = $36170003;
283 CdoPR_ATTACH_ADDITIONAL_INFO = $370F0102;
284 CdoPR_ATTACH_DATA_BIN = $37010102;
285 CdoPR_ATTACH_DATA_OBJ = $3701000D;
286 CdoPR_ATTACH_ENCODING = $37020102;
287 CdoPR_ATTACH_EXTENSION = $3703001E;
288 CdoPR_ATTACH_FILENAME = $3704001E;
289 CdoPR_ATTACH_LONG_FILENAME = $3707001E;
290 CdoPR_ATTACH_LONG_PATHNAME = $370D001E;
291 CdoPR_ATTACH_METHOD = $37050003;
292 CdoPR_ATTACH_MIME_TAG = $370E001E;
293 CdoPR_ATTACH_NUM = $0E210003;
294 CdoPR_ATTACH_PATHNAME = $3708001E;
295 CdoPR_ATTACH_RENDERING = $37090102;
296 CdoPR_ATTACH_SIZE = $0E200003;
297 CdoPR_ATTACH_TAG = $370A0102;
298 CdoPR_ATTACH_TRANSPORT_NAME = $370C001E;
299 CdoPR_ATTACHMENT_X400_PARAMETERS = $37000102;
300 CdoPR_AUTHORIZING_USERS = $00030102;
301 CdoPR_AUTO_FORWARD_COMMENT = $0004001E;
302 CdoPR_AUTO_FORWARDED = $0005000B;
303 CdoPR_BEEPER_TELEPHONE_NUMBER = $3A21001E;
304 CdoPR_BIRTHDAY = $3A420040;
305 CdoPR_BODY = $1000001E;
306 CdoPR_BODY_CRC = $0E1C0003;
307 CdoPR_BUSINESS_ADDRESS_CITY = $3A27001E;
308 CdoPR_BUSINESS_ADDRESS_COUNTRY = $3A26001E;
309 CdoPR_BUSINESS_ADDRESS_POST_OFFICE_BOX = $3A2B001E;
310 CdoPR_BUSINESS_ADDRESS_POSTAL_CODE = $3A2A001E;
311 CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE = $3A28001E;
312 CdoPR_BUSINESS_ADDRESS_STREET = $3A29001E;
313 CdoPR_BUSINESS_FAX_NUMBER = $3A24001E;
314 CdoPR_BUSINESS_HOME_PAGE = $3A51001E;
315 CdoPR_BUSINESS_TELEPHONE_NUMBER = $3A08001E;
316 CdoPR_BUSINESS2_TELEPHONE_NUMBER = $3A1B001E;
317 CdoPR_CALLBACK_TELEPHONE_NUMBER = $3A02001E;
318 CdoPR_CAR_TELEPHONE_NUMBER = $3A1E001E;
319 CdoPR_CELLULAR_TELEPHONE_NUMBER = $3A1C001E;
320 CdoPR_CHILDRENS_NAMES = $3A58101E;
321 CdoPR_CLIENT_SUBMIT_TIME = $00390040;
322 CdoPR_COMMENT = $3004001E;
323 CdoPR_COMMON_VIEWS_ENTRYID = $35E60102;
324 CdoPR_COMPANY_MAIN_PHONE_NUMBER = $3A57001E;
325 CdoPR_COMPANY_NAME = $3A16001E;
326 CdoPR_COMPUTER_NETWORK_NAME = $3A49001E;
327 CdoPR_CONTACT_ADDRTYPES = $3A54101E;
328 CdoPR_CONTACT_DEFAULT_ADDRESS_INDEX = $3A550003;
329 CdoPR_CONTACT_EMAIL_ADDRESSES = $3A56101E;
330 CdoPR_CONTACT_ENTRYIDS = $3A531102;
331 CdoPR_CONTACT_VERSION = $3A520048;
332 CdoPR_CONTAINER_CLASS = $3613001E;
333 CdoPR_CONTAINER_CONTENTS = $360F000D;
334 CdoPR_CONTAINER_FLAGS = $36000003;
335 CdoPR_CONTAINER_HIERARCHY = $360E000D;
336 CdoPR_CONTAINER_MODIFY_VERSION = $36140014;
337 CdoPR_CONTENT_CONFIDENTIALITY_ALGORITHM_ID = $00060102;
338 CdoPR_CONTENT_CORRELATOR = $00070102;
339 CdoPR_CONTENT_COUNT = $36020003;
340 CdoPR_CONTENT_IDENTIFIER = $0008001E;
341 CdoPR_CONTENT_INTEGRITY_CHECK = $0C000102;
342 CdoPR_CONTENT_LENGTH = $00090003;
343 CdoPR_CONTENT_RETURN_REQUESTED = $000A000B;
344 CdoPR_CONTENT_UNREAD = $36030003;
345 CdoPR_CONTENTS_SORT_ORDER = $360D1003;
346 CdoPR_CONTROL_FLAGS = $3F000003;
347 CdoPR_CONTROL_ID = $3F070102;
348 CdoPR_CONTROL_STRUCTURE = $3F010102;
349 CdoPR_CONTROL_TYPE = $3F020003;
350 CdoPR_CONVERSATION_INDEX = $00710102;
351 CdoPR_CONVERSATION_KEY = $000B0102;
352 CdoPR_CONVERSATION_TOPIC = $0070001E;
353 CdoPR_CONVERSION_EITS = $000C0102;
354 CdoPR_CONVERSION_PROHIBITED = $3A03000B;
355 CdoPR_CONVERSION_WITH_LOSS_PROHIBITED = $000D000B;
356 CdoPR_CONVERTED_EITS = $000E0102;
357 CdoPR_CORRELATE = $0E0C000B;
358 CdoPR_CORRELATE_MTSID = $0E0D0102;
359 CdoPR_COUNTRY = $3A26001E;
360 CdoPR_CREATE_TEMPLATES = $3604000D;
361 CdoPR_CREATION_TIME = $30070040;
362 CdoPR_CREATION_VERSION = $0E190014;
363 CdoPR_CURRENT_VERSION = $0E000014;
364 CdoPR_CUSTOMER_ID = $3A4A001E;
365 CdoPR_DEF_CREATE_DL = $36110102;
366 CdoPR_DEF_CREATE_MAILUSER = $36120102;
367 CdoPR_DEFAULT_PROFILE = $3D04000B;
368 CdoPR_DEFAULT_STORE = $3400000B;
369 CdoPR_DEFAULT_VIEW_ENTRYID = $36160102;
370 CdoPR_DEFERRED_DELIVERY_TIME = $000F0040;
371 CdoPR_DELEGATION = $007E0102;
372 CdoPR_DELETE_AFTER_SUBMIT = $0E01000B;
373 CdoPR_DELIVER_TIME = $00100040;
374 CdoPR_DELIVERY_POINT = $0C070003;
375 CdoPR_DELTAX = $3F030003;
376 CdoPR_DELTAY = $3F040003;
377 CdoPR_DEPARTMENT_NAME = $3A18001E;
378 CdoPR_DEPTH = $30050003;
379 CdoPR_DETAILS_TABLE = $3605000D;
380 CdoPR_DISC_VAL = $004A000B;
381 CdoPR_DISCARD_REASON = $00110003;
382 CdoPR_DISCLOSE_RECIPIENTS = $3A04000B;
383 CdoPR_DISCLOSURE_OF_RECIPIENTS = $0012000B;
384 CdoPR_DISCRETE_VALUES = $0E0E000B;
385 CdoPR_DISPLAY_BCC = $0E02001E;
386 CdoPR_DISPLAY_CC = $0E03001E;
387 CdoPR_DISPLAY_NAME = $3001001E;
388 CdoPR_DISPLAY_NAME_PREFIX = $3A45001E;
389 CdoPR_DISPLAY_TO = $0E04001E;
390 CdoPR_DISPLAY_TYPE = $39000003;
391 CdoPR_DL_EXPANSION_HISTORY = $00130102;
392 CdoPR_DL_EXPANSION_PROHIBITED = $0014000B;
393 CdoPR_EMAIL_ADDRESS = $3003001E;
394 CdoPR_EMAIL_AT_ADDRESS = $39FE001E;
395 CdoPR_END_DATE = $00610040;
396 CdoPR_ENTRYID = $0FFF0102;
397 CdoPR_EXPIRY_TIME = $00150040;
398 CdoPR_EXPLICIT_CONVERSION = $0C010003;
399 CdoPR_FILTERING_HOOKS = $3D080102;
400 CdoPR_FINDER_ENTRYID = $35E70102;
401 CdoPR_FOLDER_ASSOCIATED_CONTENTS = $3610000D;
402 CdoPR_FOLDER_TYPE = $36010003;
403 CdoPR_FORM_CATEGORY = $3304001E;
404 CdoPR_FORM_CATEGORY_SUB = $3305001E;
405 CdoPR_FORM_CLSID = $33020048;
406 CdoPR_FORM_CONTACT_NAME = $3303001E;
407 CdoPR_FORM_DESIGNER_GUID = $33090048;
408 CdoPR_FORM_DESIGNER_NAME = $3308001E;
409 CdoPR_FORM_HIDDEN = $3307000B;
410 CdoPR_FORM_HOST_MAP = $33061003;
411 CdoPR_FORM_MESSAGE_BEHAVIOR = $330A0003;
412 CdoPR_FORM_VERSION = $3301001E;
413 CdoPR_FTP_SITE = $3A4C001E;
414 CdoPR_GENDER = $3A4D0002;
415 CdoPR_GENERATION = $3A05001E;
416 CdoPR_GIVEN_NAME = $3A06001E;
417 CdoPR_GOVERNMENT_ID_NUMBER = $3A07001E;
418 CdoPR_HASATTACH = $0E1B000B;
419 CdoPR_HEADER_FOLDER_ENTRYID = $3E0A0102;
420 CdoPR_HOBBIES = $3A43001E;
421 CdoPR_HOME_ADDRESS_CITY = $3A59001E;
422 CdoPR_HOME_ADDRESS_COUNTRY = $3A5A001E;
423 CdoPR_HOME_ADDRESS_POST_OFFICE_BOX = $3A5E001E;
424 CdoPR_HOME_ADDRESS_POSTAL_CODE = $3A5B001E;
425 CdoPR_HOME_ADDRESS_STATE_OR_PROVINCE = $3A5C001E;
426 CdoPR_HOME_ADDRESS_STREET = $3A5D001E;
427 CdoPR_HOME_FAX_NUMBER = $3A25001E;
428 CdoPR_HOME_TELEPHONE_NUMBER = $3A09001E;
429 CdoPR_HOME2_TELEPHONE_NUMBER = $3A2F001E;
430 CdoPR_ICON = $0FFD0102;
431 CdoPR_IDENTITY_DISPLAY = $3E00001E;
432 CdoPR_IDENTITY_ENTRYID = $3E010102;
433 CdoPR_IDENTITY_SEARCH_KEY = $3E050102;
434 CdoPR_IMPLICIT_CONVERSION_PROHIBITED = $0016000B;
435 CdoPR_IMPORTANCE = $00170003;
436 CdoPR_INCOMPLETE_COPY = $0035000B;
437 CdoPR_INITIAL_DETAILS_PANE = $3F080003;
438 CdoPR_INITIALS = $3A0A001E;
439 CdoPR_INSTANCE_KEY = $0FF60102;
440 CdoPR_INTERNET_APPROVED = $1030001E;
441 CdoPR_INTERNET_ARTICLE_NUMBER = $0E230003;
442 CdoPR_INTERNET_CONTROL = $1031001E;
443 CdoPR_INTERNET_DISTRIBUTION = $1032001E;
444 CdoPR_INTERNET_FOLLOWUP_TO = $1033001E;
445 CdoPR_INTERNET_LINES = $10340003;
446 CdoPR_INTERNET_MESSAGE_ID = $1035001E;
447 CdoPR_INTERNET_NEWSGROUPS = $1036001E;
448 CdoPR_INTERNET_NNTP_PATH = $1038001E;
449 CdoPR_INTERNET_ORGANIZATION = $1037001E;
450 CdoPR_INTERNET_PRECEDENCE = $1041001E;
451 CdoPR_INTERNET_REFERENCES = $1039001E;
452 CdoPR_IPM_ID = $00180102;
453 CdoPR_IPM_OUTBOX_ENTRYID = $35E20102;
454 CdoPR_IPM_OUTBOX_SEARCH_KEY = $34110102;
455 CdoPR_IPM_RETURN_REQUESTED = $0C02000B;
456 CdoPR_IPM_SENTMAIL_ENTRYID = $35E40102;
457 CdoPR_IPM_SENTMAIL_SEARCH_KEY = $34130102;
458 CdoPR_IPM_SUBTREE_ENTRYID = $35E00102;
459 CdoPR_IPM_SUBTREE_SEARCH_KEY = $34100102;
460 CdoPR_IPM_WASTEBASKET_ENTRYID = $35E30102;
461 CdoPR_IPM_WASTEBASKET_SEARCH_KEY = $34120102;
462 CdoPR_ISDN_NUMBER = $3A2D001E;
463 CdoPR_KEYWORD = $3A0B001E;
464 CdoPR_LANGUAGE = $3A0C001E;
465 CdoPR_LANGUAGES = $002F001E;
466 CdoPR_LAST_MODIFICATION_TIME = $30080040;
467 CdoPR_LATEST_DELIVERY_TIME = $00190040;
468 CdoPR_LOCALITY = $3A27001E;
469 CdoPR_LOCATION = $3A0D001E;
470 CdoPR_MAIL_PERMISSION = $3A0E000B;
471 CdoPR_MANAGER_NAME = $3A4E001E;
472 CdoPR_MAPPING_SIGNATURE = $0FF80102;
473 CdoPR_MDB_PROVIDER = $34140102;
474 CdoPR_MESSAGE_ATTACHMENTS = $0E13000D;
475 CdoPR_MESSAGE_CC_ME = $0058000B;
476 CdoPR_MESSAGE_CLASS = $001A001E;
477 CdoPR_MESSAGE_DELIVERY_ID = $001B0102;
478 CdoPR_MESSAGE_DELIVERY_TIME = $0E060040;
479 CdoPR_MESSAGE_DOWNLOAD_TIME = $0E180003;
480 CdoPR_MESSAGE_FLAGS = $0E070003;
481 CdoPR_MESSAGE_RECIP_ME = $0059000B;
482 CdoPR_MESSAGE_RECIPIENTS = $0E12000D;
483 CdoPR_MESSAGE_SECURITY_LABEL = $001E0102;
484 CdoPR_MESSAGE_SIZE = $0E080003;
485 CdoPR_MESSAGE_SUBMISSION_ID = $00470102;
486 CdoPR_MESSAGE_TO_ME = $0057000B;
487 CdoPR_MESSAGE_TOKEN = $0C030102;
488 CdoPR_MHS_COMMON_NAME = $3A0F001E;
489 CdoPR_MIDDLE_NAME = $3A44001E;
490 CdoPR_MINI_ICON = $0FFC0102;
491 CdoPR_MOBILE_TELEPHONE_NUMBER = $3A1C001E;
492 CdoPR_MODIFY_VERSION = $0E1A0014;
493 CdoPR_MSG_STATUS = $0E170003;
494 CdoPR_NDR_DIAG_CODE = $0C050003;
495 CdoPR_NDR_REASON_CODE = $0C040003;
496 CdoPR_NEWSGROUP_NAME = $0E24001E;
497 CdoPR_NICKNAME = $3A4F001E;
498 CdoPR_NNTP_XREF = $1040001E;
499 CdoPR_NON_RECEIPT_NOTIFICATION_REQUESTED = $0C06000B;
500 CdoPR_NON_RECEIPT_REASON = $003E0003;
501 CdoPR_NORMALIZED_SUBJECT = $0E1D001E;
502 CdoPR_OBJECT_TYPE = $0FFE0003;
503 CdoPR_OBSOLETED_IPMS = $001F0102;
504 CdoPR_OFFICE_LOCATION = $3A19001E;
505 CdoPR_OFFICE_TELEPHONE_NUMBER = $3A08001E;
506 CdoPR_OFFICE2_TELEPHONE_NUMBER = $3A1B001E;
507 CdoPR_ORGANIZATIONAL_ID_NUMBER = $3A10001E;
508 CdoPR_ORIG_MESSAGE_CLASS = $004B001E;
509 CdoPR_ORIGIN_CHECK = $00270102;
510 CdoPR_ORIGINAL_AUTHOR_ADDRTYPE = $0079001E;
511 CdoPR_ORIGINAL_AUTHOR_EMAIL_ADDRESS = $007A001E;
512 CdoPR_ORIGINAL_AUTHOR_ENTRYID = $004C0102;
513 CdoPR_ORIGINAL_AUTHOR_NAME = $004D001E;
514 CdoPR_ORIGINAL_AUTHOR_SEARCH_KEY = $00560102;
515 CdoPR_ORIGINAL_DELIVERY_TIME = $00550040;
516 CdoPR_ORIGINAL_DISPLAY_BCC = $0072001E;
517 CdoPR_ORIGINAL_DISPLAY_CC = $0073001E;
518 CdoPR_ORIGINAL_DISPLAY_NAME = $3A13001E;
519 CdoPR_ORIGINAL_DISPLAY_TO = $0074001E;
520 CdoPR_ORIGINAL_EITS = $00210102;
521 CdoPR_ORIGINAL_ENTRYID = $3A120102;
522 CdoPR_ORIGINAL_SEARCH_KEY = $3A140102;
523 CdoPR_ORIGINAL_SENDER_ADDRTYPE = $0066001E;
524 CdoPR_ORIGINAL_SENDER_EMAIL_ADDRESS = $0067001E;
525 CdoPR_ORIGINAL_SENDER_ENTRYID = $005B0102;
526 CdoPR_ORIGINAL_SENDER_NAME = $005A001E;
527 CdoPR_ORIGINAL_SENDER_SEARCH_KEY = $005C0102;
528 CdoPR_ORIGINAL_SENSITIVITY = $002E0003;
529 CdoPR_ORIGINAL_SENT_REPRESENTING_ADDRTYPE = $0068001E;
530 CdoPR_ORIGINAL_SENT_REPRESENTING_EMAIL_ADDR = $0069001E;
531 CdoPR_ORIGINAL_SENT_REPRESENTING_ENTRYID = $005E0102;
532 CdoPR_ORIGINAL_SENT_REPRESENTING_NAME = $005D001E;
533 CdoPR_ORIGINAL_SENT_REPRESENTING_SEARCH_KEY = $005F0102;
534 CdoPR_ORIGINAL_SUBJECT = $0049001E;
535 CdoPR_ORIGINAL_SUBMIT_TIME = $004E0040;
536 CdoPR_ORIGINALLY_INTENDED_RECIP_ADDRTYPE = $007B001E;
537 CdoPR_ORIGINALLY_INTENDED_RECIP_EMAIL_ADDR = $007C001E;
538 CdoPR_ORIGINALLY_INTENDED_RECIP_ENTRYID = $10120102;
539 CdoPR_ORIGINALLY_INTENDED_RECIPIENT_NAME = $00200102;
540 CdoPR_ORIGINATING_MTA_CERTIFICATE = $0E250102;
541 CdoPR_ORIGINATOR_AND_DL_EXPANSION_HISTORY = $10020102;
542 CdoPR_ORIGINATOR_CERTIFICATE = $00220102;
543 CdoPR_ORIGINATOR_DELIVERY_REPORT_REQUESTED = $0023000B;
544 CdoPR_ORIGINATOR_NON_DELIVERY_REPORT_REQ = $0C08000B;
545 CdoPR_ORIGINATOR_REQUESTED_ALTERNATE_RECIP = $0C090102;
546 CdoPR_ORIGINATOR_RETURN_ADDRESS = $00240102;
547 CdoPR_OTHER_ADDRESS_CITY = $3A5F001E;
548 CdoPR_OTHER_ADDRESS_COUNTRY = $3A60001E;
549 CdoPR_OTHER_ADDRESS_POST_OFFICE_BOX = $3A64001E;
550 CdoPR_OTHER_ADDRESS_POSTAL_CODE = $3A61001E;
551 CdoPR_OTHER_ADDRESS_STATE_OR_PROVINCE = $3A62001E;
552 CdoPR_OTHER_ADDRESS_STREET = $3A63001E;
553 CdoPR_OTHER_TELEPHONE_NUMBER = $3A1F001E;
554 CdoPR_OWN_STORE_ENTRYID = $3E060102;
555 CdoPR_OWNER_APPT_ID = $00620003;
556 CdoPR_PAGER_TELEPHONE_NUMBER = $3A21001E;
557 CdoPR_PARENT_DISPLAY = $0E05001E;
558 CdoPR_PARENT_ENTRYID = $0E090102;
559 CdoPR_PARENT_KEY = $00250102;
560 CdoPR_PERSONAL_HOME_PAGE = $3A50001E;
561 CdoPR_PHYSICAL_DELIVERY_BUREAU_FAX_DELIVERY = $0C0A000B;
562 CdoPR_PHYSICAL_DELIVERY_MODE = $0C0B0003;
563 CdoPR_PHYSICAL_DELIVERY_REPORT_REQUEST = $0C0C0003;
564 CdoPR_PHYSICAL_FORWARDING_ADDRESS = $0C0D0102;
565 CdoPR_PHYSICAL_FORWARDING_ADDRESS_REQUESTED = $0C0E000B;
566 CdoPR_PHYSICAL_FORWARDING_PROHIBITED = $0C0F000B;
567 CdoPR_PHYSICAL_RENDITION_ATTRIBUTES = $0C100102;
568 CdoPR_POST_FOLDER_ENTRIES = $103B0102;
569 CdoPR_POST_FOLDER_NAMES = $103C001E;
570 CdoPR_POST_OFFICE_BOX = $3A2B001E;
571 CdoPR_POST_REPLY_DENIED = $103F0102;
572 CdoPR_POST_REPLY_FOLDER_ENTRIES = $103D0102;
573 CdoPR_POST_REPLY_FOLDER_NAMES = $103E001E;
574 CdoPR_POSTAL_ADDRESS = $3A15001E;
575 CdoPR_POSTAL_CODE = $3A2A001E;
576 CdoPR_PREFERRED_BY_NAME = $3A47001E;
577 CdoPR_PREPROCESS = $0E22000B;
578 CdoPR_PRIMARY_CAPABILITY = $39040102;
579 CdoPR_PRIMARY_FAX_NUMBER = $3A23001E;
580 CdoPR_PRIMARY_TELEPHONE_NUMBER = $3A1A001E;
581 CdoPR_PRIORITY = $00260003;
582 CdoPR_PROFESSION = $3A46001E;
583 CdoPR_PROFILE_NAME = $3D12001E;
584 CdoPR_PROOF_OF_DELIVERY = $0C110102;
585 CdoPR_PROOF_OF_DELIVERY_REQUESTED = $0C12000B;
586 CdoPR_PROOF_OF_SUBMISSION = $0E260102;
587 CdoPR_PROOF_OF_SUBMISSION_REQUESTED = $0028000B;
588 CdoPR_PROVIDER_DISPLAY = $3006001E;
589 CdoPR_PROVIDER_DLL_NAME = $300A001E;
590 CdoPR_PROVIDER_ORDINAL = $300D0003;
591 CdoPR_PROVIDER_SUBMIT_TIME = $00480040;
592 CdoPR_PROVIDER_UID = $300C0102;
593 CdoPR_RADIO_TELEPHONE_NUMBER = $3A1D001E;
594 CdoPR_RCVD_REPRESENTING_ADDRTYPE = $0077001E;
595 CdoPR_RCVD_REPRESENTING_EMAIL_ADDRESS = $0078001E;
596 CdoPR_RCVD_REPRESENTING_ENTRYID = $00430102;
597 CdoPR_RCVD_REPRESENTING_NAME = $0044001E;
598 CdoPR_RCVD_REPRESENTING_SEARCH_KEY = $00520102;
599 CdoPR_READ_RECEIPT_ENTRYID = $00460102;
600 CdoPR_READ_RECEIPT_REQUESTED = $0029000B;
601 CdoPR_READ_RECEIPT_SEARCH_KEY = $00530102;
602 CdoPR_RECEIPT_TIME = $002A0040;
603 CdoPR_RECEIVE_FOLDER_SETTINGS = $3415000D;
604 CdoPR_RECEIVED_BY_ADDRTYPE = $0075001E;
605 CdoPR_RECEIVED_BY_EMAIL_ADDRESS = $0076001E;
606 CdoPR_RECEIVED_BY_ENTRYID = $003F0102;
607 CdoPR_RECEIVED_BY_NAME = $0040001E;
608 CdoPR_RECEIVED_BY_SEARCH_KEY = $00510102;
609 CdoPR_RECIPIENT_CERTIFICATE = $0C130102;
610 CdoPR_RECIPIENT_NUMBER_FOR_ADVICE = $0C14001E;
611 CdoPR_RECIPIENT_REASSIGNMENT_PROHIBITED = $002B000B;
612 CdoPR_RECIPIENT_STATUS = $0E150003;
613 CdoPR_RECIPIENT_TYPE = $0C150003;
614 CdoPR_RECORD_KEY = $0FF90102;
615 CdoPR_REDIRECTION_HISTORY = $002C0102;
616 CdoPR_REFERRED_BY_NAME = $3A47001E;
617 CdoPR_REGISTERED_MAIL_TYPE = $0C160003;
618 CdoPR_RELATED_IPMS = $002D0102;
619 CdoPR_REMOTE_PROGRESS = $3E0B0003;
620 CdoPR_REMOTE_PROGRESS_TEXT = $3E0C001E;
621 CdoPR_REMOTE_VALIDATE_OK = $3E0D000B;
622 CdoPR_RENDERING_POSITION = $370B0003;
623 CdoPR_REPLY_RECIPIENT_ENTRIES = $004F0102;
624 CdoPR_REPLY_RECIPIENT_NAMES = $0050001E;
625 CdoPR_REPLY_REQUESTED = $0C17000B;
626 CdoPR_REPLY_TIME = $00300040;
627 CdoPR_REPORT_ENTRYID = $00450102;
628 CdoPR_REPORT_NAME = $003A001E;
629 CdoPR_REPORT_SEARCH_KEY = $00540102;
630 CdoPR_REPORT_TAG = $00310102;
631 CdoPR_REPORT_TEXT = $1001001E;
632 CdoPR_REPORT_TIME = $00320040;
633 CdoPR_REPORTING_DL_NAME = $10030102;
634 CdoPR_REPORTING_MTA_CERTIFICATE = $10040102;
635 CdoPR_REQUESTED_DELIVERY_METHOD = $0C180003;
636 CdoPR_RESOURCE_FLAGS = $30090003;
637 CdoPR_RESOURCE_METHODS = $3E020003;
638 CdoPR_RESOURCE_PATH = $3E07001E;
639 CdoPR_RESOURCE_TYPE = $3E030003;
640 CdoPR_RESPONSE_REQUESTED = $0063000B;
641 CdoPR_RESPONSIBILITY = $0E0F000B;
642 CdoPR_RETURNED_IPM = $0033000B;
643 CdoPR_ROW_TYPE = $0FF50003;
644 CdoPR_ROWID = $30000003;
645 CdoPR_RTF_COMPRESSED = $10090102;
646 CdoPR_RTF_IN_SYNC = $0E1F000B;
647 CdoPR_RTF_SYNC_BODY_COUNT = $10070003;
648 CdoPR_RTF_SYNC_BODY_CRC = $10060003;
649 CdoPR_RTF_SYNC_BODY_TAG = $1008001E;
650 CdoPR_RTF_SYNC_PREFIX_COUNT = $10100003;
651 CdoPR_RTF_SYNC_TRAILING_COUNT = $10110003;
652 CdoPR_SEARCH = $3607000D;
653 CdoPR_SEARCH_KEY = $300B0102;
654 CdoPR_SECURITY = $00340003;
655 CdoPR_SELECTABLE = $3609000B;
656 CdoPR_SEND_INTERNET_ENCODING = $3A710003;
657 CdoPR_SEND_RICH_INFO = $3A40000B;
658 CdoPR_SENDER_ADDRTYPE = $0C1E001E;
659 CdoPR_SENDER_EMAIL_ADDRESS = $0C1F001E;
660 CdoPR_SENDER_ENTRYID = $0C190102;
661 CdoPR_SENDER_NAME = $0C1A001E;
662 CdoPR_SENDER_SEARCH_KEY = $0C1D0102;
663 CdoPR_SENSITIVITY = $00360003;
664 CdoPR_SENT_REPRESENTING_ADDRTYPE = $0064001E;
665 CdoPR_SENT_REPRESENTING_EMAIL_ADDRESS = $0065001E;
666 CdoPR_SENT_REPRESENTING_ENTRYID = $00410102;
667 CdoPR_SENT_REPRESENTING_NAME = $0042001E;
668 CdoPR_SENT_REPRESENTING_SEARCH_KEY = $003B0102;
669 CdoPR_SENTMAIL_ENTRYID = $0E0A0102;
670 CdoPR_SERVICE_DELETE_FILES = $3D10101E;
671 CdoPR_SERVICE_DLL_NAME = $3D0A001E;
672 CdoPR_SERVICE_ENTRY_NAME = $3D0B001E;
673 CdoPR_SERVICE_EXTRA_UIDS = $3D0D0102;
674 CdoPR_SERVICE_NAME = $3D09001E;
675 CdoPR_SERVICE_SUPPORT_FILES = $3D0F101E;
676 CdoPR_SERVICE_UID = $3D0C0102;
677 CdoPR_SERVICES = $3D0E0102;
678 CdoPR_SPOOLER_STATUS = $0E100003;
679 CdoPR_SPOUSE_NAME = $3A48001E;
680 CdoPR_START_DATE = $00600040;
681 CdoPR_STATE_OR_PROVINCE = $3A28001E;
682 CdoPR_STATUS = $360B0003;
683 CdoPR_STATUS_CODE = $3E040003;
684 CdoPR_STATUS_STRING = $3E08001E;
685 CdoPR_STORE_ENTRYID = $0FFB0102;
686 CdoPR_STORE_PROVIDERS = $3D000102;
687 CdoPR_STORE_RECORD_KEY = $0FFA0102;
688 CdoPR_STORE_STATE = $340E0003;
689 CdoPR_STORE_SUPPORT_MASK = $340D0003;
690 CdoPR_STREET_ADDRESS = $3A29001E;
691 CdoPR_SUBFOLDERS = $360A000B;
692 CdoPR_SUBJECT = $0037001E;
693 CdoPR_SUBJECT_IPM = $00380102;
694 CdoPR_SUBJECT_PREFIX = $003D001E;
695 CdoPR_SUBMIT_FLAGS = $0E140003;
696 CdoPR_SUPERSEDES = $103A001E;
697 CdoPR_SUPPLEMENTARY_INFO = $0C1B001E;
698 CdoPR_SURNAME = $3A11001E;
699 CdoPR_TELEX_NUMBER = $3A2C001E;
700 CdoPR_TEMPLATEID = $39020102;
701 CdoPR_TITLE = $3A17001E;
702 CdoPR_TNEF_CORRELATION_KEY = $007F0102;
703 CdoPR_TRANSMITABLE_DISPLAY_NAME = $3A20001E;
704 CdoPR_TRANSPORT_KEY = $0E160003;
705 CdoPR_TRANSPORT_MESSAGE_HEADERS = $007D001E;
706 CdoPR_TRANSPORT_PROVIDERS = $3D020102;
707 CdoPR_TRANSPORT_STATUS = $0E110003;
708 CdoPR_TTYTDD_PHONE_NUMBER = $3A4B001E;
709 CdoPR_TYPE_OF_MTS_USER = $0C1C0003;
710 CdoPR_USER_CERTIFICATE = $3A220102;
711 CdoPR_USER_X509_CERTIFICATE = $3A701102;
712 CdoPR_VALID_FOLDER_MASK = $35DF0003;
713 CdoPR_VIEWS_ENTRYID = $35E50102;
714 CdoPR_WEDDING_ANNIVERSARY = $3A410040;
715 CdoPR_X400_CONTENT_TYPE = $003C0102;
716 CdoPR_X400_DEFERRED_DELIVERY_CANCEL = $3E09000B;
717 CdoPR_XPOS = $3F050003;
718 CdoPR_YPOS = $3F060003;
719
720 // General
721 PR_IPM_PUBLIC_FOLDERS_ENTRYID = $66310102;
722 CdoDefaultFolderCalendar = 0;
723 CdoDefaultFolderContacts = 5;
724 CdoDefaultFolderDeletedItems = 4;
725 CdoDefaultFolderInbox = 1;
726 CdoDefaultFolderJournal = 6;
727 CdoDefaultFolderNotes = 7;
728 CdoDefaultFolderOutbox = 2;
729 CdoDefaultFolderSentItems = 3;
730 CdoDefaultFolderTasks = 8;
731
732 // Message Recipients
733 CdoTo = 1;
734 CdoCc = 2;
735 CdoBcc = 3;
736
737 // Attachment Types
738 CdoFileData = 1;
739 CdoFileLink = 2;
740 CdoOLE = 3;
741 CdoEmbeddedMessage = 4;
742
743 // AddressEntry DisplayType
744 CdoUser = 0; // A local messaging user.
745 CdoDistList = 1; // A public distribution list.
746 CdoForum = 2; // A forum, such as a bulletin board or a public folder.
747 CdoAgent = 3; // An automated agent, such as Quote-of-the-Day.
748 CdoOrganization = 4;
749 // A special address entry defined for large groups, such as a helpdesk.
750 CdoPrivateDistList = 5; // A private, personally administered distribution list.
751 CdoRemoteUser = 6; // A messaging user in a remote messaging system.
752
753 // Error Codes
754 CdoE_OK = 0;
755 CdoE_ACCOUNT_DISABLED = $80040124;
756 CdoE_AMBIGUOUS_RECIP = $80040700;
757 CdoE_BAD_CHARWIDTH = $80040103;
758 CdoE_BAD_COLUMN = $80040118;
759 CdoE_BAD_VALUE = $80040301;
760 CdoE_BUSY = $8004010B;
761 CdoE_CALL_FAILED = $80004005;
762 CdoE_CANCEL = $80040501;
763 CdoE_COLLISION = $80040604;
764 CdoE_COMPUTED = $8004011A;
765 CdoE_CORRUPT_DATA = $8004011B;
766 CdoE_CORRUPT_STORE = $80040600;
767 CdoE_DECLINE_COPY = $80040306;
768 CdoE_DISK_ERROR = $80040116;
769 CdoE_END_OF_SESSION = $80040200;
770 CdoE_EXTENDED_ERROR = $80040119;
771 CdoE_FAILONEPROVIDER = $8004011D;
772 CdoE_FOLDER_CYCLE = $8004060B;
773 CdoE_HAS_FOLDERS = $80040609;
774 CdoE_HAS_MESSAGES = $8004060A;
775 CdoE_INTERFACE_NOT_SUPPORTED = $80004002;
776 CdoE_INVALID_ACCESS_TIME = $80040123;
777 CdoE_INVALID_BOOKMARK = $80040405;
778 CdoE_INVALID_ENTRYID = $80040107;
779 CdoE_INVALID_OBJECT = $80040108;
780 CdoE_INVALID_PARAMETER = $80070057;
781 CdoE_INVALID_TYPE = $80040302;
782 CdoE_INVALID_WORKSTATION_ACCOUNT = $80040122;
783 CdoE_LOGON_FAILED = $80040111;
784 CdoE_MISSING_REQUIRED_COLUMN = $80040202;
785 CdoE_NETWORK_ERROR = $80040115;
786 CdoE_NO_ACCESS = $80070005;
787 CdoE_NO_RECIPIENTS = $80040607;
788 CdoE_NO_SUPPORT = $80040102;
789 CdoE_NO_SUPPRESS = $80040602;
790 CdoE_NON_STANDARD = $80040606;
791 CdoE_NOT_ENOUGH_DISK = $8004010D;
792 CdoE_NOT_ENOUGH_MEMORY = $8007000E;
793 CdoE_NOT_ENOUGH_RESOURCES = $8004010E;
794 CdoE_NOT_FOUND = $8004010F;
795 CdoE_NOT_IN_QUEUE = $80040601;
796 CdoE_NOT_INITIALIZED = $80040605;
797 CdoE_NOT_ME = $80040502;
798 CdoE_OBJECT_CHANGED = $80040109;
799 CdoE_OBJECT_DELETED = $8004010A;
800 CdoE_PASSWORD_CHANGE_REQUIRED = $80040120;
801 CdoE_PASSWORD_EXPIRED = $80040121;
802 CdoE_SESSION_LIMIT = $80040112;
803 CdoE_STRING_TOO_LONG = $80040105;
804 CdoE_SUBMITTED = $80040608;
805 CdoE_TABLE_EMPTY = $80040402;
806 CdoE_TABLE_TOO_BIG = $80040403;
807 CdoE_TIMEOUT = $80040401;
808 CdoE_TOO_BIG = $80040305;
809 CdoE_TOO_COMPLEX = $80040117;
810 CdoE_TYPE_NO_SUPPORT = $80040303;
811 CdoE_UNABLE_TO_ABORT = $80040114;
812 CdoE_UNABLE_TO_COMPLETE = $80040400;
813 CdoE_UNCONFIGURED = $8004011C;
814 CdoE_UNEXPECTED_ID = $80040307;
815 CdoE_UNEXPECTED_TYPE = $80040304;
816 CdoE_UNKNOWN_CPID = $8004011E;
817 CdoE_UNKNOWN_ENTRYID = $80040201;
818 CdoE_UNKNOWN_FLAGS = $80040106;
819 CdoE_UNKNOWN_LCID = $8004011F;
820 CdoE_USER_CANCEL = $80040113;
821 CdoE_VERSION = $80040110;
822 CdoE_WAIT = $80040500;
823 CdoW_APPROX_COUNT = $00040482;
824 CdoW_CANCEL_MESSAGE = $00040580;
825 CdoW_ERRORS_RETURNED = $00040380;
826 CdoW_NO_SERVICE = $00040203;
827 CdoW_PARTIAL_COMPLETION = $00040680;
828 CdoW_POSITION_CHANGED = $00040481;
829
830 type
831 TOleVarPtr = ^OleVariant;
832
833 TCdoMapiSession = class(TObject)
834 private
835 FImpersonated: boolean;
836 FLastErrorCode: DWORD;
837 FMyName,
838 FMyEMailAddress,
839 FLastError: string;
840 FCurrentUser,
841 FOleGlobalAddressList,
842 FOleDeletedItems,
843 FOleOutBox, FOleSentItems,
844 FOleInbox, FOleContacts,
845 FOleSession: OleVariant;
846 FConnected: boolean;
847 function GetFVersion: string;
848 protected
849 procedure SetOleFolders;
850 public
851 // System
852 constructor Create; overload;
853 constructor Create(const Profile: string); overload;
854 constructor Create(const Profile: string;
855 const UserName: string;
856 const Domain: string;
857 const Password: string); overload;
858 destructor Destroy; override;
859
860 // User
861 function LoadAddressList(StringList: TStrings): boolean;
862 function LoadObjectList(const FolderOle: OleVariant; List: TList): boolean;
863 function LoadEMailTree(TV: TTreeView; Expand1stLevel: boolean = false;
864 SubjectMask: string = ''): boolean;
865 function LoadContactList(const FolderOle: OleVariant;
866 Items: TStrings): boolean; overload;
867 function LoadContactList(const FolderName: string;
868 Items: TStrings): boolean; overload;
869 procedure ShowContactDetails(Contact: OleVariant);
870
871 function First(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;
872 function Last(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;
873 function Next(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;
874 function Prior(const FolderOle: OleVariant; out ItemOle: OleVariant): boolean;
875 function AsString(const ItemOle: Olevariant; const FieldIdConstant: DWORD):
876 string;
877
878 // Properties
879 property CurrentUser: OleVariant read FCurrentUser;
880 property Connected: boolean read FConnected;
881 property LastErrorMess: string read FlastError;
882 property LastErrorCode: DWORD read FlastErrorCode;
883 property InBox: OleVariant read FOleInBox;
884 property OutBox: OleVariant read FOleOutBox;
885 property DeletedItems: Olevariant read FOleDeletedItems;
886 property SentItems: Olevariant read FOleSentItems;
887 property GlobalAddressList: Olevariant read FOleGlobalAddressList;
888 property Contacts: Olevariant read FOleContacts;
889 property Session: OleVariant read FOleSession;
890 property Version: string read GetFVersion;
891 property MyName: string read FMyName;
892 property MyEMailAddress: string read FMyEMailAddress;
893 end;
894
895 // Function Prototypes
896 function CdoNothing(Obj: OleVariant): boolean;
897 function CdoDefaultProfile: string;
898 procedure CdoDisposeList(WorkList: TList);
899 procedure CdoDisposeObjects(WorkStrings: TStrings);
900 procedure CdoDisposeNodes(WorkData: TTreeNodes);
901
902 function VarNothing: IDispatch;
903
904 // -----------------------------------------------------------------------------
905 implementation
906
907 // ===================================
908 // Emulate VB function IS NOTHING
909 // ===================================
910
911 function CdoNothing(Obj: OleVariant): boolean;
912 begin
913 Result := IDispatch(Obj) = nil;
914 end;
915
916 // ============================================
917 // Emulate VB function VarX := Nothing
918 // ============================================
919
920 function VarNothing: IDispatch;
921 var
922 Retvar: IDispatch;
923 begin
924 Retvar := nil;
925 Result := Retvar;
926 end;
927
928 // ============================================
929 // Get Default Message profile from registry
930 // ============================================
931
932 function CdoDefaultProfile: string;
933 var
934 WinReg: TRegistry;
935 Retvar: string;
936 begin
937 Retvar := '';
938 WinReg := TRegistry.Create;
939
940 if
941 WinReg.OpenKey('\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging
942 Subsystem\Profiles'
943 begin
944 Retvar := WinReg.ReadString('DefaultProfile');
945 WinReg.CloseKey;
946 end;
947
948 WinReg.Free;
949 Result := Retvar;
950 end;
951
952 // =================================================
953 // Disposes of any memory allocations in a TList
954 // =================================================
955
956 procedure CdoDisposeList(WorkList: TList);
957 var
958 i: integer;
959 begin
960 if WorkList <> nil then
961 for i := 0 to WorkList.Count - 1 do
962 if WorkList[i] <> nil then
963 dispose(WorkList[i]);
964 end;
965
966 // ====================================================
967 // Disposes of any memory allocations in a TStringList
968 // ====================================================
969
970 procedure CdoDisposeObjects(WorkStrings: TStrings);
971 var
972 i: integer;
973 begin
974 if WorkStrings <> nil then
975 for i := 0 to WorkStrings.Count - 1 do
976 if WorkStrings.Objects[i] <> nil then
977 dispose(TOleVarPtr(WorkStrings.Objects[i]));
978 end;
979
980 // ====================================================
981 // Disposes of any memory allocations in a TTreeView
982 // ====================================================
983
984 procedure CdoDisposeNodes(WorkData: TTreeNodes);
985 var
986 i: integer;
987 TN: TTreeNode;
988 begin
989 if WorkData <> nil then
990 begin
991 for i := 0 to WorkData.Count - 1 do
992 begin
993 TN := WorkData[i];
994 if TN.Data <> nil then
995 dispose(TOleVarPtr(TN.Data));
996 end;
997 end;
998 end;
999
1000// -----------------------------------------------------------------------------
1001// TCdoMapiSession
1002// -----------------------------------------------------------------------------
1003
1004// ================
1005// Default Profile
1006// ================
1007
1008constructor TCdoMapiSession.Create;
1009begin
1010 FImpersonated := false;
1011 FLastError := '';
1012 FLastErrorCode := CdoE_OK;
1013 try
1014 FOleSession := CreateOleObject('MAPI.Session');
1015 FOleSession.Logon(CdoDefaultProfile);
1016 SetOleFolders;
1017 except
1018 on E: Exception do
1019 begin
1020 FLastError := E.message;
1021 FLastErrorCode := CdoE_LOGON_FAILED;
1022 FConnected := false;
1023 end;
1024 end;
1025end;
1026
1027// ===========================
1028// With Specified Profile
1029// ===========================
1030
1031constructor TCdoMapiSession.Create(const Profile: string);
1032begin
1033 FImpersonated := false;
1034 try
1035 FOleSession := CreateOleObject('MAPI.Session');
1036 FOleSession.Logon(Profile);
1037 SetOleFolders;
1038 except
1039 on E: Exception do
1040 begin
1041 FLastError := E.message;
1042 FLastErrorCode := CdoE_LOGON_FAILED;
1043 FConnected := false;
1044 end;
1045 end;
1046end;
1047
1048// ======================================================
1049// Impersonate amother user and use specified profile
1050// ======================================================
1051
1052constructor TCdoMapiSession.Create(const Profile: string;
1053 const UserName: string;
1054 const Domain: string;
1055 const Password: string);
1056var
1057 SecurityH: THandle;
1058begin
1059 FImpersonated := false;
1060 try
1061 LogonUser(PChar(UserName), PChar(Domain), PChar(Password),
1062 LOGON32_LOGON_SERVICE,
1063 LOGON32_PROVIDER_DEFAULT, SecurityH);
1064 FImpersonated := ImpersonateLoggedOnUser(SecurityH);
1065 FOleSession := CreateOleObject('MAPI.Session');
1066 FOleSession.Logon(Profile, Password, false, true);
1067 SetOleFolders;
1068 except
1069 on E: Exception do
1070 begin
1071 FLastError := E.message;
1072 FLastErrorCode := CdoE_LOGON_FAILED;
1073 FConnected := false;
1074 end;
1075 end;
1076end;
1077
1078// ======================
1079// Free and Clean up
1080// ======================
1081
1082destructor TCdoMapiSession.Destroy;
1083begin
1084 if FConnected then
1085 FOleSession.LogOff;
1086 FCurrentUser := Unassigned;
1087 FOleGlobalAddressList := Unassigned;
1088 FOleSentItems := Unassigned;
1089 FOleContacts := Unassigned;
1090 FOleOutBox := Unassigned;
1091 FOleDeletedItems := Unassigned;
1092 FOleInBox := Unassigned;
1093 FOleSession := Unassigned;
1094 if FImpersonated then
1095 RevertToSelf;
1096 inherited Destroy;
1097end;
1098
1099// =======================================================
1100// Addition initialization called by Create() oveloads
1101// =======================================================
1102
1103procedure TCdoMapiSession.SetOleFolders;
1104begin
1105 try
1106 FOleGlobalAddressList :=
1107 FOleSession.AddressLists['Global Address List'].AddressEntries;
1108 except
1109 FOleGlobalAddressList := VarNothing;
1110 end;
1111
1112 try
1113 FOleContacts := FOleSession.AddressLists['Contacts'].AddressEntries;
1114 except
1115 FOleContacts := VarNothing;
1116 end;
1117
1118 try
1119 FOleInBox := FOleSession.InBox.Messages;
1120 except
1121 FOleInBox := VarNothing;
1122 end;
1123
1124 try
1125 FOleOutBox := FOleSession.OutBox.Messages;
1126 except
1127 FOleOutBox := VarNothing;
1128 end;
1129
1130 try
1131 FOleDeletedItems :=
1132 FOleSession.GetDefaultFolder(CdoDefaultFolderDeletedItems).Messages;
1133 except
1134 FOleDeletedItems := VarNothing;
1135 end;
1136
1137 try
1138 FOleSentItems :=
1139FOleSession.GetDefaultFolder(CdoDefaultFolderSentItems).Messages;
1140 except
1141 FOleSentItems := VarNothing;
1142 end;
1143
1144 try
1145 FCurrentUser := FOleSession.CurrentUser;
1146 FMyName := FCurrentUser.Name;
1147 except
1148 FCurrentUser := VarNothing;
1149 end;
1150
1151 FConnected := true;
1152 FMyEMailAddress := AsString(FCurrentUser, CdoPR_EMAIL_AT_ADDRESS);
1153end;
1154
1155// ======================
1156// Return CDO Version
1157// ======================
1158
1159function TCdoMapiSession.GetFVersion: string;
1160begin
1161 if FConnected then
1162 Result := FOleSession.Version
1163 else
1164 Result := 'Not Connected';
1165end;
1166
1167// ========================================================
1168// Fill a string list with all available address lists
1169// ========================================================
1170
1171function TCdoMapiSession.LoadAddressList(StringList: TStrings): boolean;
1172var
1173 Addr: OleVariant;
1174 i: integer;
1175 Retvar: boolean;
1176begin
1177 Retvar := false;
1178
1179 if FConnected then
1180 begin
1181 StringList.Clear;
1182 try
1183 Addr := FOleSession.AddressLists;
1184 for i := 1 to Addr.Count do
1185 StringList.Add(Addr.Item[i].Name);
1186 Retvar := true;
1187 except
1188 on E: Exception do
1189 begin
1190 FLastError := E.message;
1191 FLastErrorCode := CdoE_NOT_FOUND;
1192 end;
1193 end;
1194
1195 Addr := Unassigned;
1196 end;
1197
1198 Result := Retvar;
1199end;
1200
1201// =================================================
1202// Iteration functions
1203// =================================================
1204
1205function TCdoMapiSession.First(const FolderOle: OleVariant;
1206 out ItemOle: OleVariant): boolean;
1207var
1208 Retvar: boolean;
1209begin
1210 Retvar := true;
1211
1212 if FConnected then
1213 begin
1214 try
1215 ItemOle := FolderOle.GetFirst;
1216 if CdoNothing(ItemOle) then
1217 begin
1218 Retvar := false;
1219 end;
1220 except
1221 on E: Exception do
1222 begin
1223 FLastError := E.message;
1224 FLastErrorCode := CdoE_NOT_FOUND;
1225 Retvar := false;
1226 end;
1227 end;
1228 end
1229 else
1230 Retvar := false;
1231
1232 Result := Retvar;
1233end;
1234
1235function TCdoMapiSession.Last(const FolderOle: OleVariant;
1236 out ItemOle: OleVariant): boolean;
1237var
1238 Retvar: boolean;
1239begin
1240 Retvar := true;
1241
1242 if FConnected then
1243 begin
1244 try
1245 ItemOle := FolderOle.GetLast;
1246 if CdoNothing(ItemOle) then
1247 begin
1248 Retvar := false;
1249 end;
1250 except
1251 on E: Exception do
1252 begin
1253 FLastError := E.message;
1254 FLastErrorCode := CdoE_NOT_FOUND;
1255 Retvar := false;
1256 end;
1257 end;
1258 end
1259 else
1260 Retvar := false;
1261
1262 Result := Retvar;
1263end;
1264
1265function TCdoMapiSession.Next(const FolderOle: OleVariant;
1266 out ItemOle: OleVariant): boolean;
1267var
1268 Retvar: boolean;
1269begin
1270 Retvar := true;
1271
1272 if FConnected then
1273 begin
1274 try
1275 ItemOle := FolderOle.GetNext;
1276 if CdoNothing(ItemOle) then
1277 begin
1278 Retvar := false;
1279 end;
1280 except
1281 on E: Exception do
1282 begin
1283 FLastError := E.message;
1284 FLastErrorCode := CdoE_NOT_FOUND;
1285 Retvar := false;
1286 end;
1287 end;
1288 end
1289 else
1290 Retvar := false;
1291
1292 Result := Retvar;
1293end;
1294
1295function TCdoMapiSession.Prior(const FolderOle: OleVariant;
1296 out ItemOle: OleVariant): boolean;
1297var
1298 Retvar: boolean;
1299begin
1300 Retvar := true;
1301
1302 if FConnected then
1303 begin
1304 try
1305 ItemOle := FolderOle.GetPrior;
1306 if CdoNothing(ItemOle) then
1307 begin
1308 Retvar := false;
1309 end;
1310 except
1311 on E: Exception do
1312 begin
1313 FLastError := E.message;
1314 FLastErrorCode := CdoE_NOT_FOUND;
1315 Retvar := false;
1316 end;
1317 end;
1318 end
1319 else
1320 Retvar := false;
1321
1322 Result := Retvar;
1323end;
1324
1325// =========================
1326// Field Get Routines
1327// =========================
1328
1329function TCdoMapiSession.AsString(const ItemOle: Olevariant;
1330 const FieldIdConstant: DWORD): string;
1331var
1332 Retvar: string;
1333begin
1334 if FConnected then
1335 begin
1336 // Special case for EMail Address - Resolve to normal form
1337 if FieldIdConstant = CdoPR_EMAIL_AT_ADDRESS then
1338 begin
1339 try
1340 RetVar := ItemOle.Fields[CdoPR_EMAIL_AT_ADDRESS];
1341 except
1342 try
1343 Retvar := ItemOle.Fields[CdoPR_EMAIL_ADDRESS];
1344 except
1345 on E: Exception do
1346 begin
1347 FLastError := E.message;
1348 FLastErrorCode := CdoE_INVALID_OBJECT;
1349 Retvar := '';
1350 end;
1351 end;
1352 end;
1353 end
1354 else
1355 begin
1356 try
1357 RetVar := ItemOle.Fields[FieldIdConstant];
1358 except
1359 on E: Exception do
1360 begin
1361 FLastError := E.message;
1362 FLastErrorCode := CdoE_INVALID_OBJECT;
1363 Retvar := '';
1364 end;
1365 end;
1366 end;
1367 end
1368 else
1369 Retvar := '';
1370
1371 Result := Retvar;
1372end;
1373
1374// ================================================
1375// Load EMail folders Messages into a TTreeView
1376// Allocations in Nodes are freed at each call to
1377// LoadEMailTree, but you are responsible to call
1378// CdoDisposeNodes or dispose of the allocations
1379// yourself at Application end
1380// ================================================
1381
1382function TCdoMapiSession.LoadEMailTree(TV: TTreeView;
1383 Expand1stLevel: boolean = false;
1384 SubjectMask: string = ''): boolean;
1385var
1386 DocPtr: TOleVarPtr;
1387 Item: OleVariant;
1388 TN, RN, XN: TTreeNode;
1389 Retvar,
1390 Images: boolean;
1391
1392 procedure AddTree(const Name: string; Folder: Olevariant);
1393 begin
1394 if First(Folder, Item) then
1395 begin
1396 TN := TV.Items.AddChildObject(RN, Name, nil);
1397 if Images then
1398 begin
1399 TN.ImageIndex := 0;
1400 TN.SelectedIndex := 0;
1401 end;
1402
1403 while true do
1404 begin
1405 if (SubjectMask = '') or (MatchesMask(Item.Subject, SubjectMask)) then
1406 begin
1407 New(DocPtr);
1408 DocPtr^ := Item;
1409 if Item.Subject = '' then
1410 XN := TV.Items.AddChildObject(TN, '<No Subject> - ' + Item.Sender.Name,
1411 DocPtr)
1412 else
1413 XN := TV.Items.AddChildObject(TN, Item.Subject, DocPtr);
1414
1415 if Images then
1416 begin
1417 XN.ImageIndex := 1;
1418 XN.SelectedIndex := 1;
1419 end;
1420 end;
1421
1422 if not Next(Folder, Item) then
1423 break;
1424 end;
1425 end;
1426 end;
1427
1428begin
1429 Retvar := false;
1430
1431 if FConnected then
1432 begin
1433 Screen.Cursor := crHourGlass;
1434 Application.ProcessMessages;
1435 CdoDisposeNodes(TV.Items);
1436 TV.Items.Clear;
1437 TV.Items.BeginUpdate;
1438 TN := nil;
1439 RN := nil;
1440 RN := TV.Items.AddObject(RN, 'Personal Folders', nil);
1441 Images := (TV.Images <> nil) and (TV.Images.Count >= 2);
1442 if Images then
1443 begin
1444 RN.ImageIndex := 0;
1445 RN.SelectedIndex := 0;
1446 end;
1447
1448 try
1449 AddTree('Inbox', InBox);
1450 AddTree('Outbox', OutBox);
1451 AddTree('Sent Items', SentItems);
1452 AddTree('Deleted Items', DeletedItems);
1453 Retvar := true;
1454 except
1455 on E: Exception do
1456 begin
1457 FLastError := E.message;
1458 FLastErrorCode := CdoE_CALL_FAILED;
1459 end;
1460 end;
1461
1462 if Expand1stLevel then
1463 TV.Items[0].Expand(false);
1464 TV.Items.EndUpdate;
1465 Screen.Cursor := crDefault;
1466 Item := Unassigned;
1467 Screen.Cursor := crDefault;
1468 end;
1469
1470 Result := Retvar;
1471end;
1472
1473// =============================================================
1474// Load Contact list into a TStringList
1475// Allocations in Objects are freed at each call to
1476// LoadEMailTree, but you are responsible to call
1477// CdoDisposeObjects or dispose of the allocations yourself at
1478// Application end.
1479//
1480// Format "[LastName FirstName]EMailAddress"
1481// ===============================================================
1482
1483function TCdoMapiSession.LoadContactList(const FolderOle: OleVariant;
1484 Items: TStrings): boolean;
1485var
1486 ContactPtr: TOleVarPtr;
1487 Contact: OleVariant;
1488 AddrType,
1489 FullName,
1490 LastName, FirstName, Email: string;
1491 Retvar: boolean;
1492begin
1493 Retvar := false;
1494
1495 if FConnected then
1496 begin
1497 Screen.Cursor := crHourGlass;
1498 Application.ProcessMessages;
1499 CdoDisposeObjects(Items);
1500 Items.Clear;
1501 Items.BeginUpdate;
1502
1503 try
1504 if First(FolderOle, Contact) then
1505 begin
1506 while true do
1507 begin
1508 LastName := trim(AsString(Contact, CdoPR_SURNAME));
1509 FirstName := trim(AsString(Contact, CdoPR_GIVEN_NAME));
1510 EMail := AsString(Contact, CdoPR_EMAIL_AT_ADDRESS);
1511 AddrType := AsString(Contact, CdoPR_ADDRTYPE);
1512
1513 if (EMail <> '') and (AddrType <> 'FAX') then
1514 begin
1515 New(ContactPtr);
1516 ContactPtr^ := Contact;
1517 FullName := trim(LastName + ' ' + FirstName);
1518 Items.AddObject('[' + FullName + ']' + EMail, TObject(ContactPtr));
1519 end;
1520
1521 if not Next(FolderOle, Contact) then
1522 break;
1523 end;
1524
1525 Retvar := true;
1526 end;
1527 except
1528 on E: Exception do
1529 begin
1530 FLastError := E.message;
1531 FLastErrorCode := CdoE_CALL_FAILED;
1532 end;
1533 end;
1534
1535 Items.EndUpdate;
1536 Contact := Unassigned;
1537 Screen.Cursor := crDefault;
1538 end;
1539
1540 Result := Retvar;
1541end;
1542
1543function TCdoMapiSession.LoadContactList(const FolderName: string;
1544 Items: TStrings): boolean;
1545var
1546 Contacts: OleVariant;
1547 Retvar: boolean;
1548begin
1549 Retvar := false;
1550
1551 if FConnected then
1552 begin
1553 try
1554 Contacts := FOleSession.AddressLists[FolderName].AddressEntries;
1555 if not CdoNothing(Contacts) then
1556 begin
1557 Retvar := LoadContactList(Contacts, Items);
1558 end;
1559 Contacts := Unassigned;
1560 except
1561 on E: Exception do
1562 begin
1563 CdoDisposeObjects(Items);
1564 Items.Clear;
1565 FLastError := E.message;
1566 FLastErrorCode := CdoE_CALL_FAILED;
1567 end;
1568 end;
1569 end;
1570
1571 Result := Retvar;
1572end;
1573
1574// =============================================================
1575// Load Folder list into a TList
1576// Allocations in Objects are freed at each call to
1577// LoadObjectList, but you are responsible to call
1578// CdoDisposeList or dispose of the allocations yourself at
1579// Application end.
1580// ===============================================================
1581
1582function TCdoMapiSession.LoadObjectList(const FolderOle: OleVariant;
1583 List: TList): boolean;
1584var
1585 ItemPtr: TOleVarPtr;
1586 Item: OleVariant;
1587 Retvar: boolean;
1588begin
1589 Retvar := false;
1590
1591 if FConnected then
1592 begin
1593 Screen.Cursor := crHourGlass;
1594 Application.ProcessMessages;
1595 CdoDisposeList(List);
1596 List.Clear;
1597
1598 try
1599 if First(FolderOle, Item) then
1600 begin
1601 while true do
1602 begin
1603 New(ItemPtr);
1604 ItemPtr^ := Item;
1605 List.Add(ItemPtr);
1606
1607 if not Next(FolderOle, Item) then
1608 break;
1609 end;
1610 end;
1611 except
1612 on E: Exception do
1613 begin
1614 CdoDisposeList(List);
1615 List.Clear;
1616 FLastError := E.message;
1617 FLastErrorCode := CdoE_CALL_FAILED;
1618 end;
1619 end;
1620
1621 Item := Unassigned;
1622 Screen.Cursor := crDefault;
1623 end;
1624
1625 Result := Retvar;
1626end;
1627
1628// =================================================================
1629// The CDO method Details() gives an error if cancel is pressed
1630// =================================================================
1631
1632procedure TCdoMapiSession.ShowContactDetails(Contact: OleVariant);
1633begin
1634 if not CdoNothing(Contact) then
1635 try
1636 Contact.Details(Application.Handle);
1637 except
1638 // Not interested - either a dialog appears or not
1639 end;
1640end;
1641
1642end.
|
