Отправляем почту из Delphi
07.11.2016Многие наверняка «наступали на грабли» с необходимостью отправить почту из delphi.
TNM-компоненты, Indy и прочие схожие наверняка были опробованы.
В этой заметке расскажу о более универсальном способе..
Отложим в дальний угол Indy и ему подобные компоненты.
К чему использовать тяжелые компоненты, когда есть легкий и более стабильный в использовании Synapse.
В отличии от Indy, synapse так же работает с сокетами, но проект с его использованием меньше по весу примерно на 20-30%.
Synapse является бесплатной, без ограничений на коммерческое использование, библиотекой с BSD лицензией.
Это не визуальный компонент, представляющий собой набор различных модулей в текстовом виде.
В конце статьи вы сможете взять саму скомпилированную программу отправки почты, компоненнт synapse и скомпилированную библиотеку.
Приложенная программа была скомпилирована для моих нужд, поэтому, если вы будете ее использовать, вам прийдется постоянно менять зашитый адрес почтового сервера.
В ниже приложенной программе реализована возможность Drag-and-drop прикрепления файлов. Эта функция не используется в приложенной динамической библиотеке, поскольку компонент используемый для прикрепления файлов может быть другим или иметь другое имя.

Для отправки почты потребуется вводить имя и адрес получателя, имя и адрес отправителя, тему, само тело письма, возможные вложения, адрес почтового сервера и пару логин/пароль, если того требует для отправки почты сервер.
Но прежде всего необходимо сообщить нашему приложению, что будет использоваться synapse, о чем и продекларируем в разделе uses внеся туда необходимые модули httpsend,mimemess, mimepart, smtpsend,synachar.
И вот такой будет код :
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,httpsend, StdCtrls, mimemess, mimepart, smtpsend,synachar, ComCtrls, ShellCtrls,ShellAPI, PrViewEh, ExtCtrls, acPNG, ImgList;
Как видите тут присутсвуют и несколько других модулей — они понадобятся для прикрепления файлов.
Для реализации прикрепления файлов методом Drag-and-drop опишем процедуру, которая будет задействована для этого. Не буду подробно расписывать назначение каждой строки.. тут, как говорится, RTFM…
Для прикрепления файлов я использовал ListView. При необходимости разобраться в этой процедуре не сложно.
procedure TFormP.WMDROPFILES(var FMsg: TMessage);
var
ii,i, amount, size: integer;
fn,Filename: PChar;
shinfo : SHFILEINFO;
ico : TIcon;
begin
put:='p';
inherited;
Amount := DragQueryFile(FMsg.WParam, $FFFFFFFF, Filename, 255);
for i := 0 to (Amount - 1) do
begin
size := DragQueryFile(FMsg.WParam, i, nil, 0) + 1;
Filename := StrAlloc(size);
DragQueryFile(FMsg.WParam, i, Filename, size);
SHGetFileInfo(Filename, 0, shinfo, SizeOf(shinfo), SHGFI_ICON or SHGFI_SMALLICON);
ico := TIcon.Create;
ico.Handle := shinfo.hIcon;
ii:=ImageList1.AddIcon(ico);
ico.Free;
With ListView1.Items.Add do
begin
fn:= Pchar(ExtractFileName(Filename));
Caption:=StrPas(fn);
ImageIndex :=ii;
SubItems.Values[put]:= Filename;
end;
StrDispose(Filename);
end;
DragFinish(FMsg.WParam);
end;
С мспользованием этой процедуры в обозначенный компонент ListView будут перетаскиванием мышью помещаться отправляемые файлы.
Теперь настала очередь процедуры отвечающей за формирование письма и массива вложений.
Procedure SendMail (Host, Subject, pTo, From , TextBody,
HTMLBody, login,password : string);
var Msg : TMimeMess; // сообщение
StringList : TStringList; // содержимое письма
MIMEPart : TMimePart; // части сообщения (на будущее)
begin
Msg := TMimeMess.Create; // создаем новое сообщение
IdealCharsets:=[CP1251];
Msg.Header.CharsetCode:=CP1251; // Установим кодировку заголовков CP1251;
StringList := TStringList.Create;
try
// Добавляем заголовки
Msg.Header.Subject := Subject;// тема сообщения
Msg.Header.From := From; // имя и адрес отправителя
Msg.Header.ToList.Add(pTo); // имя и адрес получателя
// создаем корневой элемент
MIMEPart := Msg.AddPartMultipart('mixed', nil);
if length(TextBody)=0 then
// если формат HTML
begin
StringList.Text := HTMLBody;
Msg.AddPartHTML(StringList, MIMEPart);
end
else
// если текстовый формат
begin
StringList.Text := TextBody;
Msg.AddPartText(StringList, MIMEPart);
end;
// добавление файлов во вложение
try
for j := 0 to formp.listview1.Items.Count - 1 do
begin
Msg.AddPartBinaryFromFile(formp.listview1.Items[j].SubItems.Values[put],MIMEPart);
end;
except
end;
// Кодируем и отправляем
Msg.EncodeMessage;
// Отправляем.
if smtpsend.SendToRaw(From,pTo,Host,Msg.Lines,login,password) then
ShowMessage('Письмо отправлено')
else
ShowMessage('Письмо не отправлено');
finally
Msg.Free;
StringList.Free;
end;
end;
И собственно отправка письма выполняется следующим образом:
SendMail('почтовый сервер',
'тема письма',
'имя получателя<login@domen.ru>',
'имя отправителя<noreply@myla.net>',
'тело письма',
'',
'логин', 'пароль') ;
Здесь приведен смысловой код отправки, — в скомпилированном приложении же, — значения берутся из полей ввода.
Далее рассмотрим пример использования скомпилированной мною DLL.
Она полностью построена на коде synapse и вызов процедуры особо не отличается.. Приведу код полностью.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure SendMail (Host, Subject, pTo, From , TextBody,
HTMLBody, login,password : string); stdcall; external 'synamail.dll';
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMail('сервер smtp',
'тема письма',
'имя получателя<login@domen.ru>',
'имя отправителя<noreply@myla.net>',
'тело письма',
'',
'', '') ;
end;
end.
Вот и все сложности :)….
Вложения:
скомпилированная библиотека | Программа Spamer | Библиотека synapse40