Глубины Indy. 2. Техническая поддержка

• Название: 2. Техническая поддержка
• Дата: 02.05.2018
• Размер: 1.03 Mb.
• Имя файла: Глубины Indy.pdf
• Тип: Документы; #42664
• страница: 16 из 16

Try
LStream.CopyFrom(AMsg,
0
);
Finally
FreeAndNil(LStream);
End
;
LMsg := TIdMessage.Create;
Try
LMsg.LoadFromFile(ExtractFilePath(Application.exename) +
'test.eml'
, False);
ToLabel.Caption := LMsg.Recipients.EMailAddresses;
FromLabel.Caption := LMsg.From.Text;
SubjectLabel.Caption := LMsg.Subject;
Memo1.Lines := LMsg.Body;
Finally
FreeAndNil(LMsg);
End
;
end
;
procedure
TForm1.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
const
AAddress:
String
;
var
VAction: TIdRCPToReply;
var
VForward:
String
);
begin
// Here we are testing the RCPT TO lines sent to the server.
// These commands denote where the e-mail should be sent.
// RCPT To address comes in via AAddress. VAction sets the return action to
the server.
// Here, you would normally do:
// Check if the user has relay rights, if the e-mail address is not local
// If the e-mail domain is local, does the address exist?
// The following actions can be returned to the server:
{
rAddressOk, //address is okay
rRelayDenied, //we do not relay for third-parties
rInvalid, //invalid address
rWillForward, //not local - we will forward
rNoForward, //not local - will not forward - please use
rTooManyAddresses, //too many addresses
rDisabledPerm, //disabled permentantly - not accepting E-Mail
rDisabledTemp //disabled temporarily - not accepting E-Mail
}
// For now, we will just always allow the rcpt address.
VAction := rAddressOk;
end
;
procedure
TForm1.IdSMTPServer1UserLogin(ASender: TIdSMTPServerContext;
const
AUsername, APassword:
String
;
var
VAuthenticated: Boolean);
begin
// This event is fired if a user attempts to login to the server
// Normally used to grant relay access to specific users etc.

123
VAuthenticated := True;
end
;
procedure
TForm1.IdSMTPServer1MailFrom(ASender: TIdSMTPServerContext;
const
AAddress:
String
;
var
VAction: TIdMailFromReply);
begin
// Here we are testing the MAIL FROM line sent to the server.
// MAIL FROM address comes in via AAddress. VAction sets the return action
to the server.
// The following actions can be returned to the server:
{ mAccept, mReject }
// For now, we will just always allow the mail from address.
VAction := mAccept;
end
;
procedure
TForm1.IdSMTPServer1Received(ASender: TIdSMTPServerContext;
AReceived:
String
);
begin
// This is a new event in the rewrite of IdSMTPServer for Indy 10.
// It lets you control the Received: header that is added to the e-mail.
// If you do not want a Received here to be added, set AReceived := '';
// Formatting 'keys' are available in the received header -- please check
// the IdSMTPServer source for more detail.
end
;
end
Пример создания и отправки текстового сообщения (Indy 10)
Небольшой пример иллюстрирует отправку заранее подготовленного сообщения через указанный SMTP сервер.
unit
Main;
interface
uses
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
SysUtils, Classes, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdMessageClient, IdSMTPBase, IdSMTP;
type
TformMain =
class
(TForm) memoMsg: TMemo;
Panel1: TPanel;
Label1: TLabel; editFrom: TEdit;
Label2: TLabel; editTo: TEdit;
Label3: TLabel; editSubject: TEdit;
Label4: TLabel; editSMTPServer: TEdit; butnSendMail: TButton; lboxStatus: TListBox; smtpSendMail: TIdSMTP; mesgMessage: TIdMessage;
procedure
butnSendMailClick(Sender: TObject);
procedure
FormCreate(Sender: TObject);

