MAPI Mailversand mit TB und Delphi 7

[Frickler]

Zitat von himitsu:

Wir sind inzwischen auf die Erstellung von *.eml mittels INDY umgestiegen,
anschließend werden sie im StandardMail-Programm geöffnet
und über ein Flag im Header (X-Unsent) wurde angegeben, dass diese Mail neu ist und somit versendet werden soll.

Geht die Mail damit direkt weg, oder muss man die Mail selbst absenden (um kann ggfs zuvor noch was korrigieren) wie bei MAPI?

[himitsu]

Zitat von Frickler:

Geht die Mail damit direkt weg, oder muss man die Mail selbst absenden (um kann ggfs zuvor noch was korrigieren) wie bei MAPI?

Nee, sie wird im Senden-Fenster des Standardmail-Programms geöffnet und man muß auf senden klicken. (aber das wollen wir ja so haben)


Da Outlook mal wieder vor kurzem bissl was geändert hat, mußten wir bissl umbauen.
Multipart-Mails mit Formatierung und Anhänge ... da hatten die was verändert und beim Laden der Mail wurden die Anhänge plötzlich ignoriert.

Wir nutzen TIdMessage, um die Mail zu generieren.
Als EML via ShellExecute lässt sich in der MailApp öffnen und dann senden
oder sie ließe sich über TIdSMP direkt versenden.

Delphi-Quellcode:

function TCimSendMail.ExecuteWithEML: Boolean;
var
  _SL          : TStringList;
  _IdMsg       : TIdMessage;
  _Idx         : Integer;
  _FileName    : String;
  _Addresses   : TStringList;

  _MsgPartBody : TIdText;

  _Matches     : TMatchCollection;
  _Match       : TMatch;
  _Group       : TGroup;
  _IdxM        : Integer;
  _AttLnk      : TIdAttachmentFile;
  _Pair        : TPair<String, TCimSendMail.TAttachmentLink>;

  _IdxRelated     : Integer;
  _IdxAlternative : Integer;

  function ContentIdgenerate: String;
  begin
    Result := Format('%s%s', [IntToHex(Random(MaxInt), 4), IntToHex(Random(MaxInt), 4)]);
  end;

  procedure _LinkMsgPart(const AGroup: TGroup; const AMsgPart: TIdAttachmentFile; const ADisplayname: String);
  begin
    Self.BodyText := Copy(Self.BodyText, 1, AGroup.Index - 1) + AMsgPart.ContentID + Copy(Self.BodyText, AGroup.Index + AGroup.Length, System.MAXINT);

    if (not (ADisplayname = '')) then
      AMsgPart.Name := ADisplayname;
  end;

