unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Psock, NMsmtp;
{©Drkb v.3(2007): <a href="http://www.drkb.ru" title="www.drkb.ru">www.drkb.ru</a>,
 ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}
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('somewhere@somedomain.ru', '', '', 'test', 'body', '', False);
end;
end.

object Form1: TForm1

Left = 278

 = 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

 = 0

Width = 346

Height = 420

Align = alClient

Lines.Strings = ('Memo')

TabOrder = 0

end

object Panel1: TPanel

Left = 0

 = 420

Width = 531

Height = 33

Align = alBottom

Caption = 'Panel1'

TabOrder = 1

object Button1: TButton

Left = 440

 = 8

Width = 75

Height = 25

Caption = 'Button1'

TabOrder = 0

OnClick = Button1Click

end

end

object Panel2: TPanel

Left = 346

 = 0

Width = 185

Height = 420

Align = alRight

Caption = 'Panel2'

TabOrder = 2

object predefined: TLabel

Left = 8

 = 8

Width = 87

Height = 13

Caption = 'predefined values:'

end

object FromAddress: TEdit

Left = 24

 = 32

Width = 121

Height = 21

TabOrder = 0

Text = 'FromAddress'

end

object FromName: TEdit

Left = 24

 = 56

Width = 121

Height = 21

TabOrder = 1

Text = 'FromName'

end

object Subject: TEdit

Left = 24

 = 80

Width = 121

Height = 21

TabOrder = 2

Text = 'Subject'

end

object LocalProgram: TEdit

Left = 24

 = 104

Width = 121

Height = 21

TabOrder = 3

Text = 'LocalProgram'

end

object ReplyTo: TEdit

Left = 24

 = 128

Width = 121

Height = 21

TabOrder = 4

Text = 'ReplyTo'

end

object islog: TCheckBox

Left = 32

 = 168

Width = 97

Height = 17

Caption = 'islog'

TabOrder = 5

end

object Host: TEdit

Left = 24

 = 240

Width = 121

Height = 21

TabOrder = 6

Text = 'Host'

end

object Port: TEdit

Left = 24

 = 264

Width = 121

Height = 21

TabOrder = 7

Text = 'Port'

end

object userid: TEdit

Left = 24

 = 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

 = 32

end

end

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;