Development

Request # 24

How to build an address book dialog (Delphi way)?

Code snip:

procedure TfrmDelphiAddressBook.GetAddressBook;
var
  ObjType: ULONG;
  Count: ULONG;
  Rows: PSRowSet;
  iCount: Integer;
  PropValue: PSPRopValue;
const
 TagArray: record
  cValues: ULONG;
  aulPropTag: array [0 .. 3] of ULONG;
 end = (cValues: 4;
        aulPropTag: (PR_ENTRYID, PR_EMS_AB_PARENT_ENTRYID, PR_DEPTH, PR_DISPLAY_NAME));
begin
  if not Assigned(FMAPISession) then
    raise EMAPIError.CreateRes(@rNotSession);

  Rows := nil;

  hr := FMAPISession.OpenAddressBook(Self.Handle, nil, 0, FAddrBook);
  if failed(hr) then
    raise EMAPIError.CreateMAPI(FMAPISession, hr);
  hr := FAddrBook.OpenEntry(0, nil, @IID_IABContainer, MAPI_BEST_ACCESS, ObjType, IUnknown(FRootContainer));
  if failed(hr) then
    raise EMAPIError.CreateMAPI(FAddrBook, hr);
  hr := FRootContainer.GetHierarchyTable(CONVENIENT_DEPTH, FHierarchyTable);
  if failed(hr) then
    raise EMAPIError.CreateMAPI(FRootContainer, hr);
  hr := FHierarchyTable.SetColumns(@TagArray, TBL_BATCH);
  if failed(hr) then
    raise EMAPIError.CreateMAPI(FHierarchyTable, hr);
  hr := FHierarchyTable.GetRowCount(0, Count);
  if failed(hr) then
    raise EMAPIError.CreateMAPI(FHierarchyTable, hr);

  try
    hr := FHierarchyTable.QueryRows(Count, TBL_NOADVANCE, Rows);
    if failed(hr) then
      raise EMAPIError.CreateMAPI(FHierarchyTable, hr);

    SetLength(ABContainers, Rows.cRows);

    for iCount := 0 to Rows.cRows - 1 do
    begin
      PropValue := PpropFindProp(Rows.aRow[iCount].lpProps, Rows.aRow[iCount].cValues, PR_ENTRYID);
      if Assigned(PropValue) then
        ABContainers[iCount].ENTRYID := BinaryToBytes(PropValue.Value.bin);
      PropValue := PpropFindProp(Rows.aRow[iCount].lpProps, Rows.aRow[iCount].cValues, PR_EMS_AB_PARENT_ENTRYID);
      if Assigned(PropValue) then
        ABContainers[iCount].PARENT_ENTRYID := BinaryToBytes(PropValue.Value.bin);
      PropValue := PpropFindProp(Rows.aRow[iCount].lpProps, Rows.aRow[iCount].cValues, PR_DEPTH);
      if Assigned(PropValue) then
        ABContainers[iCount].PR_DEPTH := PropValue.Value.ul;
      PropValue := PpropFindProp(Rows.aRow[iCount].lpProps, Rows.aRow[iCount].cValues, CHANGE_PROP_TYPE(PR_DISPLAY_NAME, PT_UNSPECIFIED));
      if Assigned(PropValue) and (PROP_TYPE(PropValue.ulPropTag) <> PT_ERROR) then
        ABContainers[iCount].DISPLAY_NAME := MAPIUtils.GetPropString(PropValue);
    end;

  finally
    if Assigned(Rows) then
      FreePRows(Rows);
  end;
end;