Development

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;