Development

unit unClientFm;

interface
{$I IMI.INC}

uses
  Classes, Forms, ComCtrls, ExtCtrls, ExtendedMAPI, StdCtrls, URLLabel,
  Controls, Graphics;

type
  TfmClientPr = class(TForm)
    Panel1: TPanel;
    btCancel: TButton;
    btOK: TButton;
    btApply: TButton;
    pcInfo: TPageControl;
    tsGeneral: TTabSheet;
    Panel2: TPanel;
    lbAddress: TLabel;
    lbCity: TLabel;
    lbState: TLabel;
    lbTitle: TLabel;
    lbDepartment: TLabel;
    lbCompany: TLabel;
    lbOffice: TLabel;
    lbAssistant: TLabel;
    lbZipCode: TLabel;
    lbCountry: TLabel;
    lbPhone: TLabel;
    lbHomeServer: TLabel;
    lbHomeSite: TLabel;
    lbWhenCreated: TLabel;
    lbWhentModified: TLabel;
    Bevel1: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    lbAccount: TLabel;
    lbhServer: TLabel;
    Label5: TLabel;
    gbName: TGroupBox;
    lbFirst: TLabel;
    lbInitials: TLabel;
    lbLast: TLabel;
    lbDisplay: TLabel;
    lbAlias: TLabel;
    ebGivenName: TEdit;
    ebInitials: TEdit;
    ebSurname: TEdit;
    ebDisplayName: TEdit;
    ebMailNickname: TEdit;
    memoAddress: TMemo;
    ebLocalityName: TEdit;
    ebStateOrProvinceName: TEdit;
    ebTitle: TEdit;
    ebCompany: TEdit;
    ebDepartment: TEdit;
    ebPhysicalDeliveryOfficeName: TEdit;
    ebAssistantName: TEdit;
    ebPostalCode: TEdit;
    ebTextCountry: TEdit;
    ebTelephoneOffice1: TEdit;
    lbhSite: TLabel;
    procedure btOKClick(Sender: TObject);
    procedure btCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pcInfoChange(Sender: TObject);
    procedure ChangeMAPIValue(Sender: TObject);
    procedure btApplyClick(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
  private
    { Private declarations }
    FMailBox: IMAPIProp;
    FUserPropTagArray: PSPropTagArray;
    FUserPropValue: PSPropValue;
    hr: HRESULT;
    procedure GetMAPIProp(ActivePage: integer);
    procedure RetrieveMAPIProp(TagArray: PSPropTagArray; ActivePage: integer);
    procedure ShowMAPIError(Value: HRESULT);
    procedure UpdateMAPI;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent; const Mailbox: IMAPIProp); reintroduce;
  end;

var
  fmClientPr: TfmClientPr;

procedure InitializeGeneralPageArray;

implementation

uses
{$IFDEF DELPHI2011XE2}
UITypes,
{$ENDIF}
SysUtils, Windows, Dialogs, EDK, MAPIUtils, MAPIMacros, MAPIVariantProp;

{$R *.DFM}

type
  TItemProp = record
    PropID: ULONG;
    Changed: Bool;
    Value: String;
  end;

var
  InChange: Bool;
  GeneralPage: array [0 .. 11] of TItemProp;

constructor TfmClientPr.Create(AOwner: TComponent; const Mailbox: IMAPIProp);
begin
  inherited Create(AOwner);
  btApply.Enabled := False;
  FMailBox := Mailbox;
  FUserPropTagArray := nil;
  FUserPropValue := nil;
  lbWhenCreated.Caption := '';
  lbWhentModified.Caption := '';
  lbhSite.Caption := '';
  lbhServer.Caption := '';
  lbAccount.Caption := '';
  pcInfo.ActivePage := tsGeneral;
  InChange := True;
  GetMAPIProp(pcInfo.ActivePage.TabIndex);
  self.Caption := ' ' + ebDisplayName.Text + ' Properies';
  InChange := False;
end;