124
procedure
smtpSendMailStatus(ASender: TObject;
const
AStatus: TIdStatus;
const
AStatusText:
String
);
private
public
procedure
Status(AMsg:
string
);
end
;
var
formMain: TformMain;
implementation
{$R *.dfm}
uses
INIFiles;
procedure
TformMain.butnSendMailClick(Sender: TObject);
begin
butnSendMail.Enabled := False;
try
with
mesgMessage
do
begin
Clear;
From.Text := Trim(editFrom.Text);
Recipients.Add.Text := Trim(editTo.Text);
Subject := Trim(editSubject.Text);
Body.Assign(memoMsg.Lines);
end
;
with
smtpSendMail
do
begin
Host := Trim(editSMTPServer.Text);
Connect;
try
Send(mesgMessage);
finally
Disconnect;
end
;
end
;
Status(
'Completed'
);
finally
butnSendMail.Enabled := True;
end
;
end
;
procedure
TformMain.Status(AMsg:
string
);
begin
lboxStatus.ItemIndex := lboxStatus.Items.Add(AMsg);
// Allow the listbox to repaint
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
end
;
procedure
TformMain.FormCreate(Sender: TObject);
var
LINIFile:
string
;
begin
// This routine can be ignored, it is not a functional part of the demo.
//
// This is used to load default values during presentations at conferences
// so attendees do not have to wait for values to be entered each time.
LINIFile :=
'c:\SMTP.ini'
;
if
FileExists(LINIFile)
then
begin
with
TINIFile.Create(LINIFile)
do
try
editFrom.Text := ReadString(
'Main'
,
'From'
,
''
); editTo.Text := ReadString(
'Main'
,
'To'
,
''
); editSubject.Text := ReadString(
'Main'
,
'Subject'
,
''
); editSMTPServer.Text := ReadString(
'Main'
,
'SMTP Server'
,
''
); memoMsg.Lines.Text := ReadString(
'Main'
,
'Message'
,
''
);
finally
Free;
end
;
end
;

125
end
;
procedure
TformMain.smtpSendMailStatus(ASender: TObject;
const
AStatus: TIdStatus;
const
AStatusText:
String
);
begin
Status(AStatusText);
end
;
end
Создание и отправка письма с вложением
При помощи Indy создать и отправить письмо с вложенным файлом (аттачментом) очень просто.
procedure
TMailerForm.btnSendMailClick(Sender: TObject) ;
begin
StatusMemo.Clear;
//setup SMTP
SMTP.Host := ledHost.Text;
SMTP.Port :=
2 5;
//setup mail message
MailMessage.From.Address := ledFrom.Text;
MailMessage.Recipients.EMailAddresses := ledTo.Text +
','
+ ledCC.Text;
MailMessage.Subject := ledSubject.Text;
MailMessage.Body.Text := Body.Text;
if
FileExists(ledAttachment.Text)
then
TIdAttachment.Create(MailMessage.MessageParts, ledAttachment.Text) ;
//send mail
try
try
SMTP.Connect(1000) ;
SMTP.Send(MailMessage) ;
except
on
E:Exception
do
StatusMemo.Lines.Insert(0,
'ERROR: '
+ E.Message) ;
end
;
finally
if
SMTP.Connected
then
SMTP.Disconnect;
end
;
end
;
Утилита командной строки с поддержкой авторизации на почтовом сервере IdSMTP
Небольшая утилита с исходниками, при помощи которой можно отправить файл любому количеству получателей из командной строки. program sendmail;
{
fake sendmail for windows
Copyright (c) 2004, Byron Jones, [e-mail]
All rights reserved.

126
version 3
- smtp authentication support
- clearer error message when missing from or to address
- optional error logging
- adds date header if missing
version 2
- reads default domain from registry (.ini setting overrides)
version 1
- initial release
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
* Neither the name of the glob nor the names of its contributors may
be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}
{$APPTYPE CONSOLE}
uses
Windows, Classes, SysUtils, Registry, IniFiles, IDSmtp, IdMessage,
IdEmailAddress;
var
smtpServer :
string
; defaultFrom :
string
; defaultDomain :
string
; messageContent:
string
; errorLogFile :
string
; authUsername :
string
; authPassword :
string
; i : integer; s :
string
; ss : TStringStream; msg : TIdMessage; f : TextFile; addr : TIdEMailAddressItem;

