Extended MAPI in DELPHI
Experimental # 8
Working with Recurring Appointments
A recurring event is one that occurs at regular intervals. For example, a conference call held every Monday at 11am, an annual event such as a birthday, or a meeting held every month on the same day.
In Outlook, this sequence is recorded in a set of message properties, and when the message (meeting) is rendered, a virtual table is created based on them. It’s a bit complicated, but that’s what the developers decided.
procedure TfrmMain.RenderSeries;
type
VirtualTags = record
cValues: ULONG;
aulPropTag: array [0 .. 12] of ULONG;
end;
const
// Our Custom Tagged Property
PR_IS_MASTER = PT_BOOLEAN or ($4001 shl 16);
PR_IS_EXCEPTION = PT_BOOLEAN or ($4002 shl 16);
var
MAPITable: IMAPITable;
PropNames: array of PMAPINAMEID;
PropTags: PSPropTagArray;
ptags: at;
SortOrder: TSSortOrderSet;
RowCount: ULONG;
Malloc: IMalloc;
AllocBuff: TALLOCATEBUFFER;
AllocMore: TALLOCATEMORE;
FreeBuff: TFREEBUFFER;
ptagsVirtual: VirtualTags;
ContentsTableData: ITableData;
RowSet: PSRowSet;
Msg: IMessage;
ObjType: ULONG;
cValues: ULONG;
PropValues: PSPropValue;
IsRecurrence: Boolean;
iCount: Integer;
Indx: Integer;
Prop: PSPropValue;
UpdateRow: TSRow;
Appointment: TMAPIAppointment;
NextDate: TDateTime;
IsException: Boolean;
RecurrencePattern: TRecurrencePattern;
StartDate, EndDate: TDate;
ListItem: TListItem;
P: PSBinary;
Duration: Integer;
RecurrenceException: TRecurrenceException;
StartSortTAG: ULONG;
ExcSubject: string;
begin
if CompareDateTime(dtStart.Date, dtEnd.Date) <> -1 then
raise Exception.Create('Invalid Date Range!');
ClearListView;
// Add Master/Series Column
if (ListView.Columns.Count = 7) then
begin
ListView.Columns.BeginUpdate;
try
with ListView.Columns.Add do
begin
Autosize := True;
Caption := 'Is Master';
end;
with ListView.Columns.Add do
begin
Autosize := True;
Caption := 'Is Exception';
end;
finally
ListView.Columns.EndUpdate;
end;
end;
PropTags := nil;
RowSet := nil;
PropValues := nil;
RecurrenceException:=nil;
StartDate := dtStart.Date;
EndDate := dtEnd.Date;
StartSortTAG := PR_START_DATE;
Indx:=0;
//
try
// Get content table
hr := fMsgFolder.GetContentsTable(0, MAPITable);
if failed(hr) then
raise EMAPIError.CreateMAPI(fMsgFolder, hr);
// get property id for Location, AllDayEvent, etc..
SetLength(PropNames, 6);
PropNames[0] := @LocationPN;
PropNames[1] := @AllDayEventPN;
PropNames[2] := @StartPN;
PropNames[3] := @EndPN;
PropNames[4] := @IsRecurringPN;
PropNames[5] := @DurationPN;
hr := fMsgFolder.GetIDsFromNames(Length(PropNames), @PropNames[0], MAPI_CREATE, PropTags);
if failed(hr) then
raise EMAPIError.CreateMAPI(fMsgFolder, hr);
// Location is WideString - 4
PropTags.aulPropTag[PropTags.cValues - 6] := CHANGE_PROP_TYPE(PropTags.aulPropTag[PropTags.cValues - 6], PT_UNICODE);
// AllDayEvent is Boolean - 5
PropTags.aulPropTag[PropTags.cValues - 5] := CHANGE_PROP_TYPE(PropTags.aulPropTag[PropTags.cValues - 5], PT_BOOLEAN);
// Start is PT_SYSTIME - 6
PropTags.aulPropTag[PropTags.cValues - 4] := CHANGE_PROP_TYPE(PropTags.aulPropTag[PropTags.cValues - 4], PT_SYSTIME);
StartSortTAG := PropTags.aulPropTag[PropTags.cValues - 4];
// End is PT_SYSTIME - 7
PropTags.aulPropTag[PropTags.cValues - 3] := CHANGE_PROP_TYPE(PropTags.aulPropTag[PropTags.cValues - 3], PT_SYSTIME);
// IsRecurring is Boolean - 8
PropTags.aulPropTag[PropTags.cValues - 2] := CHANGE_PROP_TYPE(PropTags.aulPropTag[PropTags.cValues - 2], PT_BOOLEAN);
// Duration is LONG - 9
PropTags.aulPropTag[PropTags.cValues - 1] := CHANGE_PROP_TYPE(PropTags.aulPropTag[PropTags.cValues - 1], PT_LONG);
ZeroMemory(@ptags, SizeOF(ptags));
// Copy PR_ENTRYID, PR_SUBJECT, PR_START_DATE, PR_END_DATE Tags
CopyMemory(@ptags.aulPropTag[0], @ptaga.aulPropTag[0], ptaga.cValues * SizeOF(ULONG));
// Copy Location, AllDayEvent and other Named Properties
CopyMemory(@ptags.aulPropTag[4], @PropTags.aulPropTag[0], PropTags.cValues * SizeOF(ULONG));
// Set cValues
ptags.cValues := Length(ptags.aulPropTag);
// Set Column
hr := MAPITable.SetColumns(@ptags, TBL_BATCH);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
// Sort Table
ZeroMemory(@SortOrder, SizeOF(SortOrder));
SortOrder.cSorts := 1;
SortOrder.aSort[0].ulPropTag := StartSortTAG;
SortOrder.aSort[0].ulOrder := TABLE_SORT_DESCEND;
hr := MAPITable.SortTable(@SortOrder, TBL_BATCH);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
// Get Content Table Row Count
hr := MAPITable.GetRowCount(0, RowCount);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
if (RowCount <= 0) then
Exit;
////// Create our Virtual MAPI Table - START
Pointer(Malloc) := MAPIGetDefaultMalloc;
AllocBuff := GetProcAddress(MAPI32Module, 'MAPIAllocateBuffer');
AllocMore := GetProcAddress(MAPI32Module, 'MAPIAllocateMore');
FreeBuff := GetProcAddress(MAPI32Module, 'MAPIFreeBuffer');
ZeroMemory(@ptagsVirtual, SizeOF(ptagsVirtual));
ptagsVirtual.cValues := Length(ptagsVirtual.aulPropTag);
CopyMemory(@ptagsVirtual.aulPropTag[0], @ptags.aulPropTag[0], ptags.cValues * SizeOF(ULONG));
ptagsVirtual.aulPropTag[ptagsVirtual.cValues - 3] := PR_IS_MASTER;
ptagsVirtual.aulPropTag[ptagsVirtual.cValues - 2] := PR_IS_EXCEPTION;
ptagsVirtual.aulPropTag[ptagsVirtual.cValues - 1] := PR_INSTANCE_KEY;
// create the data for the table
hr := CreateTable(@IID_IMAPITableData, @AllocBuff, @AllocMore, @FreeBuff, Pointer(Malloc), TBLTYPE_DYNAMIC, PR_INSTANCE_KEY, PSPropTagArray(@ptagsVirtual),
ContentsTableData);
if failed(hr) then
raise EMAPIError.Create(GetMAPIError(nil, hr));
while True do
begin
if Assigned(RowSet) then
FreePRows(RowSet);
if Assigned(PropValues) then
MapiFreeBuffer(PropValues);
PropValues := nil;
RowSet := nil;
hr := MAPITable.QueryRows(1, 0, RowSet);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
if not Assigned(RowSet) or (RowSet.cRows = 0) then
Break;
Prop := PpropFindProp(RowSet.aRow[0].lpProps, RowSet.aRow[0].cValues, PR_ENTRYID);
if not Assigned(Prop) then
Continue;
// Get Message (Appointment)
hr := fMsgFolder.OpenEntry(Prop.Value.bin.cb, PENTRYID(Prop.Value.bin.lpb), @IID_IMessage, MAPI_BEST_ACCESS, ObjType, IUnknown(Msg));
if failed(hr) then
raise EMAPIError.CreateMAPI(fMsgFolder, hr);
hr := Msg.GetProps(@ptagsVirtual, 0, cValues, PropValues);
if failed(hr) then
raise EMAPIError.CreateMAPI(Msg, hr);
// Is Recuting
Prop := PpropFindProp(PropValues, cValues, PropTags.aulPropTag[PropTags.cValues - 2]);
if Assigned(Prop) then
IsRecurrence := Prop.Value.b
else
IsRecurrence := False;
PSPropValueArray(PropValues)[cValues - 3].ulPropTag := PR_IS_MASTER;
PSPropValueArray(PropValues)[cValues - 3].Value.b := True;
//
PSPropValueArray(PropValues)[cValues - 2].ulPropTag := PR_IS_EXCEPTION;
PSPropValueArray(PropValues)[cValues - 2].Value.b := False;
//
PSPropValueArray(PropValues)[cValues - 1].ulPropTag := PR_INSTANCE_KEY;
PSPropValueArray(PropValues)[cValues - 1].Value.bin.cb := SizeOF(ULONG);
PSPropValueArray(PropValues)[cValues - 1].Value.bin.lpb := PByte(@Indx);
if (IsRecurrence = False) then
begin
UpdateRow.cValues := cValues;
UpdateRow.lpProps := PropValues;
hr := ContentsTableData.HrInsertRow(Indx, @UpdateRow);
If failed(hr) Then
raise EMAPIError.Create(GetMAPIError(nil, hr));
inc(Indx);
end
else
begin
Appointment := TMAPIAppointment.Create(Msg, fMAPISession);
try
RecurrencePattern := Appointment.GetRecurrencePattern;
UpdateRow.cValues := cValues;
UpdateRow.lpProps := PropValues;
hr := ContentsTableData.HrInsertRow(Indx, @UpdateRow);
If failed(hr) Then
raise EMAPIError.Create(GetMAPIError(nil, hr));
inc(Indx);
if CompareDate(StartDate, RecurrencePattern.FirstOccurrence(Boolean(nil^))) <> 1 then
NextDate := RecurrencePattern.FirstOccurrence(IsException)
else
NextDate := RecurrencePattern.NextOccurrence(StartDate, IsException);
while (NextDate <= EndDate) and (NextDate > 0) do
begin
// Start Time
PSPropValueArray(PropValues)[2].Value.ft := FileTimeFromDateTime(NextDate, True);
// Start Named is #6
PSPropValueArray(PropValues)[6].Value.ft := PSPropValueArray(PropValues)[2].Value.ft;
Duration := PSPropValueArray(PropValues)[9].Value.L;
// End Time
PSPropValueArray(PropValues)[3].Value.ft := FileTimeFromDateTime(IncMinute(NextDate, Duration), True);
// End Named is #6
PSPropValueArray(PropValues)[7].Value.ft := PSPropValueArray(PropValues)[3].Value.ft;
// Is Master
PSPropValueArray(PropValues)[cValues - 3].Value.b := False;
// Is Exception
PSPropValueArray(PropValues)[cValues - 2].Value.b := IsException;
UpdateRow.cValues := cValues;
UpdateRow.lpProps := PropValues;
if IsException then
begin
RecurrenceException := RecurrencePattern.Exceptions.ItemByStartDate[NextDate];
if not Assigned(RecurrenceException) then
raise Exception.Create('not Assigned(RecurrenceException) ');
if (aroSUBJECT in RecurrenceException.OverrideFlags) then
begin
ExcSubject := PSPropValueArray(PropValues)[1].Value.lpsz;
PSPropValueArray(UpdateRow.lpProps)[1].Value.lpsz := PChar(String(RecurrenceException.Subject));
end;
// Start Time
PSPropValueArray(UpdateRow.lpProps)[2].Value.ft := FileTimeFromDateTime(RecurrenceException.ExceptionMessage.StartDateTime, True);
// Start Named is #6
PSPropValueArray(UpdateRow.lpProps)[6].Value.ft := PSPropValueArray(UpdateRow.lpProps)[2].Value.ft;
// Duration
PSPropValueArray(UpdateRow.lpProps)[9].Value.L := RecurrenceException.ExceptionMessage.Duration;
// End Time
PSPropValueArray(UpdateRow.lpProps)[3].Value.ft := FileTimeFromDateTime(RecurrenceException.ExceptionMessage.EndDateTime, True);
// End Named is #6
PSPropValueArray(UpdateRow.lpProps)[7].Value.ft := PSPropValueArray(UpdateRow.lpProps)[3].Value.ft;
end;
hr := ContentsTableData.HrInsertRow(Indx, @UpdateRow);
If failed(hr) Then
raise EMAPIError.Create(GetMAPIError(nil, hr));
PSPropValueArray(PropValues)[9].Value.L := Duration;
// Start Time
PSPropValueArray(PropValues)[2].Value.ft := FileTimeFromDateTime(NextDate, True);
// Start Named is #6
PSPropValueArray(PropValues)[6].Value.ft := PSPropValueArray(PropValues)[2].Value.ft;
// End Time
PSPropValueArray(PropValues)[3].Value.ft := FileTimeFromDateTime(IncMinute(NextDate, Duration), True);
// End Named is #6
PSPropValueArray(PropValues)[7].Value.ft := PSPropValueArray(PropValues)[3].Value.ft;
if IsException then
begin
if aroSUBJECT in RecurrenceException.OverrideFlags then
begin
PSPropValueArray(PropValues)[1].Value.lpsz := PChar(ExcSubject);
end;
end;
//
NextDate := RecurrencePattern.NextOccurrence(NextDate, IsException);
inc(Indx);
end;
FreeAndNil(RecurrencePattern);
finally
FreeAndNil(Appointment);
end;
end;
end;
finally
if Assigned(PropValues) then
MapiFreeBuffer(PropValues);
PropValues := nil;
//
if Assigned(RowSet) then
FreePRows(RowSet);
RowSet := nil;
end;
MAPITable := nil;
hr := ContentsTableData.HrGetView(nil, nil, 0, MAPITable);
If failed(hr) Then
raise EMAPIError.Create(GetMAPIError(nil, hr));
////// Create our Virtual MAPI Table - END
try
// Get Content Table Row Count
hr := MAPITable.GetRowCount(0, RowCount);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
if (RowCount <= 0) then
Exit;
// Sort Table
ZeroMemory(@SortOrder, SizeOF(SortOrder));
SortOrder.cSorts := 1;
SortOrder.aSort[0].ulPropTag := StartSortTAG;
SortOrder.aSort[0].ulOrder := TABLE_SORT_ASCEND;
hr := MAPITable.SortTable(@SortOrder, TBL_BATCH);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
ListView.Items.BeginUpdate;
try
while True do
begin
if Assigned(RowSet) then
FreePRows(RowSet);
RowSet := nil;
hr := MAPITable.QueryRows(10, 0, RowSet);
if failed(hr) then
raise EMAPIError.CreateMAPI(MAPITable, hr);
if not Assigned(RowSet) or (RowSet.cRows = 0) then
Exit; //
for iCount := 0 to RowSet.cRows - 1 do
begin
// PR_ENTRYID
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PR_ENTRYID);
if not Assigned(Prop) then
Continue;
ListItem := ListView.Items.Add;
GetMem(P, SizeOF(TSBinary));
P.cb := Prop.Value.bin.cb;
GetMem(P.lpb, Prop.Value.bin.cb);
Move(Prop.Value.bin.lpb^, P.lpb^, Prop.Value.bin.cb);
ListItem.Data := P;
// PR_SUBJECT
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PR_SUBJECT);
if Assigned(Prop) then
ListItem.Caption := MAPIUtils.GetPropString(Prop);
// Location
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PropTags.aulPropTag[PropTags.cValues - 6]);
if Assigned(Prop) then
ListItem.SubItems.Add(MAPIUtils.GetPropString(Prop))
else
ListItem.SubItems.Add('');
// PR_START_DATE
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PR_START_DATE);
if Assigned(Prop) and (DateTimeFromFileTime(Prop.Value.ft) > 1) then
ListItem.SubItems.Add(DateTimetoStr(DateTimeFromFileTime(Prop.Value.ft)))
else
begin
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PropTags.aulPropTag[PropTags.cValues - 4]);
if Assigned(Prop) and (DateTimeFromFileTime(Prop.Value.ft) > 1) then
ListItem.SubItems.Add(DateTimetoStr(DateTimeFromFileTime(Prop.Value.ft)))
else
ListItem.SubItems.Add('');
end;
// PR_END_DATE
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PR_END_DATE);
if Assigned(Prop) and (DateTimeFromFileTime(Prop.Value.ft) > 1) then
ListItem.SubItems.Add(DateTimetoStr(DateTimeFromFileTime(Prop.Value.ft)))
else
begin
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PropTags.aulPropTag[PropTags.cValues - 3]);
if Assigned(Prop) and (DateTimeFromFileTime(Prop.Value.ft) > 1) then
ListItem.SubItems.Add(DateTimetoStr(DateTimeFromFileTime(Prop.Value.ft)))
else
ListItem.SubItems.Add('');
end;
// Duration
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PropTags.aulPropTag[PropTags.cValues - 1]);
if Assigned(Prop) and (Prop.Value.L > 1) then
ListItem.SubItems.Add(IntToStr(Prop.Value.L))
else
ListItem.SubItems.Add('');
// AllDayEvent
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PropTags.aulPropTag[PropTags.cValues - 5]);
if Assigned(Prop) then
ListItem.SubItems.Add(BoolToStr(Prop.Value.b, True))
else
ListItem.SubItems.Add('');
// Is Recurrence
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PropTags.aulPropTag[PropTags.cValues - 2]);
if Assigned(Prop) then
ListItem.SubItems.Add(BoolToStr(Prop.Value.b, True))
else
ListItem.SubItems.Add('');
// Is Master
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PR_IS_MASTER);
if Assigned(Prop) then
ListItem.SubItems.Add(BoolToStr(Prop.Value.b, True))
else
ListItem.SubItems.Add('');
// Is Exception
Prop := PpropFindProp(RowSet.aRow[iCount].lpProps, RowSet.aRow[iCount].cValues, PR_IS_EXCEPTION);
if Assigned(Prop) then
ListItem.SubItems.Add(BoolToStr(Prop.Value.b, True))
else
ListItem.SubItems.Add('');
end;
if Assigned(RowSet) then
FreePRows(RowSet);
RowSet := nil;
end;
finally
ListView.Items.EndUpdate;
end;
finally
if Assigned(PropValues) then
MapiFreeBuffer(PropValues);
PropValues := nil;
ContentsTableData := nil;
Pointer(Malloc) := nil;
if Assigned(RowSet) then
FreePRows(RowSet);
if Assigned(PropTags) then
MapiFreeBuffer(PropTags);
PropNames := nil;
AutoResizeListView(ListView, LVSCW_AUTOSIZE_USEHEADER);
StatusBar.SimpleText := 'Profile name: ' + FProfileName + ' | Appointments - Series';
ListView.Refresh;
end;
end;
