Delphi - база знаний


Пример работы с SMTP


Пример работы с SMTP




unit Unit1;

interface


uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Psock, NMsmtp;  
 
type
TForm1 = class(TForm)
  Memo: TRichEdit;
  Panel1: TPanel;
  SMTP: TNMSMTP;
  Panel2: TPanel;
  FromAddress: TEdit;
  predefined: TLabel;
  FromName: TEdit;
  Subject: TEdit;
  LocalProgram: TEdit;
  ReplyTo: TEdit;
  islog: TCheckBox;
  Host: TEdit;
  Port: TEdit;
  userid: TEdit;
  Button1: TButton;
  procedure Button1Click(Sender: TObject);
private
  Procedure CleanContext;
  procedure PerformConnection;
  procedure AddMessage(msg:string; color:integer);
  procedure log(inpt :string);
  Procedure SetSMTP;
public
  function SendEmail(_to, cc, bcc, Subject, body, attachment:string; HTMLFormat:boolean):boolean;
end;

var Form1: TForm1;

implementation
{$R *.DFM}

Procedure TForm1.SetSMTP;
begin
SMTP.Host:=Host.Text;  
SMTP.Port:=strtoint(Port.text);  
SMTP.UserID:=userid.text;  
end;

Function GetEmailDateTime:string;
var tz:_time_Zone_information;
    s:string;
begin
GetTimeZoneInformation(tz);  
if (tz.Bias*100 div 60)<1000 then  
  s:=format(' -0%d',[tz.Bias*100 div 60])  
else  
  s:=format(' -%d',[tz.Bias*100 div 60]);  
result:=formatdatetime('ddd, dd mmm yyyy hh:nn:ss',now)+s;  
end;

Procedure TForm1.CleanContext;
{set default values, some of them comes from "Setup" form}
begin
SMTP.PostMessage.FromAddress:=FromAddress.text;  
SMTP.PostMessage.FromName:=FromName.text;  
SMTP.PostMessage.ToAddress.Clear;  
SMTP.PostMessage.ToCarbonCopy.clear;  
SMTP.PostMessage.ToBlindCarbonCopy.clear;  
SMTP.PostMessage.Body.clear;  
SMTP.PostMessage.Attachments.clear;  
SMTP.PostMessage.Subject:=Subject.text;  
SMTP.PostMessage.LocalProgram:=LocalProgram.text;  
(*Mon, 27 Nov 2000 12:37:46 -0700*)  
SMTP.PostMessage.Date:=GetEmailDateTime;  
SMTP.PostMessage.ReplyTo:=ReplyTo.Text;  
end;

procedure TForm1.log(inpt :string);
  var outf:textfile;
begin  {writing in the log file}
if not islog.checked then exit;  
assignfile(outf, changefileext(paramstr(0), '.log'));  
if fileexists(changefileext(paramstr(0), '.log')) then  
  append(outf)  
else  
  rewrite(outf);  
writeln(outf, datetimetostr(now)+'|'+inpt);  
closefile(outf);  
end;

procedure TForm1.AddMessage(msg:string; color:integer);
begin {showing in the memo field progress...}
while memo.lines.Count>2000 do memo.lines.Delete(0);  
memo.sellength:=0;  
memo.selstart:=length(memo.text);  
memo.selattributes.Color:=Color;  
memo.seltext:=#13#10+DateTimeTostr(now)+' '+msg;  
memo.perform($00B7,0,0);  
Application.ProcessMessages;  
if color<>clRed then log(DateTimeTostr(now)+' '+msg) else log('Error: '+DateTimeTostr(now)+' '+msg);  
end;

procedure TForm1.PerformConnection;
begin
while (not SMTP.connected) do  
  begin  
    SetSMTP;  
    AddMessage('Connecting to SMTP',clBlue);  
    application.processmessages;  
    try  
      SMTP.Connect;  
      AddMessage('No Errors',clBlue);  
    except  
      on e:exception do AddMessage('Error conection: '+e.message,clBlue);  
    end;  
  end;  
end;