procedure TfmClientPr.GetMAPIProp(ActivePage: integer);
begin
  if Assigned(FUserPropTagArray) then
    MAPIFreeBuffer(FUserPropTagArray);

  FUserPropTagArray := nil;

  case ActivePage of
    0:
      begin // GENERAL
        InitializeGeneralPageArray;
        hr := SizedSPropTagArray([PR_DISPLAY_NAME, PR_GIVEN_NAME, PR_INITIALS,
          PR_SURNAME, PR_ACCOUNT, PR_STREET_ADDRESS, PR_LOCALITY,
          PR_STATE_OR_PROVINCE, PR_POSTAL_CODE, PR_COUNTRY, PR_TITLE,
          PR_COMPANY_NAME, PR_DEPARTMENT_NAME, PR_OFFICE_LOCATION, PR_ASSISTANT,
          PR_BUSINESS_TELEPHONE_NUMBER, PR_CREATION_TIME,
          PR_LAST_MODIFICATION_TIME, PR_EMS_AB_HOME_MTA], FUserPropTagArray);
        if Failed(hr) then
          raise Exception.Create('MAPI Memory Error!');
        RetrieveMAPIProp(FUserPropTagArray, ActivePage);
      end;
  end;

  if Assigned(FUserPropTagArray) then
    MAPIFreeBuffer(FUserPropTagArray);
  FUserPropTagArray := nil;
end;

procedure InitializeGeneralPageArray;
var
  I: integer;
begin
  GeneralPage[0].PropID := PR_INITIALS;
  GeneralPage[1].PropID := PR_STREET_ADDRESS;
  GeneralPage[2].PropID := PR_LOCALITY;
  GeneralPage[3].PropID := PR_STATE_OR_PROVINCE;
  GeneralPage[4].PropID := PR_POSTAL_CODE;
  GeneralPage[5].PropID := PR_COUNTRY;
  GeneralPage[6].PropID := PR_TITLE;
  GeneralPage[7].PropID := PR_COMPANY_NAME;
  GeneralPage[8].PropID := PR_DEPARTMENT_NAME;
  GeneralPage[9].PropID := PR_OFFICE_LOCATION;
  GeneralPage[10].PropID := PR_ASSISTANT;
  GeneralPage[11].PropID := PR_BUSINESS_TELEPHONE_NUMBER;

  for I := 0 to High(GeneralPage) do
    GeneralPage[I].Changed := False;
end;

procedure TfmClientPr.RetrieveMAPIProp(TagArray: PSPropTagArray;
  ActivePage: integer);
var
  cCount, cValues: ULONG;
begin
  if Assigned(FUserPropValue) then
    MAPIFreeBuffer(FUserPropValue);
  FUserPropValue := nil;
  hr := FMailBox.GetProps(TagArray, fMapiUnicode, cValues, FUserPropValue);

  if Failed(hr) or (FUserPropValue = nil) then
  begin
    ShowMAPIError(hr);
    exit;
  end;

  if (cValues > 0) and Assigned(FUserPropValue) then
    case ActivePage of
      0:
        for cCount := 0 to cValues - 1 do
          case PSPropValueArray(FUserPropValue)[cCount].ulPropTag of
            PR_DISPLAY_NAME:
              begin
                lbAccount.Caption := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
                ebDisplayName.Text := lbAccount.Caption;
              end;
            PR_GIVEN_NAME:
              ebGivenName.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_INITIALS:
              ebInitials.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_SURNAME:
              ebSurname.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_ACCOUNT:
              ebMailNickname.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_STREET_ADDRESS:
              memoAddress.Lines.Add(PSPropValueArray(FUserPropValue)[cCount].Value.lpsz);
            PR_LOCALITY:
              ebLocalityName.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_STATE_OR_PROVINCE:
              ebStateOrProvinceName.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_POSTAL_CODE:
              ebPostalCode.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_COUNTRY:
              ebTextCountry.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_TITLE:
              ebTitle.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_COMPANY_NAME:
              ebCompany.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_DEPARTMENT_NAME:
              ebDepartment.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_OFFICE_LOCATION:
              ebPhysicalDeliveryOfficeName.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_ASSISTANT:
              ebAssistantName.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_BUSINESS_TELEPHONE_NUMBER:
              ebTelephoneOffice1.Text := PSPropValueArray(FUserPropValue)[cCount].Value.lpsz;
            PR_CREATION_TIME:
              lbWhenCreated.Caption := ConvertMAPIPropValueToVariant(@PSPropValueArray(FUserPropValue)[cCount]);
            PR_LAST_MODIFICATION_TIME:
              lbWhentModified.Caption := ConvertMAPIPropValueToVariant(@PSPropValueArray(FUserPropValue)[cCount]);
            PR_EMS_AB_HOME_MTA:
              begin
                lbhServer.Caption :=
                  GetExchServerName(PSPropValueArray(FUserPropValue)[cCount].Value.lpsz);
                lbhSite.Caption :=
                  GetExchSiteName(PSPropValueArray(FUserPropValue)[cCount].Value.lpsz);
              end;
          end;
    end;

  if Assigned(FUserPropValue) then
    MAPIFreeBuffer(FUserPropValue);
  FUserPropValue := nil;

  if lbhServer.Caption = '~~' then    //   PR_EMS_AB_HOME_MTA IS OBSOLETE AFTER EXCHANGE 2007
  begin
    MessageDlg('You do not have connection to' + #13#10 +
      'Microsoft Exchange Server', mtInformation, [mbOK], 0);
    ModalResult := mrOk;
    abort;
  end;