begin
  // Compose Email mittels Indy
  _IdMsg := TIdMessage.Create(nil);
  _IdMsg.Subject := Subject;
  _Addresses := TStringList.Create;
  try
    ExtractList(MailTo, _Addresses, [',', ';'], False, False);

    for _Idx := 0 to _Addresses.Count - 1 do
    begin
      if Pos(' ', _Addresses[_Idx]) > 0 then
        raise Exception.Create(makeText(13207) // "EMail-Adresse darf keine Leerzeichen enthalten. Bitte prüfen Sie die Stammdaten der Adresse oder des Ansprechpartners."
                               + slinebreak
                               + 'Email: "'
                               + _Addresses[_Idx] + '"');
       _IdMsg.Recipients.Add.Address := Trim(_Addresses[_Idx]);
    end;

    // for linked message-parts (within the email) we need it set to mixed/related !!!
    // this will then clash with attachments, which are not related
    // https://redmine.prodat-sql.de/issues/22117
    // https://borland.public.delphi.internet.winsock.narkive.com/26JN1s0l/tidmessage-nested-parts
    _IdMsg.ContentType := 'multipart/mixed; charset=UTF-8;';

    _SL := TStringList.Create;
    try
      // this allows to prepare the linked attachments: TFormDokments._PrepareCimEmailLinkedAttachments
      if (Assigned(FOnBeforeEMLAddAttachments)) then
        FOnBeforeEMLAddAttachments(Self);


      with TIdText.Create(_IdMsg.MessageParts, NIL) do
      begin
        ContentType := 'multipart/alternative';

        _IdxAlternative := Index;
      end;

      _SL.Add(BodyText);
      with TIdText.Create(_IdMsg.MessageParts, _SL) do
      begin
        ContentType := 'text/plain';
        ParentPart  := _IdxAlternative;
      end;
      _SL.Clear;

      // Zeilenumbrueche mit HTML Tags ersetzen
      BodyText := StringReplace(BodyText, sLineBreak, '<br />', [rfReplaceAll, rfIgnoreCase]);
      BodyText := StringReplace(BodyText,        #$A, '<br />', [rfReplaceAll, rfIgnoreCase]);

      with TIdText.Create(_IdMsg.MessageParts, NIL) do
      begin
        ContentType := 'multipart/related; type="text/html"';
        ParentPart  := _IdxAlternative;

        _IdxRelated := Index;
      end;

      _MsgPartBody := TIdText.Create(_IdMsg.MessageParts, NIL);
      _MsgPartBody.ContentType := 'text/html';
      _MsgPartBody.CharSet     := 'UTF-8';
      _MsgPartBody.ParentPart  := _IdxRelated;

      // replace the src="cid:" with the correct cid's inside the emailbody of the lniked attachment
      for _Pair in AttachmentsLinked do
      begin
        _AttLnk := TIdAttachmentFile.Create(_IdMsg.MessageParts, _Pair.Value.SourceFilename);
        _AttLnk.ContentID  := Format('%d_attlnk_%s', [_Idx, ContentIdgenerate]);
        _AttLnk.ParentPart := _IdxRelated;

        // we need to actually call it for each Pair !!!
        _Matches := TRegEx.Matches(BodyText, CATTLNK_REGEX, [roIgnoreCase]);
        try
          for _IdxM := _Matches.Count - 1 downto 0 do
          begin
            _Match := _Matches.Item[_IdxM];
            _Group := _Match.Groups.Item[CATTLNK_LINK];

            if ((_Match.Groups.Count = CATTLNK_GRPCNT) and _Group.Success and _Match.Groups.Item[CATTLNK_TYPE].Success) then
            begin
              // even if a MDS-Link and a File-Link are present, which point to the same sourcefile
              // there can be only one entry in Self.AttachmentsLinked for both
              // thats why we do a string check again instead of TAttachmentLinkSource
              // see TCimSendMail.AddAttachmentLinked
              if (SameText(CATTLNK_TYPE_DMS, _Match.Groups.Item[CATTLNK_TYPE].Value)) then
              begin
                if (SameText(_Pair.Value.ID, _Match.Groups.Item[CATTLNK_ID].Value)) then
                  _LinkMsgPart(_Group, _AttLnk, _Pair.Value.DisplayFilename);
              end
              else if (SameText(CATTLNK_TYPE_FILE, _Match.Groups.Item[CATTLNK_TYPE].Value)) then
              begin
                if (SameText(_Pair.Value.SourceFilename, _Match.Groups.Item[CATTLNK_ID].Value)) then
                  _LinkMsgPart(_Group, _AttLnk, _Pair.Value.DisplayFilename);
              end;
            end;
          end;
        finally
          Finalize(_Matches);
        end;
      end;
      CheckWarnLinkedAttachments(True);

      _SL.Add('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">');
      _SL.Add('<meta http-equiv="Content-Type" content="text/html; charset="UTF-8" />');
      _SL.Add('<html><head>');
      _SL.Add(Format('<title>%s</title>', ['Title']));
      _SL.Add('</head><body>');
      _SL.Add(Format('<div>%s</div>', [BodyText]));
      _SL.Add('</body></html>');
      // assign the message text
      _MsgPartBody.Body := _SL;

      for _Idx := 0 to Length(Attachments) - 1 do
      begin
        with TIdAttachmentFile.Create(_IdMsg.MessageParts, Attachments[_Idx]) do
          ContentID  := Format('%d_attach_%s', [_Idx, ContentIdgenerate]);
      end;
    finally
      FreeAndNIL(_SL);
    end;

    // Wichtig ist dabei einzig und allein der X-Header (damit es als eine neue, zu sendende EMail verarbeitet wird): X-Unset
    _IdMsg.Headers.Add('X-Unsent: 1');

    // Save to file
    _FileName := Format('%s\%s.eml', [CurrentSession_UConstants.Path_MailTemp, ContentIdgenerate]);
    ForceDirectories(ExtractFilePath(_FileName));
    _IdMsg.SaveToFile(_FileName);

    // Mark file for delete on reboot/logout
    DeleteFileOnShutdown(_FileName);

    try
      // 'Open' file -> Default Email Client will open
      DoExecute(0, _FileName, '', 'open', False);
      Result := True;
    except
      on E: Exception do
        RaiseError(E.Message);
    end;
  finally
    _Addresses.Free;
    _IdMsg.Free;
  end
end;

[Frickler]

Danke! Ich werds damit mal probieren. Ich mache das bislang auch per (Simple-)MAPI, und da gehen einige Dinge nicht mehr so gut.

Nachtrag: scheint gut zu funktionieren. Für den Text samt Anhängen verwende ich IdMessageBuilder, wie hier (https://stackoverflow.com/questions/...232252#8232252) beschrieben.