Function TForm1.SendEmail(_to, cc, bcc, Subject, body,  attachment:string; HTMLFormat:boolean):boolean;
begin
PerformConnection;  
result:=true;  
CleanContext;  
try  
  if (attachment<>'') and (not Fileexists(attachment)) then  
    begin  
      AddMessage('Attachment is not ready yet ('+ attachment+') ', clNavy);  
      sleep(300);  
      result:=false;  
      exit;  
    end;  
  SMTP.PostMessage.ToAddress.text:=StringReplace(_to, ';',#13#10, [rfReplaceAll, rfIgnoreCase]);  
  if cc<>'' then SMTP.PostMessage.ToCarbonCopy.text:=StringReplace(cc, ';',#13#10, [rfReplaceAll, rfIgnoreCase]);  
  if bcc<>'' then SMTP.PostMessage.ToBlindCarbonCopy.text:=StringReplace(bcc, ';',#13#10, [rfReplaceAll, rfIgnoreCase]);  
  if Subject<>'' then SMTP.PostMessage.Subject:=Subject;  
  if HTMLFormat then SMTP.SubType:=mtPlain else SMTP.SubType:=mtHtml;  
  SMTP.PostMessage.Body.Text:=Body;  
  if attachment<>'' then SMTP.PostMessage.Attachments.add(attachment);  
  AddMessage('Sending to '+ _to, clGreen);  
  SMTP.SendMail;  
  AddMessage('Complete.'+#13#10, clGreen);  
except  
  on e:sysutils.exception do  
    begin  
      AddMessage(e.message, clRed);  
      result:=false;  
    end;  
end;  
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendEmail('vit@vingrad.ru', '', '', 'test', 'body',  '', False);
end;

end.


А это форма для этого примера:

object Form1: TForm1
Left = 278  
Top = 108  
Width = 539  
Height = 480  
Caption = 'Form1'  
Color = clBtnFace  
Font.Charset = DEFAULT_CHARSET  
Font.Color = clWindowText  
Font.Height = -11  
Font.Name = 'MS Sans Serif'  
Font.Style = []  
OldCreateOrder = False  
PixelsPerInch = 96  
TextHeight = 13  
object Memo: TRichEdit  
Left = 0  
Top = 0  
Width = 346  
Height = 420  
Align = alClient  
Lines.Strings = ('Memo')  
TabOrder = 0  
end  
object Panel1: TPanel  
Left = 0  
Top = 420  
Width = 531  
Height = 33  
Align = alBottom  
Caption = 'Panel1'  
TabOrder = 1  
object Button1: TButton  
Left = 440  
Top = 8  
Width = 75  
Height = 25  
Caption = 'Button1'  
TabOrder = 0  
OnClick = Button1Click  
end  
end  
object Panel2: TPanel  
Left = 346  
Top = 0  
Width = 185  
Height = 420  
Align = alRight  
Caption = 'Panel2'  
TabOrder = 2  
object predefined: TLabel  
Left = 8  
Top = 8  
Width = 87  
Height = 13  
Caption = 'predefined values:'  
end  
object FromAddress: TEdit  
Left = 24  
Top = 32  
Width = 121  
Height = 21  
TabOrder = 0  
Text = 'FromAddress'  
end  
object FromName: TEdit  
Left = 24  
Top = 56  
Width = 121  
Height = 21  
TabOrder = 1  
Text = 'FromName'  
end  
object Subject: TEdit  
Left = 24  
Top = 80  
Width = 121  
Height = 21  
TabOrder = 2  
Text = 'Subject'  
end  
object LocalProgram: TEdit  
Left = 24  
Top = 104  
Width = 121  
Height = 21  
TabOrder = 3  
Text = 'LocalProgram'  
end  
object ReplyTo: TEdit  
Left = 24  
Top = 128  
Width = 121  
Height = 21  
TabOrder = 4  
Text = 'ReplyTo'  
end  
object islog: TCheckBox  
Left = 32  
Top = 168  
Width = 97  
Height = 17  
Caption = 'islog'  
TabOrder = 5  
end  
object Host: TEdit  
Left = 24  
Top = 240  
Width = 121  
Height = 21  
TabOrder = 6  
Text = 'Host'  
end  
object Port: TEdit  
Left = 24  
Top = 264  
Width = 121  
Height = 21  
TabOrder = 7  
Text = 'Port'  
end  
object userid: TEdit  
Left = 24  
Top = 288  
Width = 121  
Height = 21  
TabOrder = 8  
Text = 'userid'  
end  
end  
object SMTP: TNMSMTP  
Port = 25  
ReportLevel = 0  
EncodeType = uuMime  
ClearParams = True  
SubType = mtPlain  
Charset = 'us-ascii'  
Left = 296  
Top = 32  
end  
end 

Автор ответа Vit
Взято с Vingrad.ru




В следующем примере E-mail отправляется автоматически сразу после нажатия кнопки.

ЗАМЕЧАНИЕ: Вам потребуется компонент 'TNMSMTP'. Этот компонент входит в поставляется с Delphi 4 и 5 и его можно найти на закладке 'Fastnet'.


procedure TForm1.Button1Click(Sender: TObject); 
begin 
NMSMTP1.Host := 'smtp.mailserver.com';   
NMSMTP1.UserID := 'h.abdullah';   
NMSMTP1.Connect;   
NMSMTP1.PostMessage.FromAddress := 'hasan@excite.com';   
NMSMTP1.PostMessage.ToAddress.Text := 'someone@xmail.com';   
NMSMTP1.PostMessage.Body.Text := 'Текст письма';  
NMSMTP1.PostMessage.Subject := 'Тема письма';  
NMSMTP1.SendMail;   
end;

Взято с Исходников.ru



Начало  Назад  Вперед