TRestriction Class Helper (SetSearchCriteria & Restrict)
Hi,
Thanks to this group I've learn a lot about Extended Mapi. I thought
it was time to give some of this knowledge back.
You'll find hereafter a quite simple Class that simplifies a lot the
creation and use of the Restriction parameter of the Setsearchcriteria
and Restrict functions.
It's true that it's not cutting-hedge coding, but I thought the Class
was useful enough for non Mapi expert to be posted.
The principle is easy:
You create and instance of the class and then you create as many
restrictions of any chosen types as you wish. The easy part is that
you just reference the restrictions between each others with the name
you previously assigned to them.
example:
var
MyRM:TRestrictionManager;
begin
MyRM:=TRestrictionManager.create(nil);
MyRM.addcontent('Content1',PR_SUBJECT,'Searched
Text',TFSubString,TCIgnoreCase);
MyRM..AddProperty('Prop1',PR_HASATTACH,False,TCEqual);
MyRM.AddAnd('Restriction','Content1,Prop1');
.....
Res:=FSearchFldr.SetSearchCriteria(@(MyRM.RestrictionsByName['Restriction'].Restriction,
EntryList,
RESTART_SEARCH +
BACKGROUND_SEARCH +
RECURSIVE_SEARCH);
...
MyRM.destroy;
The Source:
{///////////////////////////////////////////////////////////////
Restriction Manager
Abstract:
Class to assist in the construction of the Restriction Param
of the Restrict and SetSearchCriteria Methods
Comments:
Source Written by Patochem, 2008
Disclaimer:
This document is provided as is without any express or
implied warranties. While taking every effort to ensure
the accuracy of the information contained herein,
the author assumes no responsibility for any errors or
omissions, or for damages (real or imaginary) resulting
from the proper or improper use of the information
contained in this document.
Thanks & Aknowledgements:
To Dmitry Streblechenko for his patience, time and enlightment.
(http://www.dimastr.com)
To Alexander Staubo for his initial traduction of the X-Mapi
headers, and again to Dmitry for the final version of the files
(http://www.dimastr.com/outspy/download/MAPI_headers.zip)
To Ashley Godfrey, for its fantastic MapiServices Wrapper.
(http://www.evocorp.com/Downloads/MapiServices.pas)
///////////////////////////////////////////////////////////////////}
unit RestrictionManager;
interface
uses SysUtils, Classes, mapiservices,mapidefs;
type
TRestriction=record
Name:String;
Restriction:TSRestriction;
end;
TRestrictionArray=Array of TRestriction;
TArrayOfTRestrictionArray=record
Name:String;
RestrictionArray:Array of TSRestriction;
end;
TComparator=(TCLesser, TCLesserOrEqual, TCGreater,
TCGreaterOrEqual,
TCEqual,TCNotEqual,TCLike);
TFuzziness=(TFFullString=$00000000,
TFSubString=$00000001,
TFPrefix=$00000002);
TCase=(TCIgnoreCase=$00010000,
TCIgnoreonSpace=$00020000,
TCLoose=$00070000);
type
TRestrictionManager=Class(TComponent)
private
FRestrictions:TRestrictionArray;
FRestrictionArrays:array of TArrayOfTRestrictionArray;
FCount:integer;
function CountRestrictions: integer;
function GetRestriction(Index: integer): TRestriction;
function GetRestrictionByName(name: string): TRestriction;
procedure PrepareNewRestriction(Name: string);
function GetRestrictionIndex(Name:String):integer;
function GetRestrictionArrayIndex(Name:String):Integer;
function GetRestrictionArray(Index: integer):
TArrayOfTRestrictionArray;
function GetRestrictionArrayByName(Index: integer):
TArrayOfTRestrictionArray;
protected
public
//constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure AddAnd(Name,Restrictions: string); // Coma separated
names
procedure AddNot(Name,Restriction:string);overload;
procedure AddNot(Name:String;Restriction:integer);overload;
procedure AddOr(Name, Restrictions: string); // Coma separated
names
procedure AddExists(Name: string; FieldTag: Cardinal);
procedure AddProperty(Name: string; FieldTag: Cardinal; Value:
Variant; Oper: TComparator);
procedure AddContent(Name: string; FieldTag: Cardinal; Value:
Variant; Fuzziness: TFuzziness; CaseTreatment:TCase);
procedure AddSize(Name: string; FieldTag, Value, Oper:
Cardinal);
function AddRestrictionArray(Name,Restrictions:String):integer;
property
RestrictionArrays[Index:integer]:TArrayOfTRestrictionArray read
GetRestrictionArray;
property
RestrictionArraysByName[Index:integer]:TArrayOfTRestrictionArray read
GetRestrictionArrayByName;
property Restrictions[Index:integer]:TRestriction read
GetRestriction;
property RestrictionsByName[name:string]:TRestriction read
GetRestrictionByName;
property Count:integer read CountRestrictions;
End;
implementation
{ TRestrictionManager }
procedure TRestrictionManager.AddAnd(Name, Restrictions: string);
var
Index:integer;
begin
Index:=AddRestrictionArray('',Restrictions);
if Index=-1 then exit;
PrepareNewRestriction(Name);
FRestrictions[Fcount-1].Restriction.rt:=RES_AND;
FRestrictions[Fcount-1].Restriction.res.resAnd.cRes:=length(FRestrictionArrays[Index].RestrictionArray);
FRestrictions[Fcount-1].Restriction.res.resAnd.lpRes:=@(FRestrictionArrays[Index].RestrictionArray[0]);
end;
procedure TRestrictionManager.AddContent(Name: string; FieldTag:
Cardinal; Value: Variant; Fuzziness: TFuzziness; CaseTreatment:TCase);
var
propValue: TSPropValue;
begin
PrepareNewRestriction(Name);
FRestrictions[Fcount-1].Restriction.rt := RES_CONTENT;
FRestrictions[Fcount-1].Restriction.res.resContent.ulFuzzyLevel:=cardinal(Fuzziness)
+ cardinal(CaseTreatment);
FRestrictions[Fcount-1].Restriction.res.resContent.ulPropTag:=FieldTag;
propValue.ulPropTag:=FieldTag ;
propValue.dwAlignPad:=0;
propValue.Value.b:=1;
propValue.Value.lpszA:=pchar(string(Value));
getmem(FRestrictions[FCount-1].Restriction.res.resProperty.lpProp,sizeof(TSRestriction));
FRestrictions[Fcount-1].Restriction.res.resProperty.lpProp^ :=propValue;
end;
procedure TRestrictionManager.AddExists(Name: string; FieldTag:
Cardinal);
begin
PrepareNewRestriction(Name);
FRestrictions[Fcount-1].Restriction.rt:=RES_EXIST;
FRestrictions[Fcount-1].Restriction.res.resExist.ulReserved1:=0;
FRestrictions[Fcount-1].Restriction.res.resExist.ulReserved2:=0;
FRestrictions[Fcount-1].Restriction.res.resExist.ulPropTag:=FieldTag;
end;
procedure TRestrictionManager.AddNot(Name, Restriction: string);
var
n:integer;
begin
n:=GetRestrictionIndex(Restriction);
if n<0 then exit;
PrepareNewRestriction(Name);
FRestrictions[FCount-1].Restriction.rt:=RES_NOT;
FRestrictions[FCount-1].Restriction.res.resNot.ulReserved:=0;
FRestrictions[FCount-1].Restriction.res.resnot.lpRes:=@FRestrictions[n].Restriction;
end;
procedure TRestrictionManager.AddNot(Name: String; Restriction:
integer);
begin
if (Restriction>FCount) or (Restriction<0) then exit;
PrepareNewRestriction(Name);
FRestrictions[FCount-1].Restriction.rt:=RES_NOT;
FRestrictions[FCount-1].Restriction.res.resNot.ulReserved:=0;
FRestrictions[FCount-1].Restriction.res.resnot.lpRes:=@FRestrictions[Restriction].Restriction;
end;
procedure TRestrictionManager.AddOr(Name, Restrictions: string);
begin
AddAnd(Name, Restrictions);
FRestrictions[Fcount-1].Restriction.rt:=RES_OR;
end;
procedure TRestrictionManager.AddProperty(Name: string; FieldTag:
Cardinal; Value: Variant; Oper: TComparator);
var
propValue: TSPropValue;
ValueType: Cardinal;
begin
PrepareNewRestriction(Name);
getmem(FRestrictions[FCount-1].Restriction.res.resProperty.lpProp,sizeof(TSRestriction));
FRestrictions[Fcount-1].Restriction.rt := RES_PROPERTY;
FRestrictions[Fcount-1].Restriction.res.resProperty.relop:=cardinal(Oper) ;
FRestrictions[Fcount-1].Restriction.res.resContent.ulPropTag:=FieldTag;
propValue.ulPropTag:=FieldTag;
PropValue.dwAlignPad:=0;
ValueType:=PROP_TYPE(FieldTag);
case ValueType of
//PT_UNSPECIFIED : { (Reserved for interface use) type doesn't
matter to caller }
PT_NULL :propValue.Value.x:=Value;
PT_I2 :propValue.Value.i:=value;
PT_LONG :propValue.Value.l:=Value;
PT_R4 :propValue.Value.flt:=value;
PT_DOUBLE :propValue.Value.dbl:=Value;
PT_CURRENCY :propValue.Value.cur.int64:=Value;
PT_APPTIME :propValue.Value.at:=value;
PT_ERROR :propValue.Value.err:=value;
PT_BOOLEAN :propValue.Value.i:=value;
PT_OBJECT :propValue.Value.x:=Value;
PT_I8 :propValue.Value.li:=Value;
PT_STRING8 :propValue.Value.lpszA:=pchar(string(value));
PT_UNICODE :propValue.Value.lpszW:=pwstr(string(value));
//PT_SYSTIME :propValue.Value
PT_CLSID :propValue.Value.lpguid:=@Value;
PT_BINARY :propValue.Value.bin:=StringToEntryId(value);
end;
FRestrictions[Fcount-1].Restriction.res.resProperty.lpProp^ :=
propValue;
end;
function TRestrictionManager.AddRestrictionArray(Name, Restrictions:
String):integer;
var
Values: TStringList;
n,count: Integer;
Rest: TRestriction;
begin
Count:=0;
Values:=TStringList.Create;
Values.Delimiter:=',';
Values.DelimitedText:=Restrictions;
Setlength(FRestrictionArrays,length(FRestrictionArrays)+1);
try
for n := 0 to Values.Count-1 do
begin
Rest:= GetRestrictionByName(Values.Strings[n]);
if Rest.Name<>'' then
begin
inc(count);
setlength(FRestrictionArrays[high(FRestrictionArrays)].RestrictionArray,count);
FRestrictionArrays[high(FRestrictionArrays)].RestrictionArray[count-1]:=Rest.Restriction;
end
else
Exception.Create('TRestrictionManager.AddAnd/AddOr:
Restriction "'+ Values.ValueFromIndex[n] +'" not found');
end;
finally
Values.Free;
end;
Result:=-1;
if count=0 then
begin
setlength(FRestrictionArrays,high(FRestrictionArrays));
exit;
end;
if Name='' then Name:='Array'+inttostr(high(FRestrictionArrays)+1);
FRestrictionArrays[high(FRestrictionArrays)].Name:=Name;
Result:=high(FRestrictionArrays);
end;
procedure TRestrictionManager.AddSize(Name: string; FieldTag, Value,
Oper: Cardinal);
begin
PrepareNewRestriction(Name);
end;
procedure TRestrictionManager.PrepareNewRestriction(Name: string);
begin
inc(FCount);
Setlength(FRestrictions, FCount);
if Name = '' then
Name := 'R' + inttostr(FCount);
FRestrictions[FCount - 1].name := Name;
end;
function TRestrictionManager.CountRestrictions: integer;
begin
Result:=FCount;
end;
destructor TRestrictionManager.Destroy;
var
n:integer;
begin
for n := 0 to FCount - 1 do
if (FRestrictions[n].Restriction.rt=RES_PROPERTY) or
(FRestrictions[n].Restriction.rt=RES_CONTENT) then
try
freemem(FRestrictions[n].Restriction.res.resProperty.lpProp);
finally
end;
inherited;
end;
function TRestrictionManager.GetRestriction(Index: integer):
TRestriction;
begin
if (Index>FCount) or (Index<0) then exit;
Result:=FRestrictions[Index];
end;
function TRestrictionManager.GetRestrictionArray(
Index: integer): TArrayOfTRestrictionArray;
begin
if (Index>high(FRestrictionArrays)) or (Index<0) then exit;
Result:=FRestrictionArrays[Index];
end;
function TRestrictionManager.GetRestrictionArrayByName(
Index: integer): TArrayOfTRestrictionArray;
begin
Result:=GetRestrictionArray(GetRestrictionArrayIndex(name));
end;
function TRestrictionManager.GetRestrictionArrayIndex(Name: String):
Integer;
var
n:integer;
begin
Result:=-1;
for n := 0 to high(FRestrictionArrays) do
if FRestrictionArrays[n].Name=Name then
begin
Result:=n;
break;
end;
end;
function TRestrictionManager.GetRestrictionByName(name: string):
TRestriction;
begin
Result:=GetRestriction(GetRestrictionIndex(name));
end;
function TRestrictionManager.GetRestrictionIndex(Name: String):
integer;
var
n:integer;
begin
Result:=-1;
for n := 0 to FCount - 1 do
if FRestrictions[n].Name=Name then
begin
Result:=n;
break;
end;
end;
end.
date: Mon, 7 Jul 2008 07:51:57 -0700 (PDT)
author: patochem