end;

procedure TfmClientPr.ShowMAPIError(Value: HRESULT);
begin
  MessageDlg(GetMAPIError(FMailBox, Value), mtError, [mbOK], 0);
end;

procedure TfmClientPr.btOKClick(Sender: TObject);
begin
  if btApply.Enabled then
    UpdateMAPI;
  ModalResult := mrOk;
end;

procedure TfmClientPr.btCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfmClientPr.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(FUserPropTagArray) then
    MAPIFreeBuffer(FUserPropTagArray);
  if Assigned(FUserPropValue) then
    MAPIFreeBuffer(FUserPropValue);
  FUserPropTagArray := nil;
  FUserPropValue := nil;
end;

procedure TfmClientPr.pcInfoChange(Sender: TObject);
begin
  InChange := True;
  btApply.Enabled := False;
  GetMAPIProp(pcInfo.ActivePage.TabIndex);
  InChange := False;
end;

procedure TfmClientPr.ChangeMAPIValue(Sender: TObject);
begin
  if ((InChange = False) and (TCustomEdit(Sender).Modified)) then
  begin
    GeneralPage[TComponent(Sender).Tag].Changed := True;
    GeneralPage[TComponent(Sender).Tag].Value := TCustomEdit(Sender).Text;
    btApply.Enabled := True;
  end;
end;

procedure TfmClientPr.btApplyClick(Sender: TObject);
begin
  UpdateMAPI;
end;

procedure TfmClientPr.UpdateMAPI;
var
  PropValueForUpdate: PSPropValue;
  iCount, cCount, cCountUpd: integer;
begin
  cCount := 0;
  for iCount := 0 to High(GeneralPage) do
    if GeneralPage[iCount].Changed then
      Inc(cCount);

  if cCount > 0 then
  begin
    PropValueForUpdate := nil;
    MAPIAllocateBuffer(SizeOf(TSPropValue) * cCount, Pointer(PropValueForUpdate));
    cCountUpd := 0;

    (*
      Here we will use a small trick.
      When the field's value is empty, i.e. we have EmptyStr, and we update the attributes,
      MAPI will decide that we want to erase this attribute, rather than update it.
      This is reasonable, because if an attribute does not have any value,
      this should mean that we do not need it.
      Because we DO NOT HAVE rights to ERASE, an error will be generated that will
      notify us that we do not have rights.
      Because of this we will try to CHEAT by typing a space.
      This is not right, data is distorted, however it will work for the purpose of our example.
      Otherwise we will have to assign special rights to an even lower level for each user.
    *)

    for iCount := 0 to High(GeneralPage) do
      if GeneralPage[iCount].Changed then
      begin
        PSPropValueArray(PropValueForUpdate)[cCountUpd].ulPropTag :=
          GeneralPage[iCount].PropID;

        if GeneralPage[iCount].Value <> '' then
          PSPropValueArray(PropValueForUpdate)[cCountUpd].Value.lpsz :=
            PChar(GeneralPage[iCount].Value)
        else
          PSPropValueArray(PropValueForUpdate)[cCountUpd].Value.lpsz := ' ';

        PSPropValueArray(PropValueForUpdate)[cCountUpd].dwAlignPad := 0;
        Inc(cCountUpd);
      end;

    hr := FMailBox.SetProps(cCountUpd, PropValueForUpdate, PSPropProblemArray(nil^));

    if Failed(hr) then
      ShowMAPIError(hr)
    else
    begin
      hr := FMailBox.SaveChanges(KEEP_OPEN_READWRITE);
      if Failed(hr) then
        ShowMAPIError(hr)
      else
        ShowMessage('The Mailbox is Updated!');
    end;

    if Assigned(PropValueForUpdate) then
      MAPIFreeBuffer(PropValueForUpdate);
    PropValueForUpdate := nil;
  end;

  btApply.Enabled := False;
end;

procedure TfmClientPr.Panel2Click(Sender: TObject);
begin
  fmClientPr.ActiveControl := Panel2;
end;

end.