Добрый день!
Вот уже который день никак не могу решить следующую проблему.
Отсылаю в программе письма используя компоненты TIdSMTP и TIdMessage.
Версия Indy 10.1.5.0, Delphi 7. Пытаюсь сделать прогрессбар отправки письма.
Но до адресатов доходят пустые письма (указана только тема). Тело письма и вложения просто пропадают. Причем если не использовать процедуры отображения прогрессбара данной проблемы не наблюдается, письма доходят в таком ввиде как я их отсылаю.
Код процедуры отправки и процедур отображения прогрессбара привожу ниже.
Код процедуры отправки письма:
function TFormEmailSend.SendCallToAssistent(AttachmentFile:string):boolean;
var OperatorName,AssistentName,AssistemtMail:string;
attf:TIdAttachmentFile;
idtTextPart: TIdText;
i,j:integer;
tmpstr:string;
begin
MailMessage.Clear;
MailMessage.OnInitializeISO:= MailMessageInitializeISO;
MailMessage.ContentType := 'Multipart/Alternative';
MailMessage.CharSet:='windows-1251';
MailMessage.Date := Now;
MailMessage.From.Address:=’ адрес отправителя’;
MailMessage.Recipients.EMailAddresses:=’ адрес получателя’;
MailMessage.Subject:=’ тема сообщения’;
MailMessage.Priority:=IdMessage.mpHighest;
MailMessage.ReceiptRecipient.Address:= ’отчет о доставке ';
try
//тело сообщения
idtTextPart := TIdText.Create(MailMessage.MessageParts, nil);
idtTextPart.ContentType := 'text/plain';
idtTextPart.CharSet := 'windows-1251';
//тело письма
for i:=0 to FormEmailSetup.MemoMailBody.Lines.Count-1 do
begin
tmpstr:=FormEmailSetup.MemoMailBody.Lines[i];
idtTextPart.Body.Add(tmpstr);
end;
//формирование вложения
if FileExists(AttachmentFile) then attf:=TIdAttachmentFile.Create(MailMessage.MessageParts,AttachmentFile);
attf.ContentType := 'application/zip';
//подключение к серверу для отправки сообщения
SMTP.Connect;
if SMTP.Connected then
try
SMTP.Send(MailMessage);
except on E:Exception do
ShowMessage('Статус отправки: ERROR - '+E.Message,true);
end
finally
SMTP.Disconnect;
attf.Free;
idtTextPart.Free;
end;
end;
Процедуры отображения хода отправки письма:
procedure TFormEmailSend.SMTPWorkBegin(ASender: TObject;
AWorkMode: TWorkMode; AWorkCountMax: Int64);
var S: TMemoryStream;
begin
if AWorkMode = wmWrite then
begin
S := TMemoryStream.Create;
try
MailMessage.SaveToStream(S, False);
GaugeProgress.MaxValue := S.Size;
S.Clear;
MailMessage.SaveToStream(S, True);
GaugeProgress.MaxValue := GaugeProgress.MaxValue - S.Size;
отправки
GaugeProgress.Progress:=0;
finally
S.Free;
end;
end;
end;
procedure TFormEmailSend.SMTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
if AWorkMode = wmWrite then GaugeProgress.Progress:=AWorkCount;
end;
procedure TFormEmailSend.SMTPWorkEnd(ASender: TObject;
AWorkMode: TWorkMode);
begin
if AWorkMode = wmWrite then GaugeProgress.Progress:= GaugeProgress.MaxValue;
end;
Письма доходят без вложений и тела письма после выполнения процедуры SMTPWorkBegin, а именно MailMessage.SaveToStream(S, False);
Пожалуйста помогите советом, как это исправить, заранее огромное человеческое спасибо.