Development

Request # 18

Signed Extended MAPI messages (digitally signed email)

This example shows how you can decode digitally signed email.

Code snip:

Function GetIsSigned(const MAPIMessage: ExtendedMAPI.IMessage): boolean;
var
  hr: hresult;
  Named: TMAPINAMEID;
  PropTags: PSPropTagArray;
  PropNamed: Array [0 .. 0] Of PMAPINAMEID;
  PropTag: ULONG;
  MessageClass: string;
const
  SecGUID: TGUID = '{41F28F13-83F4-4114-A584-EEDB5A6B0BFF}';
Begin
  Result := False;
  Named.lpguid := @SecGUID;
  Named.ulKind := MNID_STRING;
  Named.Kind.lpwstrName := PWideChar(WideString('IsSigned'));
  PropNamed[0] := @Named;

  PropTags := nil;
  try
    hr := MAPIMessage.GetIDsFromNames(1, @PropNamed, 0, PropTags);
    if (hr <> S_OK) or not Assigned(PropTags) or (PropTags.cValues <> 1) then
      Exit;

    PropTag := CHANGE_PROP_TYPE(PropTags.aulPropTag[0], PT_BOOLEAN);
    Result := GetPropBoolean(MAPIMessage, PropTag);

  finally
    if Assigned(PropTags) then
      MAPIFreeBuffer(PropTags);

    if not Result then
    begin
      MessageClass := GetPropString(MAPIMessage, PR_MESSAGE_CLASS);
      Result := AnsiContainsText(MessageClass, '.SMIME') or AnsiContainsText(MessageClass, '.SECURE.SIGN')
    end;

  end;
End;


procedure TfrmMain.btGetSignedStreamClick(Sender: TObject);
var
  Table: IMAPITable;
  Restriction: TSRestriction;
  RestrictionOne: array [0 .. 1] of TSRestriction;
  KeyPropOne: TSPropValue;
  Count: ULONG;
  RowSet: PSRowSet;
  ATTACH_NUM: Integer;
  PropValue: PSPropValue;
  Atachment: IAttach;
  Stream: IStream;
  OleStream: TOleStream;
  P: PByte;
  VarBArray: OleVariant;
  MemoryStream: TMemoryStream;
  oST: OleVariant; // ADODB.Stream
const
  TableColumn: record
    cValues: ULONG;
    aulPropTag: array [0 .. 5] of ULONG;
  end  = (cValues: 6;
          aulPropTag: (
                       PR_ATTACH_NUM,
                       PR_ATTACH_CONTENT_ID,
                       PR_ATTACH_LONG_FILENAME,
                       PR_ATTACH_FILENAME,
                       PR_ATTACH_MIME_TAG_W,
                       PR_ATTACH_CONTENT_LOCATION);
          );
begin
  Table := nil;
  RowSet := nil;
  OleStream := nil;
  Stream := nil;
  MemoryStream := nil;
  try
    // Process attach
    hr := FMAPIMessage.GetAttachmentTable(0, Table);
    if failed(hr) then
      raise EMAPIError.CreateMAPI(FMAPIMessage, hr);
    hr := Table.SetColumns(@TableColumn, TBL_BATCH);
    if failed(hr) then
      raise EMAPIError.CreateMAPI(Table, hr);

    KeyPropOne.ulPropTag := PR_ATTACH_MIME_TAG_W;
    // application/pkcs7-mime
    // multipart/signed
    KeyPropOne.Value.lpszW := PWideChar(WideString('multipart/signed'));

    RestrictionOne[0].rt := RES_EXIST;
    RestrictionOne[0].res.resExist.ulPropTag := PR_ATTACH_MIME_TAG;
    RestrictionOne[0].res.resExist.ulReserved1 := 0;
    RestrictionOne[0].res.resExist.ulReserved2 := 0;

    RestrictionOne[1].rt := RES_PROPERTY;
    RestrictionOne[1].res.resProperty.relop := RELOP_EQ;
    RestrictionOne[1].res.resProperty.ulPropTag := PR_ATTACH_MIME_TAG_W;
    RestrictionOne[1].res.resProperty.lpProp := @KeyPropOne;

    Restriction.rt := RES_AND;
    Restriction.res.resAnd.cRes := 2;
    Restriction.res.resAnd.lpRes := @RestrictionOne;

    // apply restriction
    hr := Table.Restrict(@Restriction, 0);
    if failed(hr) and (hr <> MAPI_E_NO_SUPPORT) then
      raise EMAPIError.CreateMAPI(Table, hr);
    hr := Table.GetRowCount(0, Count);
    if failed(hr) then
      raise EMAPIError.CreateMAPI(Table, hr);
    if Integer(Count) <> 1 then // There should be only One signed attachement
      Exit;

    hr := Table.QueryRows(1, 0, RowSet);
    If failed(hr) or (Assigned(RowSet) and (RowSet.cRows = 0)) Then
      Exit;

    // Get ATTACH_NUM
    PropValue := PpropFindProp(RowSet.aRow[0].lpProps, RowSet.aRow[0].cValues, PR_ATTACH_NUM);
    if not Assigned(PropValue) then
      Exit;
    ATTACH_NUM := PropValue.Value.L;

    // Open Attachment
    hr := FMAPIMessage.OpenAttach(ATTACH_NUM, @IID_IAttachment, MAPI_BEST_ACCESS, Atachment);
    if failed(hr) then
      raise EMAPIError.CreateMAPI(FMAPIMessage, hr);

    hr := Atachment.OpenProperty(PR_ATTACH_DATA_BIN, @IID_IStream, 0, 0, IUnknown(Stream));
    if failed(hr) then
      raise EMAPIError.CreateMAPI(Atachment, hr);

    OleStream := TOleStream.Create(Stream); // where FStream is IStream

    Memo.Lines.LoadFromStream(OleStream);

    OleStream.Position := 0;

    // you can open eml file with Outlook Express!
    (*
     with TMemoryStream.Create do
     begin
        LoadFromStream(OleStream);
        SaveToFile('c:\test.eml');
        free
     end;
    *)

    OleStream.Position := 0;

    oCDO := CreateOleObject('CDO.Message');
    oST := CreateOleObject('ADODB.Stream');
    oST := oCDO.GetStream;
    oST.Type := 1;

    MemoryStream := TMemoryStream.Create;
    MemoryStream.LoadFromStream(OleStream);
    MemoryStream.Position := 0;

    VarBArray := VarArrayCreate([0, MemoryStream.Size - 1], varByte);
    P := VarArrayLock(VarBArray);
    try
      Move(MemoryStream.Memory^, P^, MemoryStream.Size);
    finally
      VarArrayUnlock(VarBArray);
    end;

    oST.Write(VarBArray);

    oST.Flush;

    btShowMIMEMessage.Enabled := True;
  finally
    if Assigned(OleStream) then
      FreeAndNil(OleStream);

    if Assigned(MemoryStream) then
      FreeAndNil(MemoryStream);

    if Assigned(RowSet) then
      FreeProws(RowSet);
    Stream := nil;
    Atachment := nil;
  end;
 end;