Отправляем почту из 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('почтовый сервер', 'тема письма', 'имя получателя<[email protected]>', 'имя отправителя<[email protected]>', 'тело письма', '', 'логин', 'пароль') ;
Здесь приведен смысловой код отправки, — в скомпилированном приложении же, — значения берутся из полей ввода.
Далее рассмотрим пример использования скомпилированной мною 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', 'тема письма', 'имя получателя<[email protected]>', 'имя отправителя<[email protected]>', 'тело письма', '', '', '') ; end; end.
Вот и все сложности :)….
Вложения:
скомпилированная библиотека | Программа Spamer | Библиотека synapse40