Delphi-Send Mail

[zbeng]

Deci una din modalitatile de a trimite date pe e-mail este SMTP .

Urmariti urmatorul program p-ru a vedea cum functioneaza :

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 mARTIE 2007 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:=StringRep lace(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.

Form- Exemplu :

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;

Transmitem totul printrun click pe buton :

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 := 'Textul';

NMSMTP1.PostMessage.Subject := 'Textul';

NMSMTP1.SendMail;

end;

Deci avem nevoie in acest program shi de TNMSMTP - Component !!!

Success..