Development

Experimental # 7

Ole Attachments inside RTF?

“How to render Microsoft Office Excel Table or Microsoft Office Word document inside RTF Body?”
What about PR_RENDERING_POSITION, PR_RTF_COMPRESSED, PR_ATTACH_METHOD?

Embedded OLE attachments are valid only inside RTF formatted messages.

This example application is trying to answer all these questions.

Procedure TfrmMain.LoadRTFBody;
Var
  OleStreamC, OleStreamU: IStream;
  Stream: TMemoryStream;
  StreamBuffer: Array [0 .. 4095] Of Byte;
  iBytesRead: Longint;
Begin
  RichEdit.Lines.Clear;
  If Not FPropExists(FMessage, PR_RTF_COMPRESSED) Then
  Begin
    RichEdit.Lines.Add('There is not PR_RTF_COMPRESSED Body!');
    Exit;
  End;

  Stream := nil;
  Try
    hr := FMessage.OpenProperty(PR_RTF_COMPRESSED, @IID_IStream, 0, 0,
      IUnknown(OleStreamC));
    If failed(hr) Then
      Raise EMAPIError.CreateMAPI(FMessage, hr);

    hr := WrapCompressedRTFStream(OleStreamC, 0, OleStreamU);
    If failed(hr) Then
      Raise EMAPIError.CreateMAPI(nil, hr);

    Stream := TMemoryStream.Create;

    hr := OleStreamU.Read(@StreamBuffer, Length(StreamBuffer) - 1, @iBytesRead);

    Repeat
      Stream.WriteBuffer(StreamBuffer, iBytesRead);

      hr := OleStreamU.Read(@StreamBuffer, Length(StreamBuffer), @iBytesRead);

    Until iBytesRead <= 0;

    Stream.Position := 0;

    RichEdit.Lines.LoadFromStream(Stream);

    LoadAttachments;
  Finally
    If Assigned(Stream) Then
      FreeAndNil(Stream);
    OleStreamU := nil;
    OleStreamC := nil;
  End;
End;

Procedure TfrmMain.LoadAttachments;
Var
  AttachmentTable: IMAPITable;
  AttCount: ULONG;
  iCount: Integer;
  Attachment: IAttach;
  RowSet: PSRowSet;
  PropValue: PSPropValue;
  ListItem: TListItem;
  NUM: ULONG;

Const
AttachmentPropTagArray: Record
  cValues: ULONG;
  aulPropTag: Array [0 .. 2] Of ULONG;
end
= (cValues: 3;
   aulPropTag:
    (PR_ATTACH_NUM, PR_ATTACH_METHOD,
     PR_RENDERING_POSITION);
  );

SortOrderSet: TSSortOrderSet = (cSorts: 1;
                                cCategories: 0;
                                cExpanded: 0;
                                aSort: (
                                       (ulPropTag: PR_RENDERING_POSITION;
                                       ulOrder: TABLE_SORT_ASCEND)
                                       );
                                );
Begin
  ListView.Items.Clear;

  If Not FPropExists(FMessage, PR_HASATTACH) Or Not GetPropBoolean(FMessage,
    PR_HASATTACH) Then
    Exit;

  AttachmentTable := nil;
  RowSet := nil;
  Attachment := nil;

  Try
    hr := FMessage.GetAttachmentTable(fMapiUnicode, AttachmentTable);
    If failed(hr) Then
      Raise EMAPIError.CreateMAPI(FMessage, hr);

    hr := AttachmentTable.GetRowCount(0, AttCount);
    If failed(hr) Then
      Raise EMAPIError.CreateMAPI(AttachmentTable, hr);

    If AttCount < 1 Then
      Exit;

    // Retrieves all rows of a table.
    hr := HrQueryAllRows(AttachmentTable, @AttachmentPropTagArray, nil,
      @SortOrderSet, 0, RowSet);
    If failed(hr) Then
      Raise EMAPIError.CreateMAPI(AttachmentTable, hr);

    If Not Assigned(RowSet) Or (RowSet.cRows < 1) Then
      Exit;

    For iCount := 0 To RowSet.cRows - 1 Do
    Begin
      ListItem := ListView.Items.Add;

      // PR_ATTACH_NUM
      PropValue := PpropFindProp(RowSet.aRow[iCount].lpProps,
        RowSet.aRow[iCount].cValues, PR_ATTACH_NUM);
      If Assigned(PropValue) Then
      Begin
        NUM := ConvertMAPIPropValueToVariant(PropValue);
        ListItem.Caption := IntToStr(NUM);
        hr := FMessage.OpenAttach(NUM, nil, 0, Attachment);
        If failed(hr) Then
          Raise EMAPIError.CreateMAPI(FMessage, hr);
      End
      Else
        Continue;

      // PR_ATTACH_METHOD
      PropValue := PpropFindProp(RowSet.aRow[iCount].lpProps,
        RowSet.aRow[iCount].cValues, PR_ATTACH_METHOD);
      If Assigned(PropValue) Then
        ListItem.SubItems.Add(GetMAPIPascalString('AttachMethod',
          ConvertMAPIPropValueToVariant(PropValue)))
      Else
        ListItem.SubItems.Add('');

      // PR_RENDERING_POSITION
      PropValue := PpropFindProp(RowSet.aRow[iCount].lpProps,
        RowSet.aRow[iCount].cValues, PR_RENDERING_POSITION);
      If Assigned(PropValue) Then
        ListItem.SubItems.Add(ConvertMAPIPropValueToVariant(PropValue))
      Else
        ListItem.SubItems.Add('');

      ProcessAttachmentForRTF(RichEdit.Handle, Attachment);

      Attachment := nil;
    End;

  Finally
    If Assigned(RowSet) Then
      FreePRows(RowSet);
    Attachment := nil;
    AttachmentTable := nil;
  End;
End;