Создание 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: WideString;
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
%>
Коротаевский Андрей