Development

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;