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;