127
begin
// read default domain from registry
with
TRegistry.Create
do
try
RootKey := HKEY_LOCAL_MACHINE;
if
(OpenKeyReadOnly(
'\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters'
))
then
defaultDomain := ReadString(
'Domain'
);
finally
Free;
end
;
// read ini
with
TIniFile.Create(ChangeFileExt(ParamStr(0),
'.ini'
))
do
try
smtpServer := ReadString(
'sendmail'
,
'smtp_server'
,
'mail.mydomain.com'
); defaultDomain := ReadString(
'sendmail'
,
'default_domain'
, defaultDomain); defaultFrom := ReadString(
'sendmail'
,
'default_from'
, defaultFrom); errorLogFile := ReadString(
'sendmail'
,
'error_logfile'
,
''
); authUsername := ReadString(
'sendmail'
,
'auth_username'
,
''
); authPassword := ReadString(
'sendmail'
,
'auth_password'
,
''
);
if
(smtpServer =
'mail.mydomain.com'
)
or
(defaultDomain =
'mydomain.com'
)
then
begin
writeln(
'you must configure the smtp_server and default_domain in '
+ fileName); halt(1);
end
;
finally
Free;
end
;
if
(errorLogFile <>
''
)
and
(ExtractFilePath(errorLogFile) =
''
)
then
errorLogFile := ExtractFilePath(ParamStr(0)) + errorLogFile;
// read email from stdin
messageContent :=
''
;
while
(not eof(Input))
do
begin
readln(Input, s); messageContent := messageContent + s +
#1 3
#1 0;
end
;
// deliver message
try
// load message into stream (TidMessage expects message to end in ".")
ss := TStringStream.Create(messageContent +
#1 3
#1 0
'.'#1 3
#1 0); msg :=
nil
;
try

128
// load message
msg := TIdMessage.Create(nil); msg.LoadFromStream(ss);
// check for from and to
if
(Msg.From.Address =
''
)
then
if
(defaultFrom =
''
)
then
raise
Exception.Create(
'email is missing sender''s address'
)
else
Msg.From.Address := defaultFrom;
if
(Msg.Recipients.Count =
0
)
then
if
(ParamCount =
0
)
then
raise
Exception.Create(
'email is missing recipient''s address'
)
else
for
i:=
1
to
ParamCount
do
begin
addr := Msg.Recipients.Add; addr.Address := ParamStr(i);
end
;
// add date header if missing
if
(Msg.Headers.Values[
'date'
] =
''
)
then
Msg.Date := now;
// append default domain
if
(Pos(
'@'
, Msg.From.Address) =
0
)
then
Msg.From.Text := Msg.From.Address +
'@'
+ defaultDomain;
for
i :=
0
to
msg.Recipients.Count -
1
do
if
(pos(
'@'
, msg.Recipients[i].Address) =
0
)
then
msg.Recipients[i].Address := msg.Recipients[i].Address +
'@'
+ defaultDomain;
// deliver message
with
TIdSMTP.Create(nil)
do
try
Host := smtpServer;
if
(authUsername <>
''
)
then
begin
AuthenticationType := atLogin;
Username := authUsername;
Password := authPassword;
end
;
Connect;
Send(msg);
finally
Free;
end
;
finally
msg.Free; ss.Free;
end
;

129
except
on
e:Exception
do
begin
writeln(
'sendmail: error during delivery: '
+ e.message);
if
(errorLogFile <>
''
)
then
begin
AssignFile(f, errorLogFile);
try
if
(not FileExists(errorLogFile))
then
begin
ForceDirectories(ExtractFilePath(errorLogFile));
Rewrite(f);
end
else
Append(f); writeln(f,
'['
+ DateTimeToStr(Now) +
'] '
+ e.message); closeFile(f);
except
on
e:Exception
do
writeln(
'sendmail: error writing to error.log: '
+ e.message);
end
;
end
; halt(1);
end
;
end
;
end