Создание ActiveX SMTP клиента в Delphi 7

В какой-то момент на свет белый вылезла задача написания Active X DLL для отсылки писем через корпоративный почтовый сервер.Неоходимо было при регистрации пользователя на сайте компании отослать ему ключевое слово для проверки валидности введённого им почтового адреса. Иными словами, при регистрации пользователя ASP-форма предлагает ввести адрес его электронной почты, на которую затем высылается пароль и ссылка на продолжение регистрации. ASP-форма при этом создаёт экземпляр класса из ActiveX библиотеки, который и отсылает письмо.

Библиотека была реализована в Delphi 7. Этапы написания приведены ниже. Архив с исходниками и примерами использования можно скачать здесь.

Идём в File->New->Other

 

 На появившейся форме открываем вкладку Active X. Из списка выбираем ActiveX Library.

Называем разрабатываемую библиотеку “MailClient”. Снова идём в File->New->Other

Выбираем Automation Object.
Вываливаемся в формочку:

Вводим CoClass Name. Пусть будет “SMTP”. Остальное оставляем, как есть.
Нажимаем ОК. Переходим в форму Type Library.

 Впоследствии эту форму можно открыть, выбрав в главном меню: View->Type Library.
Здесь вводим имена и типы свойств для интерфейса ISMTP. Оставляем только свойства на запись. На чтение - нам не нужны. Кроме того, создаём один метод: “SendEmail”. Нажимаем кнопку “Refresh”. Это обновит объявления свойств и методов в модуле “unit1”. Переименуем его в “SMTP”.

 Далее, в код модуля SMTP добавляем переменные и вставляем тела процедур установки свойств и тело функции SendMail. Кроме того, для корректной работы с русским языком добавляем процедуру: MsgInitializeISO. Она будет использоваться событием OnInitializeISO объекта класса TIdSMTP. Это обеспечит нормальное отображение заголовка письма.

В результате код модуля “SMTP” будет выглядеть следующим образом:

unit SMTP;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, MailClient_TLB, StdVcl, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdMessageClient, IdPOP3, IdMessage, IdSMTP, IdCoderHeader;

type
  TSMTP = class(TAutoObject, ISMTP)
  IdMessage: TIdMessage;
  SMTP: TIdSMTP;
  sEmailMessage: WideString;
  sEmailFrom: WideString;
  sEmailHost: WideString;
  sEmailSubject: WideString;
  sEmailTo: Wide
String;
  procedure MsgInitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: String);
  protected
  procedure SendEmail; safecall;
  procedure Set_EmailFrom(const Value: WideString); safecall;
  procedure Set_EmailHost(const Value: WideString); safecall;
  procedure Set_EmailMessage(const Value: WideString); safecall;
  procedure Set_EmailSubject(const Value: WideString); safecall;
  procedure Set_EmailTo(const Value: WideString); safecall;
  end;

implementation


uses ComServ;

procedure TSMTP.SendEmail;
var
  LSMTP: TIdSMTP;
  LMsg: TIdMessage;

begin

  LSMTP := TIdSMTP.Create(nil); //Ñîçäàåìñÿ
  LMsg := TIdMessage.Create(LSMTP);
  with LMsg do

  begin
  OnInitializeISO:=MsgInitializeISO;
  ContentType:='text/html; charset=windows-1251';
  Subject := sEmailSubject; // Çäåñü ââîäèì òåìó
  Recipients.EMailAddresses := sEmailTo; // Ïðèíèìàòåëü
  From.Text := sEmailFrom; // Îòñûëàòåëü
  Body.Clear();
  Body.Add(sEmailMessage);
  end;
  with LSMTP do
  begin
  AuthenticationType:=atNone;
  Host := sEmailHost;
  Port := 25;
  try
  Connect;
  Send(LMsg);
  except
  end;
  end;
  FreeAndNil(LMsg);
  FreeAndNil(LSMTP);
end;

procedure TSMTP.Set_EmailFrom(const Value: WideString);
begin
  sEmailFrom:=Value;

end;

procedure TSMTP.Set_EmailHost(const Value: WideString);
begin
  sEmailHost:=Value;
end;

procedure TSMTP.Set_EmailMessage(const Value: WideString);
begin
  sEmailMessage:=Value;
end;

procedure TSMTP.Set_EmailSubject(const Value: WideString);
begin
  sEmailSubject:=Value;
end;

procedure TSMTP.Set_EmailTo(const Value: WideString);
begin
  sEmailTo:=Value;
end;

procedure TSMTP.MsgInitializeISO(var VTransferHeader: TTransfer;
  var VHeaderEncoding: Char; var VCharSet: String);
begin
 VCharSet := 'windows-1251';
 VHeaderEncoding := 'B';
end;

initialization
  TAutoObjectFactory.Create(ComServer, TSMTP, Class_SMTP,
  ciMultiInstance, tmApartment);
end.

Если Ваш SMTP сервер требует аутентификации, то строчку
 AuthenticationType:=atNone;
В процедуре
 SendMail
Меняем на 
 Username :='Ваш_логин' ;
 Password :='Ваш_ пароль' ; 
 AuthenticationType:=atLogin;


Теперь собираем dll и регистрируем её в системе, используя regsvr32.

Текст простейшей ASP-страницы, использующей данный объект выглядит следующим образом:
<%
dim objEmail 

  Set objEmail = Server.CreateObject("MailClient.SMTP") 
  with objEmail
  .EmailHost ="smtp.mail.ru"
  .EmailFrom = "post_from@mail.ru"
  .EmailTo ="post_to@mail.ru"

  .EmailSubject = "Привет"
  .EmailMessage = "Глубокоуважаемый!"
  .SendEmail  
  End With
  Set objEmail = Nothing
  Response.Write "Послано"
end if
%>


Коротаевский Андрей








Rambler's Top100 Рейтинг@Mail.ru

mdls.ru © 2008-2013

НОВОСТИ
03.04.2014
Проект "ЧПУ на Ардуино" перенесён на ecnc.ru
Открытый проект "Простой станок с ЧПУ на Ардуино" перенесён на http://ecnc.ru
25.01.2013
Опубликован сайт "Частный переводчик"
Частный переводчик поможет провести переговоры, осуществит последовательный, синхронный, письменный переводы. http://tran.mdls.ru
25.01.2013
Начата раработка открытого проекта "Станок с ЧПУ"
Как сделать простой станок с ЧПУ на базе Arduino стоимостью менее 100$ своими руками. http://cnc.mdls.ru.
25.10.2011
"Юристы помогают" перенесён на lawshelp.ru
Проведена смена домена urist.mdls.ru на lawshelp.ru. Теперь обсудить задачи из любых отраслей Права можно на сайте www.lawshelp.ru