Development

Request # 16

DateTime restriction and Appointments

This example shows how to construct DateTime restriction. With this restriction we will limit the listed Appointments to certain time interval.

Code snip:

// Fills List with Appointments data in format:
// Start; End; Busy Status; Subject
// If not StartDate and EndDate are defined, restriction is removed

Procedure GetFreeBusy(Const MessageStore: IMsgStore; Const MAPIFolder: IMAPIFolder;
                      List: TStrings; const StartDate: TDateTime = 0; const EndDate: TDateTime = 0);
Type
  TaMsgPropArray = Record
    cValues: ULONG;
    aulPropTag: Array [0 .. 3] Of ULONG;
  End;

  POutlookNamedProp = ^TOutlookNamedProp;

  TOutlookNamedProp = Record
    ID: Integer;
    OulookName: WideString;
    PROP_TAG: Integer;
    PROP_TAG_NAMED: TMAPINAMEID;
  End;

Var
  ContentTable: IMAPITable;
  hr: HRESULT;
  Flags, ContentTableRowCount: Cardinal;
  PropTagStart, PropTagEnd, PropTagBusyStatus: Cardinal;
  aMsgPropArray: TaMsgPropArray;
  RowSet: PSRowSet;
  iCount: Integer;
  PP: PSPropValue;
  FreeBusyData: string;

  Restriction: TSRestriction;
  RestrictionAND: array [0 .. 3] of TSRestriction;
  Prop1, Prop2: TSPropValue;
  SortCriteria: TSSortOrderSet;

Const
  // Outlook GUID's
  // IPM.Appointment
  IID_IPMAppointment: TGUID = '{00062002-0000-0000-C000-000000000046}';
  strIID_IPMAppointment = '{00062002-0000-0000-C000-000000000046}';

const
  TBusyStatusDesc: Array [TBusyStatus] Of string = ('Free', 'Tentative', 'Busy',
    'OutOfOffice', 'WorkingFromElsewhere');

Const
  NamedProp: Array [0 .. 2] Of TOutlookNamedProp = (
    (ID: 0;
     OulookName: 'Start';
    PROP_TAG: PT_SYSTIME;
    PROP_TAG_NAMED: (lpguid: @IID_IPMAppointment;
                     ulKind: MNID_ID;
                     KIND: (lID: $820D));
    ),
    (ID: 1;
    OulookName: 'End';
    PROP_TAG: PT_SYSTIME;
    PROP_TAG_NAMED: (lpguid: @IID_IPMAppointment;
                     ulKind: MNID_ID;
                     KIND: (lID: $820E));
    ),
    (ID: 2;
    OulookName: 'BusyStatus';
    PROP_TAG: PT_LONG;
    PROP_TAG_NAMED: (lpguid: @IID_IPMAppointment;
                     ulKind: MNID_ID;
                     KIND: (lID: $8205));
    )
    );
  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
  Function PropTagFromNamed(Const NamedProp: TMAPINAMEID;
    Const PropType: Cardinal; Out PropTag: Cardinal;
    Const Create: Boolean = False): Boolean;
  Var
    PsPropTag: PSPropTagArray;
    PropNamed: Array [0 .. 0] Of PMAPINAMEID;
  Begin
    Result := False;
    PsPropTag := nil;
    PropTag := 0;
    If Not Assigned(MAPIFolder) Then
      Exit;

    If Create Then
      Flags := MAPI_CREATE
    Else
      Flags := 0;

    Try
      PropNamed[0] := @NamedProp;
      hr := IMAPIProp(MAPIFolder).GetIDsFromNames(1, @PropNamed, Flags,
        PsPropTag);

      If failed(hr) Or Not Assigned(PsPropTag) Or (PsPropTag.cValues <> 1) Then
        Exit;

      PsPropTag.aulPropTag[0] := CHANGE_PROP_TYPE(PsPropTag.aulPropTag[0],
        PropType);

      PropTag := PsPropTag.aulPropTag[0];

      Result := True;

    Finally
      If Assigned(PsPropTag) Then
        MAPIFreeBuffer(PsPropTag);
    End;
  End;

// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//

