Request # 27
How to Open another person’s Contact folder and post a Contact item?
This example requires you to use a Microsoft Exchange account.
The ability to open another person’s folder, and whether or not you can change it, is controlled by the owner of the folder.
Code sign:
function CreateOneOffContact(const DisplayName, AdrType, Address: WideString): TBytes;
type
TContactEID = packed record
abFlags: array [0 .. 3] of Byte; // 0-3
uidResource: array [0 .. 15] of Byte; // 4-19
ulBitMask: ULONG; // 20-23
end;
PContactEID = ^TContactEID;
var
len, indx: Integer;
begin
Result := nil;
if (Trim(DisplayName) = '') or (Trim(AdrType) = '') or (Trim(Address) = '') then
Exit;
len := 0;
indx := SizeOf(TContactEID);
Inc(len, (Length(DisplayName) + 1) * SizeOf(WideChar));
Inc(len, (Length(AdrType) + 1) * SizeOf(WideChar));
Inc(len, (Length(Address) + 1) * SizeOf(WideChar));
Inc(len, indx);
SetLength(Result, len);
ZeroMemory(@Result[0], len);
CopyMemory(@Result[4], @MAPI_ONE_OFF_UID, 16);
PContactEID(@Result[20]).ulBitMask := MAPI_UNICODE or
OOP_DONT_LOOKUP or
MAPI_SEND_NO_RICH_INFO or
ENCODING_PREFERENCE or
ENCODING_MIME or
BODY_ENCODING_TEXT_AND_HTML;
len := Length(DisplayName) * SizeOf(WideChar);
Move(DisplayName[1], Result[indx], len);
Inc(indx, len + SizeOf(WideChar));
len := Length(AdrType) * SizeOf(WideChar);
Move(AdrType[1], Result[indx], len);
Inc(indx, len + SizeOf(WideChar));
len := Length(Address) * SizeOf(WideChar);
Move(Address[1], Result[indx], len);
end;
function AddContactItem(const ContactFolder: IMAPIFolder; // Default Contact Folder
const FullName, // PR_DISPLAY_NAME, PR_SUBJECT
GivenName, // PR_GIVEN_NAME
MiddleName, // PR_MIDDLE_NAME
SurName, // PR_SURNAME
Initials, // PR_INITIALS
FileUnder, // idFileUnder
EmailDisplayName, // idEmail1DisplayName
EmailAddressType, // idEmail1AddressType
EmailAddress, // idEmail1EmailAddress
EmailOriginalDisplayName, // idEmail1OriginalDisplayName
Company, // PR_COMPANY_NAME
BusinessStreet, // idWorkAddressStreet, PR_STREET_ADDRESS
BusinessCity, // idWorkAddressCity, PR_LOCALITY
BusinessState, // idWorkAddressState, PR_STATE_OR_PROVINCE
BusinessPostalCode, // idWorkAddressPostalCode, PR_POSTAL_CODE
BusinessCountry, // idWorkAddressCountry, PR_COUNTRY
BusinessCountryCode, // idWorkAddressCountryCode, idAddressCountryCode
BusinessPhone, // PR_BUSINESS_TELEPHONE_NUMBER
URL, // idHtml, PR_BUSINESS_HOME_PAGE
Notes // PR_BODY
: WideString): Boolean;
var
ContactItem: IMessage;
FileUnderArray, ProviderEmailArray, ContactItemDataArray: TIntegerDynArray;
OneOfEntryID: TBytes;
hr: HRESULT;
const
FileUnderList: array [0 .. 4] of Integer = ($00008017, // Surname, Given Middle
$00008037, // Given Middle Surname Generation
$00003A16, // Company Name (PR_COMPANY_NAME)
$00008019, // Surname, Given Middle$13$10Company Name
$00008018 // Company Name$13$10Surname, Given Middle
);
ContactItemDataList: array [0 .. 5] of Integer = ($00000002, // Display work address
$00008080, // Display Email 1 (idEmail1DisplayName)
$3A08, // Display Business Telephone (PR_BUSINESS_TELEPHONE_NUMBER)
$3A09, // Display Home Telephone (PR_HOME_TELEPHONE_NUMBER)
$3A24, // Display Business Fax (PR_BUSINESS_FAX_NUMBER)
$3A1C // Display Mobile Telephone (PR_MOBILE_TELEPHONE_NUMBER)
);
begin
Result := False;
OneOfEntryID := nil;
// Check input parameters
if not Assigned(ContactFolder) then
raise Exception.Create('not Assigned(ContactFolder)');
if Trim(FileUnder) = '' then
raise Exception.Create('not defined (FileUnder)');
if Trim(EmailDisplayName) = '' then
raise Exception.Create('not defined (EmailDisplayName)');
if Trim(EmailAddressType) = '' then
raise Exception.Create('not defined (EmailAddressType)');
if Trim(EmailAddress) = '' then
raise Exception.Create('not defined (EmailAddress)');
if Trim(EmailOriginalDisplayName) = '' then
raise Exception.Create('not defined (EmailOriginalDisplayName)');
// Create a message. This will set also PR_MESSAGE_CLASS
ContactItem := CreateMapiMessage(ContactFolder, oContact);
if not Assigned(ContactItem) then
Exit;
try
// Set FileUnderList
SetLength(FileUnderArray, Length(FileUnderList));
Move(FileUnderList[0], FileUnderArray[0], Length(FileUnderList) * SizeOf(Integer));
SetNamedPropLongMV(ContactItem,
OutlookAddressNamedProp[idFileUnderList].GUID_ID^,
OutlookAddressNamedProp[idFileUnderList].PROP_ID,
FileUnderArray);
// Set Do Not Journal
SetNamedPropBoolean(ContactItem,
OutlookAddressNamedProp[idAutoLog].GUID_ID^,
OutlookAddressNamedProp[idAutoLog].PROP_ID,
False);
// Set Email1 - defined
SetLength(ProviderEmailArray, 1);
ProviderEmailArray[0] := $0000000;
(* PidLidAddressBookProviderEmailList
Value Meaning
0x00000000 Email1 is defined for the contact.
0x00000001 Email2 is defined for the contact.
0x00000002 Email3 is defined for the contact.
0x00000003 Business fax is defined for the contact.
0x00000004 Home fax is defined for the contact.
*)
//PidLidAddressBookProviderEmailList
SetNamedPropLongMV(ContactItem,
OutlookAddressNamedProp[idAddressBookProviderEmailList].GUID_ID^,
OutlookAddressNamedProp[idAddressBookProviderEmailList].PROP_ID,
ProviderEmailArray);
// PidLidAddressBookProviderArrayType
(*
Bit Meaning
0x00000001 Email1 is defined for the contact
0x00000002 Email2 is defined for the contact.
0x00000004 Email3 is defined for the contact.
0x00000008 Business fax is defined for the contact.
0x00000010 Home fax is defined for the contact.
0x00000020 Primary fax is defined for the contact.
*)
SetNamedPropLong(ContactItem,
OutlookAddressNamedProp[idAddressBookProviderArrayType].GUID_ID^,
OutlookAddressNamedProp[idAddressBookProviderArrayType].PROP_ID,
1);
// Set FileUnder
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idFileUnder].GUID_ID^,
OutlookAddressNamedProp[idFileUnder].PROP_ID,
FileUnder);
// Set FileUnderId
SetNamedPropLong(ContactItem,
OutlookAddressNamedProp[idFileUnderId].GUID_ID^,
OutlookAddressNamedProp[idFileUnderId].PROP_ID,
FileUnderList[0]);
// Set Contact CharSet
SetNamedPropLong(ContactItem,
OutlookAddressNamedProp[idContactCharacterSet].GUID_ID^,
OutlookAddressNamedProp[idContactCharacterSet].PROP_ID,
$00000100 // "western" character set
);
// Set EmailDisplayName
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idEmail1DisplayName].GUID_ID^,
OutlookAddressNamedProp[idEmail1DisplayName].PROP_ID,
EmailDisplayName);
// Set EmailAddressType
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idEmail1AddressType].GUID_ID^,
OutlookAddressNamedProp[idEmail1AddressType].PROP_ID,
EmailAddressType);
// Set EmailAddress
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idEmail1EmailAddress].GUID_ID^,
OutlookAddressNamedProp[idEmail1EmailAddress].PROP_ID,
EmailAddress);
// Set EmailOriginalDisplayName
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idEmail1OriginalDisplayName].GUID_ID^,
OutlookAddressNamedProp[idEmail1OriginalDisplayName].PROP_ID,
EmailOriginalDisplayName);
// Set BusinessStreet
if Trim(BusinessStreet) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idWorkAddressStreet].GUID_ID^,
OutlookAddressNamedProp[idWorkAddressStreet].PROP_ID,
BusinessStreet);
// Set BusinessCity
if Trim(BusinessCity) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idWorkAddressCity].GUID_ID^,
OutlookAddressNamedProp[idWorkAddressCity].PROP_ID,
BusinessCity);
// Set State
if Trim(BusinessState) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idWorkAddressState].GUID_ID^,
OutlookAddressNamedProp[idWorkAddressState].PROP_ID,
BusinessState);
// Set BusinessPostalCode
if Trim(BusinessPostalCode) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idWorkAddressPostalCode].GUID_ID^,
OutlookAddressNamedProp[idWorkAddressPostalCode].PROP_ID,
BusinessPostalCode);
// Set BusinessCountry
if Trim(BusinessCountry) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idWorkAddressCountry].GUID_ID^,
OutlookAddressNamedProp[idWorkAddressCountry].PROP_ID,
BusinessCountry);
// Set BusinessCountryCode
if Trim(BusinessCountryCode) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idWorkAddressCountryCode].GUID_ID^,
OutlookAddressNamedProp[idWorkAddressCountryCode].PROP_ID,
BusinessCountryCode);
// Set Postal Address
SetNamedPropLong(ContactItem,
OutlookAddressNamedProp[idPostalAddressId].GUID_ID^,
OutlookAddressNamedProp[idPostalAddressId].PROP_ID,
2 // Work address is mailing address
);
if Trim(BusinessStreet) <> '' then
SetPropString(ContactItem, PR_STREET_ADDRESS_W, BusinessStreet);
if Trim(BusinessCity) <> '' then
SetPropString(ContactItem, PR_LOCALITY_W, BusinessCity);
if Trim(BusinessState) <> '' then
SetPropString(ContactItem, PR_STATE_OR_PROVINCE_W, BusinessState);
if Trim(BusinessPostalCode) <> '' then
SetPropString(ContactItem, PR_POSTAL_CODE_W, BusinessPostalCode);
if Trim(BusinessCountry) <> '' then
SetPropString(ContactItem, PR_COUNTRY_W, BusinessCountry);
if Trim(BusinessCountryCode) <> '' then
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idAddressCountryCode].GUID_ID^,
OutlookAddressNamedProp[idAddressCountryCode].PROP_ID,
BusinessCountryCode);
// Set Display Data
SetLength(ContactItemDataArray, Length(ContactItemDataList));
Move(ContactItemDataList[0], ContactItemDataArray[0], Length(ContactItemDataList) * SizeOf(Integer));
SetNamedPropLongMV(ContactItem,
OutlookAddressNamedProp[idContactItemData].GUID_ID^,
OutlookAddressNamedProp[idContactItemData].PROP_ID,
ContactItemDataArray);
// Set URL
if Trim(URL) <> '' then
begin
SetPropString(ContactItem, PR_BUSINESS_HOME_PAGE_W, URL);
SetNamedPropString(ContactItem,
OutlookAddressNamedProp[idHtml].GUID_ID^,
OutlookAddressNamedProp[idHtml].PROP_ID,
URL);
end;
// Set DISPLAY NAME PREFIX
SetPropString(ContactItem, PR_DISPLAY_NAME_PREFIX_W, '');
// Set SurName
SetPropString(ContactItem, PR_SURNAME_W, SurName);
// Set MiddleName
SetPropString(ContactItem, PR_MIDDLE_NAME_W, MiddleName);
// Set GivenName
SetPropString(ContactItem, PR_GIVEN_NAME_W, GivenName);
// Set GENERATION
SetPropString(ContactItem, PR_GENERATION_W, '');
// Set Initials
SetPropString(ContactItem, PR_INITIALS_W, Initials);
// Set Company
SetPropString(ContactItem, PR_COMPANY_NAME_W, Company);
// Set BusinessPhone
SetPropString(ContactItem, PR_BUSINESS_TELEPHONE_NUMBER_W, BusinessPhone);
// Set FullName
SetPropString(ContactItem, PR_DISPLAY_NAME_W, FullName);
// Set PR_SUBJECT_PREFIX
SetPropString(ContactItem, PR_SUBJECT_PREFIX_W, '');
// Set PR_SUBJECT
SetPropString(ContactItem, PR_SUBJECT_W, FullName);
// Set Notes
SetPropString(ContactItem, PR_BODY_W, Notes);
// set Icon
SetPropLong(ContactItem, PR_ICON_INDEX, 512);
// Set OneOf - idEmail1OriginalEntryID
OneOfEntryID := CreateOneOffContact(EmailDisplayName, UpperCase(EmailAddressType), EmailAddress);
SetNamedPropBinary(ContactItem,
OutlookAddressNamedProp[idEmail1OriginalEntryID].GUID_ID^,
OutlookAddressNamedProp[idEmail1OriginalEntryID].PROP_ID,
Length(OneOfEntryID),
PByte(@OneOfEntryID[0]));
hr := ContactItem.SaveChanges(FORCE_SAVE);
if failed(hr) then
raise EMAPIError.CreateMAPI(ContactItem, hr);
Result := True;
finally
OneOfEntryID := nil;
end;
end;
Download Request #27 as Compiled Application
Download Project (DELPHI 10.4) ZIP file
Source Code: In package
