function WhoIm(lpSession:IMAPISession;
out lppCurrentObject:IMAPIProp):HRESULT;
(*
The function retrieves a MAPI IMAPIProp interface
for the current session object.
Parameters
lpSession - Input parameter. Points to a MAPI IMAPISession interface containing the MAPI session.
lppCurrentObject - Output parameter. Points to a MAPI IMAPIProp interface containing the current object.
*)
var
hr:HRESULT; //hr= NOERROR;
cbSessionEntryID:ULONG; //cbSessionEntryID = 0;
pSessionEntryID:PENTRYID; //pSessionEntryID = NULL;
pCurrentObjectInterface:IMAPIPROP; //pCurrentObjectInterface = NULL;
ulObjType :ULONG; //= 0;
lppMAPIError:pMAPIError;
label cleanup;
begin
lppMAPIError:=nil;
cbSessionEntryID:=0;
pSessionEntryID:=nil;
pCurrentObjectInterface:=nil;
// Get the entry ID for the session.
(*
The IMAPISession.QueryIdentity method returns the entry identifier of the object that provides the primary identity
for the session.
Parameters
cbSessionEntryID - [out] Pointer to the count of bytes in the entry identifier pointed to by the lppEntryID parameter.
pSessionEntryID - [out] Pointer to a pointer to the entry identifier of the object providing the primary identity.
*)
hr := lpSession.QueryIdentity(cbSessionEntryID,pSessionEntryID);
if hr<>S_OK then
begin
(*
The IMAPISession.GetLastError method returns
a MAPIERROR structure containing information
about the previous session error.
*)
lpSession.GetLastError(hr,0,lppMAPIError);
if Assigned(lppMapiError) then
begin
if Assigned(lppMapiError.lpszError) then
EMAPILogger.LogMessage(String(lppMapiError.lpszError));
end
else
EMAPILogger.LogMessage('MAPI can''t Query Identity.');
lppMAPIError:=nil;
goto cleanup;
end;
// Open the entry ID and get an IMAPIProp interface.
ulObjType := 0;
hr := lpSession.OpenEntry(cbSessionEntryID,
pSessionEntryID,
IID_IMAPIProp,
MAPI_MODIFY or
MAPI_BEST_ACCESS or
MAPI_DEFERRED_ERRORS,
ulObjType,
IUNKNOWN(pCurrentObjectInterface));
if hr<>S_OK then
begin
.....
goto cleanup;
end;
// Everything was successful, so return the
user interface to the caller.
lppCurrentObject := pCurrentObjectInterface;
cleanup:
if hr<>S_OK then
begin
pCurrentObjectInterface:=nil;
lppCurrentObject := Nil;
end;
if Assigned(pSessionEntryID) then MAPIFREEBUFFER(pSessionEntryID);
result :=hr;
end;
We will create CustomForm passing lppCurrentObject as param.
fmClientPr:=TfmClientPr.Create(nil,lppCurrentObject);
unit unClientFm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls,ImgList, Mask, ExtendedMAPI;
type
TfmClientPr = class(TForm)
Panel1: TPanel;
btCancel: TButton;
btOK: TButton;
btApply: TButton;
....
....
... etc..
private
FMailBox:IMAPIProp;
lPropTagArray:PSPropTagArray;
lPSPropValue:PSPropValueArray;
lppMAPIERRORS:pMAPIERROR;
procedure GetMAPIProp(ActivePage: Integer);
procedure RetrieveMAPIProp(TagArray:PSPropTagArray;ActivePage: Integer);
procedure ShowMAPIError(Value:HRESULT);
procedure UpdateMAPI;
public
constructor Create(AOwner:TComponent;Mailbox:IMAPIProp);reintroduce; overload;
end;
var
fmClientPr: TfmClientPr;
procedure InitializeGeneralPageArray;
implementation
const PR_EMS_AB_HOME_MTA = $8007001E;
{$R *.DFM}
type
MItemProp = record
PropID : ULONG;
Changed:Bool;
Value:String;
end;
var InChange:bool;
var GeneralPage : Array [0..11] of MItemProp;
constructor TfmClientPr.Create(AOwner:TComponent;Mailbox:IMAPIProp);
begin
inherited Create(AOwner);
MAPIInitialize(nil);
btApply.Enabled:=False;
FMailBox:=Mailbox;
lPropTagArray:=nil;
lPSPropValue:=nil;
lppMAPIERRORS:=nil;
pcInfo.ActivePage:=tsGeneral;
InChange:=True;
GetMAPIProp(pcInfo.ActivePage.TabIndex);
self.Caption := ebDisplayName.Text + ' Properies';
InChange:=False;
end;
procedure TfmClientPr.GetMAPIProp(ActivePage: Integer);
var
cProp:ULONG;
begin
if Assigned(lPropTagArray) then MAPIFreeBuffer(lPropTagArray);
lPropTagArray:=nil;
cProp:=19;
MAPIAllocateBuffer(SizeOf(TSPropTagArray)+ SizeOf(ULONG)*(cProp-1),Pointer(lPropTagArray));
lPropTagArray.cValues:=cProp;
cProp:=0;
lPropTagArray.aulPropTag[cProp]:=PR_DISPLAY_NAME;
lPropTagArray.aulPropTag[cProp+1]:=PR_GIVEN_NAME;
lPropTagArray.aulPropTag[cProp+2]:=PR_INITIALS;
lPropTagArray.aulPropTag[cProp+3]:=PR_SURNAME;
lPropTagArray.aulPropTag[cProp+4]:=PR_ACCOUNT;
lPropTagArray.aulPropTag[cProp+5]:=PR_STREET_ADDRESS; //ADRESS
lPropTagArray.aulPropTag[cProp+6]:=PR_LOCALITY; //CITY
lPropTagArray.aulPropTag[cProp+7]:=PR_STATE_OR_PROVINCE;
lPropTagArray.aulPropTag[cProp+8]:=PR_POSTAL_CODE;
lPropTagArray.aulPropTag[cProp+9]:=PR_COUNTRY;
lPropTagArray.aulPropTag[cProp+10]:=PR_TITLE;
lPropTagArray.aulPropTag[cProp+11]:=PR_COMPANY_NAME;
lPropTagArray.aulPropTag[cProp+12]:=PR_DEPARTMENT_NAME;
lPropTagArray.aulPropTag[cProp+13]:=PR_OFFICE_LOCATION;
lPropTagArray.aulPropTag[cProp+14]:=PR_ASSISTANT;
lPropTagArray.aulPropTag[cProp+15]:=PR_BUSINESS_TELEPHONE_NUMBER;
lPropTagArray.aulPropTag[cProp+16]:=PR_CREATION_TIME;
lPropTagArray.aulPropTag[cProp+17]:=PR_LAST_MODIFICATION_TIME;
lPropTagArray.aulPropTag[cProp+18]:=PR_EMS_AB_HOME_MTA;
RetrieveMAPIProp(lPropTagArray,ActivePage);
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 11 do GeneralPage[I].Changed :=False;
end;
procedure TfmClientPr.RetrieveMAPIProp(TagArray:PSPropTagArray;ActivePage: Integer);
var
hr:HRESULT;
cCount,cValues:ULONG;
begin
if Assigned(lPSPropValue) then MAPIFreeBuffer(lPSPropValue);
lPSPropValue:=nil;
hr:=FMailBox.GetProps(TagArray,0,cValues,lPSPropValue);
if failed(hr) then
begin
ShowMAPIError(hr);
exit;
end;
cCount:=0;
case ActivePage of
0: begin
if lPSPropValue[cCount].ulPropTag =PR_DISPLAY_NAME then
lbAccount.Caption := lPSPropValue[cCount].Value.lpsza;
ebDisplayName.Text := lbAccount.Caption;
if lPSPropValue[cCount+1].ulPropTag =PR_GIVEN_NAME then
ebGivenName.Text:=lPSPropValue[cCount+1].Value.lpsza;
if lPSPropValue[cCount+2].ulPropTag = PR_INITIALS then
ebInitials.Text:=lPSPropValue[cCount+2].Value.lpsza;
...
...etc...
...
if lPSPropValue[cCount+17].ulPropTag = PR_LAST_MODIFICATION_TIME then
lbWhentModified.Caption :=PT_SYSTIME2V(lPSPropValue[cCount+17].Value);
if lPSPropValue[cCount+18].ulPropTag = PR_EMS_AB_HOME_MTA then
begin
lbhServer.Caption :=GetServerN(lPSPropValue[cCount+18].Value.lpsza);
lbhSite.Caption :=GetSiteN(lPSPropValue[cCount+18].Value.lpsza);
end;
end;
end;
end;
procedure TfmClientPr.btOKClick(Sender: TObject);
begin
if btApply.Enabled then UpdateMAPI;
ModalResult:=mrOK;
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
lPSPropValueForUpdate:PSPropValueArray;
pProblems : PSPropProblemArray;
hr:HRESULT;
i,cCount,cCountUpd:Integer;
begin
cCount:=0;
for I:=0 to High(GeneralPage) do
if GeneralPage[I].Changed then
Inc(cCount);
if cCount>0 then
begin
lPSPropValueForUpdate:=nil;
MAPIAllocateBuffer(SizeOf(TSPropValueArray)+SizeOf(TSPropValue)*(cCount-1),Pointer(lPSPropValueForUpdate));
cCountUpd:=0;
for I:=0 to High(GeneralPage) do
if GeneralPage[I].Changed then
begin
lPSPropValueForUpdate[cCountUpd].ulPropTag:=GeneralPage[I].PropID;
lPSPropValueForUpdate[cCountUpd].Value.lpszA:=PCHAR(GeneralPage[I].Value);
Inc(cCountUpd);
end;
pProblems:=nil;
hr:=FMailBox.SetProps(cCount,PSPropValue(lPSPropValueForUpdate),pProblems);
if failed(hr) then ShowMapiError(hr)
else
begin
hr:=FMailBox.SaveChanges(0);
if failed(hr) then ShowMapiError(hr)
else
ShowMessage('Mailbox is UPDATED!');
end;
if Assigned(pProblems) then MAPIFreeBuffer(pProblems);
if Assigned(lPSPropValueForUpdate) then MAPIFreeBuffer(lPSPropValueForUpdate);
end;
btApply.Enabled:=False;
end;
...
...etc...
...
end.