Отправляем почту из 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

Категория: Delphi,mailto: Из среды Delphi
Теги: , , ,

Оставить комментарий