I'm trying send message from delphi-code use TIdMessage
. The message consists of 2 parts: text/plain
and text/html
.
I have html-page as a template and some large text that need to insert to the template (in special place that was marked as ##text##). After merge the template and the text I get body of my new message. Then I send this message (use TIdMessage
and TIdSMTP
), but in a result the message contain only second part of the text. The text have more 40,000 characters.
When I send message without html-tmplate (only large text) the everything is Ok.
How can I set length of message?
I tried to set FIdMessage.ContentTransferEncoding := 'quoted-printable' and FIdSMTP.MsgLineLength := MAXWORD;
but it did not help me.
Thanks in advance.
Here are some code:
var
FSMTP: TIdSMTP;
FIdMessage: TIdMessage;
idx: integer;
i: Integer;
FIdText: TIdText;
begin
FSMTP := TIdSMTP.Create( nil );
FIdMessage := TIdMessage.Create( nil );
try
try
FIdMessage.ExtraHeaders.Clear;
FIdMessage.MessageParts.Clear;
// Attachments
for idx := 0 to Attachments.Count - 1 do
TIdAttachment.Create( FIdMessage.MessageParts,
TEmailAttachment( Attachments.Items[ idx ] ).FLocalTemplateName );
FIdMessage.From.Text := FFrom;
FIdMessage.Recipients.EMailAddresses := FTo;
FIdMessage.Subject := FSubject;
if (FHtmlTemplateFilePath <> '') then
begin
FIdMessage.ContentType := 'multiparts/related; type="text/html"';
AddAttachements(FIdMessage); // procedure that added Attachments
FIdText := TIdText.Create(FIdMessage.MessageParts, nil);
FIdText.Body.Text := 'Please view a html version of this email';
FIdText.ContentType := 'text/plain';
FIdText := TIdText.Create(FIdMessage.MessageParts, nil);
FIdText.Body.Text := FBody;
FIdText.ContentType := 'text/html';
end
else
begin
FIdMessage.Body.Text := FBody;
end;
FIdMessage.CCList.Clear;
FIdMessage.ReceiptRecipient.Text := '';
FSMTP.AuthenticationType := FSMTPAuthenticationType;
FSMTP.UserID := FSMTPUserID;
FSMTP.Password := FSMTPPassword;
FSMTP.Host := FSMTPHost;
FSMTP.Port := FSMTPPort;
FSMTP.MsgLineLength := MAXWORD;
RepeatRetryCount := FSMTPRepeatRetryCount;
FSMTP.Connect;
try
FSMTP.Send( FIdMessage );
finally
FSMTP.Disconnect;
end;
except
end;
finally
FSMTP.Free;
FIdMessage.Free;
end;
end;
procedure AddAttachements(AIdMessage: TidMessage);
var
LCid: Integer;
LFileName, LFileExt, LSearchFolder: String;
LSearchResult: TSearchRec;
Attachment: TIdAttachment;
begin
FHtmlCids.Clear;
LSearchFolder := ExtractFilePath(FHtmlTemplateFilePath)+ChangeFileExt(ExtractFileName(FHtmlTemplateFilePath),'');
if (FindFirst(LSearchFolder + '_*', faDirectory, LSearchResult)=0) or
(FindFirst(LSearchFolder + '.*', faDirectory, LSearchResult)=0)
then
LSearchFolder := LSearchResult.Name;
FindClose(LSearchResult);
if FindFirst(ExtractFilePath(FHtmlTemplateFilePath)+LSearchFolder+'\*.*', faAnyFile - faDirectory, LSearchResult)=0 then
begin
repeat
Attachment := TIdAttachment.Create(AIdMessage.MessageParts, ExtractFilePath(FHtmlTemplateFilePath)+ LSearchFolder + '\' + LSearchResult.Name);
LCid := Random(MaxInt);
Attachment.ExtraHeaders.Values['Content-ID'] := IntToStr(LCid);
LFileName := ExtractFileName(LSearchResult.Name);
LFileExt := ExtractFileExt(LSearchResult.Name);
if UpperCase(LFileExt) = '.XML' then
Attachment.ContentType := 'text/xml'
else if UpperCase(LFileExt) = '.PNG' then
Attachment.ContentType := 'image/png'
else if UpperCase(LFileExt) = '.THMX' then
Attachment.ContentType := 'application/vnd.ms-officetheme'
else if UpperCase(LFileExt) = '.JPG' then
Attachment.ContentType := 'image/jpeg'
else if UpperCase(LFileExt) = '.GIF' then
Attachment.ContentType := 'image/gif'
else if UpperCase(LFileExt) = '.SVG' then
Attachment.ContentType := 'image/svg+xml'
else if UpperCase(LFileExt) = '.TIF' then
Attachment.ContentType := 'image/tiff'
else if UpperCase(LFileExt) = '.TIFF' then
Attachment.ContentType := 'image/tiff'
else if UpperCase(LFileExt) = '.ICO' then
Attachment.ContentType := 'image/vnd.microsoft.icon'
else if UpperCase(LFileExt) = '.BMP' then
Attachment.ContentType := 'image/bmp'
else if UpperCase(LFileExt) = '.CSS' then
Attachment.ContentType := 'text/css'
else if UpperCase(LFileExt) = '.JS' then
Attachment.ContentType := 'application/javascript'
else if UpperCase(LFileExt) = '.JPEG' then
Attachment.ContentType := 'image/jpeg'
else if UpperCase(LFileExt) = '.WMZ' then
Attachment.ContentType := 'application/x-ms-wmz'
else raise Exception.CreateFmt('Unknown file type "%s"', [LFileExt]);
FHtmlCids.AddObject(LSearchFolder+'/'+LFileName, TObject(LCid));
FHtmlCids.AddObject(UrlEncode(LSearchFolder+'/'+LFileName), TObject(LCid));
until FindNext(LSearchResult)<>0;
FindClose(LSearchResult);
end;
FHtmlCids.Sort;
end;