Begin
  // If Not Assigned(MAPIFolder) Or (GetMAPIFolderType(MAPIFolder) <> oFolderCalendar) Then
  // Exit;

  If Not Assigned(MAPIFolder) Or (GetMAPIFolderTypeEx(MessageStore, MAPIFolder)
    <> oFolderCalendar) Then
    Exit;

  RowSet := nil;

  if not Assigned(List) then
    Exit;

  Try

    Flags := 0;
    hr := MAPIFolder.GetContentsTable(Flags, ContentTable);
    If failed(hr) Or Not Assigned(ContentTable) Then
      Raise EMAPIError.CreateMAPI(MAPIFolder, hr);

    hr := ContentTable.GetRowCount(0, ContentTableRowCount);
    If failed(hr) Then
      Raise Exception.Create(GetMapiError(ContentTable, hr));

    If Integer(ContentTableRowCount) < 1 Then
      Exit;

    If Not PropTagFromNamed(NamedProp[0].PROP_TAG_NAMED, NamedProp[0].PROP_TAG, PropTagStart) 
    Or Not PropTagFromNamed(NamedProp[1].PROP_TAG_NAMED, NamedProp[1].PROP_TAG, PropTagEnd) 
    Or Not PropTagFromNamed(NamedProp[2].PROP_TAG_NAMED, NamedProp[2].PROP_TAG, PropTagBusyStatus) Then
      Exit;

    aMsgPropArray.cValues := 4;
    aMsgPropArray.aulPropTag[0] := PropTagStart;
    aMsgPropArray.aulPropTag[1] := PropTagEnd;
    aMsgPropArray.aulPropTag[2] := PropTagBusyStatus;
    aMsgPropArray.aulPropTag[3] := PR_SUBJECT;

    ZeroMemory(@SortCriteria, SizeOf(TSSortOrderSet));
    SortCriteria.cSorts := 1;
    SortCriteria.aSort[0].ulPropTag := PropTagStart;
    SortCriteria.aSort[0].ulOrder := TABLE_SORT_ASCEND;

    hr := ContentTable.SetColumns(@aMsgPropArray, TBL_BATCH);
    If failed(hr) And (hr = MAPI_E_BUSY) Then // do we have to wait?
    Begin
      hr := ContentTable.WaitForCompletion(0, 2000, ULONG(nil^)); // 2sec??

      If hr = S_OK Then // does not run either
        hr := ContentTable.SetColumns(@aMsgPropArray, TBL_BATCH);
    End;

    if (Trunc(StartDate) = 0) and (Trunc(EndDate) = 0) then
    begin // Clear Restriction!!!
      hr := ContentTable.Restrict(nil, TBL_BATCH);
      if failed(hr) and (hr <> MAPI_E_BUSY) then
        raise Exception.Create(GetMapiError(ContentTable, hr));

      if (hr = MAPI_E_BUSY) then
      begin
        hr := ContentTable.WaitForCompletion(0, 2000, ULONG(nil^));
        // wait 2000 msec
        if hr = S_OK then // does not run either
          hr := ContentTable.Restrict(nil, TBL_BATCH);
        if failed(hr) then
          raise Exception.Create(GetMapiError(ContentTable, hr));
      end;
    end
    else
    begin
      // request -  messges between dates
      if (Trunc(StartDate) <> 0) and (Trunc(EndDate) <> 0) then
      begin
        ZeroMemory(@Restriction, SizeOf(TSRestriction));
        ZeroMemory(@RestrictionAND, SizeOf(TSRestriction) * 4);
        ZeroMemory(@Prop1, SizeOf(TSPropValue));
        ZeroMemory(@Prop2, SizeOf(TSPropValue));

        Restriction.rt := RES_AND;
        Restriction.res.resAnd.cRes := 4;

        RestrictionAND[0].rt := RES_EXIST;
        RestrictionAND[0].res.resExist.ulPropTag := PropTagStart;
        RestrictionAND[0].res.resExist.ulReserved1 := 0;
        RestrictionAND[0].res.resExist.ulReserved2 := 0;

        RestrictionAND[1].rt := RES_EXIST;
        RestrictionAND[1].res.resExist.ulPropTag := PropTagEnd;
        RestrictionAND[1].res.resExist.ulReserved1 := 0;
        RestrictionAND[1].res.resExist.ulReserved2 := 0;

        Prop1.ulPropTag := PropTagStart;
        ConvertVariantToMAPIPropValue(StartDate, Prop1, nil);

        RestrictionAND[2].rt := RES_PROPERTY;
        RestrictionAND[2].res.resProperty.relop := RELOP_GE;
        RestrictionAND[2].res.resProperty.ulPropTag := PropTagStart;
        RestrictionAND[2].res.resProperty.lpProp := @Prop1;

        Prop2.ulPropTag := PropTagEnd;
        ConvertVariantToMAPIPropValue(EndDate, Prop2, nil);

        RestrictionAND[3].rt := RES_PROPERTY;
        RestrictionAND[3].res.resProperty.relop := RELOP_LE;
        RestrictionAND[3].res.resProperty.ulPropTag := PropTagEnd;
        RestrictionAND[3].res.resProperty.lpProp := @Prop2;

        Restriction.res.resAnd.lpRes := @RestrictionAND;
      end
      else
        // request -  StartDate or EndDate Defined
        if (Trunc(StartDate) <> 0) or (Trunc(EndDate) <> 0) then
        begin
          ZeroMemory(@Restriction, SizeOf(TSRestriction));
          ZeroMemory(@RestrictionAND, SizeOf(TSRestriction) * 2);
          ZeroMemory(@Prop1, SizeOf(TSPropValue));
          ZeroMemory(@Prop2, SizeOf(TSPropValue));

          Restriction.rt := RES_AND;
          Restriction.res.resAnd.cRes := 2;

          RestrictionAND[0].rt := RES_EXIST;

          if (Trunc(StartDate) <> 0) then
            RestrictionAND[0].res.resExist.ulPropTag := PropTagStart
          else
            RestrictionAND[0].res.resExist.ulPropTag := PropTagEnd;

          RestrictionAND[0].res.resExist.ulReserved1 := 0;
          RestrictionAND[0].res.resExist.ulReserved2 := 0;

          RestrictionAND[1].rt := RES_PROPERTY;

          if (Trunc(StartDate) <> 0) then
          begin
            RestrictionAND[1].res.resProperty.relop := RELOP_GE; { >= }
            RestrictionAND[1].res.resProperty.ulPropTag := PropTagStart;
          end
          else
          begin
            RestrictionAND[1].res.resProperty.relop := RELOP_LE; { <= }
            RestrictionAND[1].res.resProperty.ulPropTag := PropTagEnd;
          end;

          if (Trunc(StartDate) <> 0) then
          begin
            Prop1.ulPropTag := PropTagStart;
            ConvertVariantToMAPIPropValue(StartDate, Prop1, nil);
          end
          else
          begin
            Prop1.ulPropTag := PropTagEnd;
            ConvertVariantToMAPIPropValue(EndDate, Prop1, nil);
          end;

          RestrictionAND[1].res.resProperty.lpProp := @Prop1;
          Restriction.res.resAnd.lpRes := @RestrictionAND;
        end;

      hr := ContentTable.Restrict(@Restriction, TBL_BATCH);
      if failed(hr) and (hr <> MAPI_E_BUSY) then
        raise Exception.Create(GetMapiError(ContentTable, hr));

      if (hr = MAPI_E_BUSY) then
      begin
        hr := ContentTable.WaitForCompletion(0, 2000, ULONG(nil^));
        // wait 2000 msec
        if hr = S_OK then // does not run either
          hr := ContentTable.Restrict(@Restriction, TBL_BATCH);
        if failed(hr) then
          raise Exception.Create(GetMapiError(ContentTable, hr));
      end;

      if (Trunc(StartDate) <> 0) then
        SortCriteria.aSort[0].ulPropTag := PropTagStart
      else
        SortCriteria.aSort[0].ulPropTag := PropTagEnd;
    end;

    hr := ContentTable.SortTable(@SortCriteria, TBL_BATCH);
    if failed(hr) and (hr <> MAPI_E_BUSY) then
      raise EMAPIError.CreateMAPI(ContentTable, hr);

    if (hr = MAPI_E_BUSY) then
    begin
      hr := ContentTable.WaitForCompletion(0, 2000, ULONG(nil^));

      if hr = S_OK then // does not run either
        hr := ContentTable.SortTable(@SortCriteria, TBL_BATCH);
      if failed(hr) then
        raise EMAPIError.CreateMAPI(ContentTable, hr);
    end;

    hr := ContentTable.GetRowCount(0, ContentTableRowCount);
    If failed(hr) Then
      Raise Exception.Create(GetMapiError(ContentTable, hr));

    If Integer(ContentTableRowCount) < 1 Then
      Exit;

    While True Do
    Begin
      RowSet := nil;
      hr := ContentTable.QueryRows(25, 0, RowSet);

      If Not failed(hr) And Assigned(RowSet) Then
        If RowSet.cRows = 0 Then
        Begin
          If Assigned(RowSet) Then
            FreePRows(RowSet);
          RowSet := nil;
          Break;
        End
        Else
        Begin
          For iCount := 0 To RowSet.cRows - 1 Do
          Begin
            FreeBusyData := '';

            PP := PpropFindProp(RowSet.aRow[iCount].lpProps,
              RowSet.aRow[iCount].cValues, PropTagStart);

            If Assigned(PP) Then
              FreeBusyData :=
                VarToStr(ConvertMAPIPropValueToVariant(PP)) + '; ';

            PP := PpropFindProp(RowSet.aRow[iCount].lpProps,
              RowSet.aRow[iCount].cValues, PropTagEnd);
            If Assigned(PP) Then
              FreeBusyData := FreeBusyData +
                VarToStr(ConvertMAPIPropValueToVariant(PP)) + '; ';

            PP := PpropFindProp(RowSet.aRow[iCount].lpProps,
              RowSet.aRow[iCount].cValues, PropTagBusyStatus);
            If Assigned(PP) Then
              FreeBusyData := FreeBusyData + TBusyStatusDesc
                [TBusyStatus(PP.Value.l)] + '; ';

            PP := PpropFindProp(RowSet.aRow[iCount].lpProps,
              RowSet.aRow[iCount].cValues, PR_SUBJECT);

            If Assigned(PP) Then
              FreeBusyData := FreeBusyData + StrPas(PP.Value.lpsz);
            List.Add(FreeBusyData);
          End; // for iCount := 0 to RowSet.cRows - 1 do
        End;

      If Assigned(RowSet) Then
        FreePRows(RowSet);
      RowSet := nil;
    End; // while True do
  Finally
    If Assigned(RowSet) Then
      FreePRows(RowSet);
    RowSet := nil;
    ContentTable := nil;
  End;
End;