unit MainUnit;
interface
uses
Forms,
Buttons, Classes, ComCtrls, Controls, ExtCtrls, ExtendedMAPI, StdCtrls;
type
TfrmMain = class (TForm)
plTOP: TPanel;
btLogOn: TSpeedButton;
rgProfile: TRadioGroup;
btLogOff: TSpeedButton;
lwUser: TListView;
procedure FormCreate(Sender: TObject);
procedure btLogOnClick(Sender: TObject);
procedure btLogOffClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FMapiSession: IMAPISession; // MAPI Session variable -> Interface IMAPISession
FUserProp: IMAPIProp; // Current MAPI User -> Interface IMAPIProp
hr: HRESULT; // EDK and MAPI returns HRESULT
procedure NullMAPI;
procedure MAPILocalInit(Flag: cardinal);
procedure MapiInternalLogOff;
procedure ItIsMe;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses Dialogs, EDK, MAPIUtils, MAPIVariantProp, SysUtils
{$IFDEF VER140}, Variants {$ENDIF VER140}, Windows;
{$R *.DFM}
(*This auxiliary function clears the used MAPI interfaces*)
procedure TfrmMAIN.NullMAPI;
begin
FUserProp := nil;
FMapiSession := nil;
end;
procedure TfrmMAIN.MAPILocalInit(Flag: cardinal);
var
ErrorMessage: string; // A variable that will contain a text representation
// of the errors returned by the initialization
MAPIINIT: TMAPIINIT; // MAPI Init Structure
bMapiInit: boolean; // is MAPI initialized???
begin
bMapiInit := False;
(* Extended MAPI is one of the first COM technologies provided by Microsoft.
To use any of the extended MAPI functions and/or interfaces (with very few exceptions),
before we do anything, we should initialize the Extended MAPI subsystem.
For this purpose Microsoft provides the MapiInitialize function.
Through this function MAPI initializes the COM system by calling CoInitializ internally.
The MAPIInitialize function increments the MAPI subsystem reference
count and initializes global data for the MAPI32.DLL.
function MAPIInitialize (lpMapiInit : Pointer) : HResult; stdcall;
Parameters
lpMapiInit : Pointer to TMAPIINIT
TMAPIINIT (MAPIINIT_0)
Members
ulVersion - Integer value representing the version number of the MAPIINIT_0 structure.
The ulVersion member is for future expansion and does not represent
the version of the MAPI interface.
Currently, ulVersion must be set to MAPI_INIT_VERSION.
ulFlags - Bitmask of flags used to control the initialization of the MAPI session.
The following flags can be set:
MAPI_MULTITHREAD_NOTIFICATIONS - MAPI should generate notifications
using a thread dedicated to notification handling rather than
the first thread used to call MAPIInitialize.
MAPI_NT_SERVICE - The caller is running as a Windows NT service.
Callers that are not running as a Windows NT service should not
set this flag; callers that are running as a service must set this flag.
MAPI_NO_COINIT - This flag was added to MAPI in Exchange 5.5 SP1
If CoInitializeEx is called with the COINIT_MULTITHREADED flag
before MAPIInitialize is called, you will get error
$80010106 (E_INVALID_FLAGS or RPC_E_CHANGED_MODE).
To prevent this error, set MAPI_NO_COINIT (value of $8)
in the ulFlags member of the TMAPIINIT structure passed in MAPIInitialize.
MAPI, by default, will try to initialize COM with a call to CoInitialize.
This initializes COM with a single threaded apartment model.
Since COM has already been initialized with a multithreaded model and
the threading model cannot be changed, MAPIInitialize will fail and
return RPC_E_CHANGED_MODE.
If a MAPIINIT_0 structure is passed into MAPIInitialize
with ulFlags set to MAPI_NO_COINIT,
MAPI will assume that COM has already been initialized
and bypass the call to CoInitialize.
Multithreaded clients running under Windows NT or Windows95/98/Me/2000/2003 should set
the MAPI_MULTITHREADED_NOTIFICATIONS flag. If the flag is not set,
notifications are generated on the thread used to make the first call to MAPIInitialize.
*)
try
MAPIINIT.ulVersion := MAPI_INIT_VERSION;
MAPIINIT.ulFlags := 0;
hr := MapiInitialize( @MAPIINIT);
(*
MAPIInitialize does not return any extended error information.
Unlike most other MAPI calls, the meanings of its return values are strictly defined
to correspond to the particular step of the initialization that failed
*)
if failed(hr) then
begin
case hr of
MAPI_E_INVALID_PARAMETER or MAPI_E_UNKNOWN_FLAGS: ErrorMessage :=
'Invalid parameter or flag!';
MAPI_E_TOO_COMPLEX: ErrorMessage :=
'The keys required by MAPI could not be initialized.';
MAPI_E_VERSION: ErrorMessage :=
'The version of OLE installed on the workstation is not compatible with this version of MAPI.';
MAPI_E_SESSION_LIMIT: ErrorMessage :=
'MAPI sets up context specific to the current process.' +
#13 + 'Failures may occur on Win16 if the number of processes exceeds a certain number,' + #13 + 'or on any system if available memory is exhausted.';
MAPI_E_NOT_ENOUGH_RESOURCES: ErrorMessage :=
'Not enough system resources were available to complete the operation.';
MAPI_E_INVALID_OBJECT: ErrorMessage :=
'May fail if system resources are exhausted.';
MAPI_E_NOT_INITIALIZED: ErrorMessage :=
'The MAPI profile provider has encountered an error.';
else ErrorMessage := 'The MAPI Error!'
end;
MessageBox(0, PChar(ErrorMessage), 'MS MAPI Subsystem', MB_OK or MB_ICONERROR);
exit;
end;
(*
The MAPILogonEx function logs a client application on to
a session with the messaging system.
function MAPILogonEx (ulUIParam : ULONG; lpszProfileName : PChar;
lpszPassword : PChar; ulFlags : ULONG;
out lppSession : IMAPISession) : HResult;
Parameters
ulUIParam - [input] Handle to the window to which the logon dialog box is modal.
If no dialog box is displayed during the call, the ulUIParam parameter is ignored.
This parameter can be zero.
lpszProfileName - [input] Pointer to a string (PChar) containing the name of the profile
to use when logging on. This string is limited to 64 characters.
lpszPassword - [input] Pointer to a string (PChar) containing the password of the profile.
The lpszPassword parameter can be NULL whether or not the lpszProfileName
parameter is NULL. This string is limited to 64 characters.
flFlags - [input] Bitmask of flags used to control how logon is performed.
The following flags can be set:
MAPI_ALLOW_OTHERS - The shared session should be returned, allowing subsequent
clients to acquire the session without providing any user credentials.
MAPI_EXPLICIT_PROFILE - The default profile should not be used, and the user
should be required to supply a profile.
MAPI_EXTENDED - Log on with extended capabilities.
This flag should always be set.
The older MAPILogon function is no longer available.
MAPI_FORCE_DOWNLOAD - An attempt should be made to download all of the user's
messages before returning. If the MAPI_FORCE_DOWNLOAD flag is not set,
messages can be downloaded in the background after the call
to MAPILogonEx returns.
MAPI_LOGON_UI - A dialog box should be displayed to prompt the user for logon
information if required. When the MAPI_LOGON_UI flag is not set,
the calling client does not display a logon dialog box and
returns an error value if the user is not logged on.
MAPI_LOGON_UI and MAPI_PASSWORD_UI are mutually exclusive.
MAPI_NEW_SESSION - An attempt should be made to create a new MAPI session
rather than acquire the shared session. If the MAPI_NEW_SESSION flag
is not set, MAPILogonEx uses an existing shared session even if
the lpszprofileName parameter is not NULL.
MAPI_NO_MAIL - MAPI should not inform the MAPI spooler of the session's existence.
The result is that no messages can be sent or received within the session
except through a tightly coupled store and transport pair.
A calling client sets this flag if it is acting as an agent,
if configuration work must be done, or if the client is browsing
the available message stores.
MAPI_NT_SERVICE - The caller is running as a Windows NT service.
Callers that are not running as a Windows NT service should not set this flag;
callers that are running as a service must set this flag.
MAPI_PASSWORD_UI - A dialog box should be displayed to prompt the user for
the profile password. MAPI_PASSWORD_UI cannot be set if MAPI_LOGON_UI
is set because the calling client can only present one of the two dialog boxes. This dialog box does not allow the profile name to be changed; the lpszProfileName parameter must be non-NULL.
MAPI_SERVICE_UI_ALWAYS - MAPILogonEx should display a configuration
dialog box for each message service in the profile.
The dialog boxes are displayed after the profile has been chosen
but before any message service is logged on.
The MAPI common dialog box for logon also contains a check box that
requests the same operation.
MAPI_TIMEOUT_SHORT - The logon should fail if blocked for more than a few seconds.
MAPI_UNICODE - The passed-in strings are in Unicode format.
If the MAPI_UNICODE flag is not set, the strings are in ANSI format.
MAPI_USE_DEFAULT - The messaging subsystem should substitute the profile name
of the default profile for the lpszProfileName parameter.
The MAPI_EXPLICIT_PROFILE flag is ignored unless lpszProfileName is NULL or empty.
lppSession - [out] Pointer to the MAPI session interface.
*)
hr := MAPILogonEx(Application.Handle, nil, nil, MAPI_EXTENDED or
MAPI_NEW_SESSION or MAPI_NO_MAIL or flag, FMapiSession);
if failed(hr) then
begin
case hr of
MAPI_E_LOGON_FAILED: MessageDlg(
WrapText(
'The logon did not succeed, either because one or more of the parameters to Profile were invalid or because there were too many sessions open already.', #13#10, ['.', ' '], 42), mtError, [mbOK], 0);
MAPI_E_TIMEOUT: MessageDlg(
WrapText(
'MAPI serializes all logons through a mutex. This is returned if the another thread held the mutex.',
#13#10, ['.', ' '], 42), mtError, [mbOK], 0);
MAPI_E_USER_CANCEL: ShowMessage(
WrapText(
'The user canceled the operation, typically by choosing the Cancel button in a dialog box.',
#13#10, ['.', ' '], 42));
MAPI_E_TOO_MANY_SESSIONS: MessageDlg(
WrapText(
'The user had too many sessions open simultaneously. No session handle was returned.',
#13#10, ['.', ' '], 42), mtError, [mbOK], 0);
MAPI_E_UNCONFIGURED: MessageDlg(
WrapText(
'A service provider has not been configured, and therefore the operation did not complete.',
#13#10, ['.', ' '], 42), mtError, [mbOK], 0);
else MessageDlg(WrapText('The logon did not succeed', #13#10, ['.', ' '], 42),
mtError, [mbOK], 0);
end;
exit;
end;
bMapiInit := True;
finally
btLogOn.Enabled := (bMapiInit = False) or Failed(hr) or not Assigned(FMapiSession);
btLogOff.Enabled := not btLogOn.Enabled;
if btLogOff.Enabled then ItIsMe;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
NullMAPI;
end;
procedure TfrmMain.MapiInternalLogOff;
begin
lwUser.Items.BeginUpdate;
try
lwUser.Items.Clear;
finally
lwUser.Items.EndUpdate;
lwUser.Repaint;
end;
Application.ProcessMessages;
if Assigned(FUserProp) then FUserProp := nil;
if Assigned(FMapiSession) then
begin
(*
The IMAPISession.Logoff method ends a MAPI session.
Parameters
UIParam - [input] Handle of the parent window for any dialog boxes or
windows to be displayed if possible. This parameter is ignored
if the MAPI_LOGOFF_UI flag is not set.
Flags - [input] Bitmask of flags that control the logoff operation.
The following flags can be set:
MAPI_LOGOFF_SHARED - If this session is shared, all clients logged
on using the shared session should be notified of the logoff
in progress. The clients should log off. Any client using
the shared session can set this flag.
MAPI_LOGOFF_SHARED is ignored if the current session is not shared.
MAPI_LOGOFF_UI - Logoff can display a dialog box during the operation,
possibly prompting the user for confirmation.
Reserved - Reserved; must be zero.
The IMAPISession.Logoff method ends a MAPI session.
When Logoff returns, none of the methods except
for Release (IMapiSession:=nil) can be called.
*)
FMapiSession.Logoff(Application.Handle, MAPI_LOGOFF_UI, 0);
FMapiSession := nil;
(*
The MAPIUninitialize function decrements the reference count,
cleans up, and deletes per-instance global data
for the MAPI32.DLL.
A client application calls the MAPIUninitialize function
to end its interaction with MAPI, begun with a call to the MAPIInitialize
function. After MAPIUninitialize is called,
no other MAPI calls can be made by the client.
MAPIUninitialize decrements the reference count,
and the corresponding MAPIInitialize function increments
the reference count.
Thus, the number of calls to one function must equal
the number of calls to the other.
*)
MAPIUninitialize;
end;
end;
procedure TfrmMain.btLogOnClick(Sender: TObject);
begin
case rgProfile.ItemIndex of
0: MAPILocalInit(MAPI_USE_DEFAULT);
1: MAPILocalInit(MAPI_LOGON_UI);
end;
end;
procedure TfrmMain.btLogOffClick(Sender: TObject);
begin
MapiInternalLogOff;
btLogOn.Enabled := True;
btLogOff.Enabled := False;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MapiInternalLogOff;
end;
procedure TfrmMAIN.ItIsMe;
var
FPropTagArray: PSPropTagArray;
FPSPropValue: PSPropValue;
i: integer;
cValues: ULONG;
ListItem: TListItem;
Save_Cursor: TCursor;
strTemp: string;
Count: integer;
FTempVariant: variant;
begin
Save_Cursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
lwUser.Items.Clear;
lwUser.Items.BeginUpdate;
FUserProp := nil;
cValues := 0;
FPropTagArray := nil;
FPSPropValue := nil;
try
// Get IMAPIPROP for Loged Object
hr := HrOpenSessionObject(FMAPISession, FUserProp);
if failed(hr) then
begin
MessageDlg(GetMAPIError(FMAPISession, hr), mtError, [mbOK], 0);
exit;
end;
if hr = MAPI_W_NO_SERVICE then
MessageDlg('NO SERVICE AVALIABLE.', mtError, [mbOK], 0);
//The IMAPIProp.GetPropList method returns property tags for all properties.
(*
Parameters
Flags - [input] Bitmask of flags that controls the format for the strings in
the returned property tags. The following flag can be set:
MAPI_UNICODE - The returned strings are in Unicode format.
If the MAPI_UNICODE flag is not set,
the strings are in ANSI format.
PropTagArray - [out] Pointer to the property tag array containing
tags for all of the object's properties.
The IMAPIProp.GetPropList method retrieves the property tag
for each property currently supported by an object.
If the object does not currently support any properties,
GetPropList returns a property tag array with the cValues member set to zero.
*)
if Assigned(FUserProp) then
begin
hr := FUserProp.GetPropList(0, FPropTagArray);
if Assigned(FPropTagArray) then cValues := FPropTagArray.cValues;
if (Failed(hr) or (cValues = 0)) then
begin
MessageDlg(GetMAPIError(FUserProp, hr), mtError, [mbOK], 0);
exit;
end;
//The IMAPIProp.GetProps method retrieves the property value of one
//or more properties of an object.
(*
Parameters
PropTagArray - [in] Pointer to an array of property tags identifying
the properties whose values are to be retrieved.
The PropTagArray parameter must either be NULL (nil),
indicating that values for all properties of the object should
be returned, or point to an SPropTagArray structure containing
one or more property tags.
Flags - [in] Bitmask of flags that indicates the format for properties
that have the type PT_UNSPECIFIED. The following flag can be set:
MAPI_UNICODE - The string values for these properties should
be returned in the Unicode format. If the MAPI_UNICODE flag is
not set, the string values should be returned in the ANSI format.
cValues - [out] A count of property values pointed to by
the PropArray parameter. If PropArray is NULL (nil), the contents of
the cValues parameter is zero.
PropArray - [out] Pointer to the retrieved property values.
*)
hr := FUserProp.GetProps(FPropTagArray, 0, cValues, FPSPropValue);
if (Failed(hr) or (cValues = 0) or (FPSPropValue = nil)) then
begin
MessageDlg(GetMAPIError(FUserProp, hr), mtError, [mbOK], 0);
exit;
end;
(*
Once we have the values, we will visualize them.
We will use the ConvertMAPIPropValueToVariant function that will return Variant,
and thus we will not have to worry about the data type.
*)
for I := 0 to cValues - 1 do
begin
ListItem := lwUser.Items.Add;
ListItem.Caption := SzGetPropTag(PSPropValueArray(FPSPropValue)[I].ulPropTag);
case PROP_TYPE(PSPropValueArray(FPSPropValue)[I].ulPropTag) of
PT_SHORT,
PT_LONG,
PT_FLOAT,
PT_DOUBLE,
PT_BOOLEAN,
PT_APPTIME,
PT_SYSTIME,
PT_STRING8,
PT_UNICODE: begin
ListItem.SubItems.Add(
SzGetPropType(PSPropValueArray(FPSPropValue)[I].ulPropTag));
ListItem.SubItems.Add(ConvertMAPIPropValueToVariant(
@PSPropValueArray(FPSPropValue)[I]));
end;
PT_BINARY: begin
ListItem.SubItems.Add(
SzGetPropType(PSPropValueArray(FPSPropValue)[I].ulPropTag));
strTemp := '';
FTempVariant := ConvertMAPIPropValueToVariant(
@PSPropValueArray(FPSPropValue)[I]);
for Count :=
0 to VarArrayHighBound(FTempVariant, 1) do strTemp :=
strTemp + ' ' + IntToHex(byte(FTempVariant[Count]), 2);
strTemp := 'cb:' + IntToStr(VarArrayHighBound(FTempVariant, 1) + 1) +
', lpb:' + Trim(strTemp);
ListItem.SubItems.Add(Trim(strTemp));
end;
PT_MV_STRING8: begin
FTempVariant := ConvertMAPIPropValueToVariant(
@PSPropValueArray(FPSPropValue)[I]);
for Count := 0 to VarArrayHighBound(FTempVariant, 1) do
begin
if Count > 0 then
begin
ListItem := lwUser.Items.Add;
ListItem.Caption :=
SzGetPropTag(PSPropValueArray(FPSPropValue)[I].ulPropTag);
end;
ListItem.SubItems.Add(
SzGetPropType(PSPropValueArray(FPSPropValue)[I].ulPropTag));
ListItem.SubItems.Add(FTempVariant[Count]);
end;
end
else begin
ListItem.SubItems.Add(
SzGetPropType(PSPropValueArray(FPSPropValue)[I].ulPropTag) +
' - Not implemented');
ListItem.SubItems.Add('A MAPI Value');
end
end;
end;
end;
finally
(*
We should not forget to free IMAPIProp memory.
GetPropList will return an array, that MUST be freed through MAPIFreeBuffer
*)
if Assigned(FPropTagArray) then
begin
MAPIFreeBuffer(FPropTagArray);
FPropTagArray := nil;
end;
(*
IMAPIProp.GetProps provides an array of Prop Values,
that should also be freed using MAPIFreeBuffer.
*)
if Assigned(FPSPropValue) and not Failed(hr) then
begin
MAPIFreeBuffer(FPSPropValue);
FPSPropValue := nil;
end;
if Assigned(FUserProp) then FUserProp := nil;
lwUser.Items.EndUpdate;
Screen.Cursor := Save_Cursor;
end;
end;
end.