I've been using Synapse at work for an application that sends e-mails.
Most of the people using it, use their company e-mail server but one company
doesn't allow any applications to send e-mail out except via outlook.
To get around this, I asked the customer to create a gmail account and told
them how to configure the application to use it. It worked fine, except
CC'd e-mails (all e-mails from the system are CC'd) never get through.
NOTE: openssl is used and the DLLs must be in the project directory, and the
Synapse units in the project search path for this to run.
*The code follows:*
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActnList, StdCtrls, ExtCtrls, Buttons, ComCtrls;
type
ESMTP = class (Exception);
TfrmMain = class(TForm)
Splitter1: TSplitter;
mMessage: TMemo;
pnlBottom: TPanel;
btnSend: TButton;
mLog: TRichEdit;
pnlTop: TPanel;
pnlTopLeft: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label9: TLabel;
Label10: TLabel;
edFrom: TEdit;
edTo: TEdit;
edSubject: TEdit;
edBCC: TEdit;
edCC: TEdit;
pnlTopRight: TPanel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
edUserId: TEdit;
edPassword: TEdit;
edServerName: TEdit;
Splitter2: TSplitter;
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SendMail(const sSmtpHost : String; iSmtpPort : integer;
sSmtpUser, sSmtpPasswd, sFrom, sTo, sCC, sBCC, sSubject : String;
slAttachments, msgLines : TStrings; log: TObject);
end;
var
frmMain: TfrmMain;
implementation
uses blcksock, smtpsend, pop3send, ssl_openssl, synautil, mimemess,
mimepart;
{$R *.dfm}
procedure SplitHostAndPort(const sInput : String; var sHostName : String;
var iPortNumber : Integer);
var
sTemp,
sPortNumber : String;
begin
sHostName := Trim(SeparateLeft(sInput, ':'));
sTemp := Trim(SeparateRight(sInput, ':'));
if (sTemp <> '') and (sTemp <> sInput) then
sPortNumber := sTemp;
try
iPortNumber := StrToInt(sPortNumber);
except
iPortNumber := 0;
end;
end;
procedure ParseEmailList(sInput : string; const Strings : TStrings);
begin
Assert(Assigned(Strings));
Strings.Clear;
if pos(';', sInput) > 0 then
Strings.Delimiter := ';'
else
if pos(',', sInput) > 0 then
Strings.Delimiter := ',';
Strings.DelimitedText := sInput;
end;
procedure AddToLog(log : TObject; logLine : AnsiString; isError : Boolean);
begin
if log <> nil then
begin
if (log is TRichEdit) then
begin
if isError then
(log as TRichEdit).SelAttributes.Color := clRed
else
(log as TRichEdit).SelAttributes.Color := clBlack;
(log as TRichEdit).Lines.Add(logLine);
end;
if (log is TMemo) then
begin
if isError then
(log as TMemo).Lines.Add('ERROR: ' + logLine)
else
(log as TMemo).Lines.Add(logLine);
end;
if (log is TStrings) then
begin
if isError then
(log as TStrings).Add('ERROR: ' + logLine)
else
(log as TStrings).Add(logLine);
end;
Application.ProcessMessages;
end;
end;
procedure TfrmMain.btnSendClick(Sender: TObject);
var
slMsgBody: TStringList;
sFrom, sTo, sCC, sBCC, sSubject, sSmtpServer, sSmtpHost, sSmtpUser,
sSmtpPasswd : String;
iSmtpPort : Integer;
begin
slMsgBody := TStringList.Create;
sFrom := edFrom.Text;
sTo := edTo.Text;
sCC := edCC.Text;
sBCC := edBCC.Text;
sSubject := edSubject.Text;
sSmtpServer := edServerName.Text;
sSmtpUser := edUserId.Text;
sSmtpPasswd := edPassword.Text;
try
SplitHostAndPort(sSmtpServer, sSmtpHost, iSmtpPort);
SendMail(sSmtpHost, iSmtpPort, sSmtpUser, sSmtpPasswd,
sFrom, sTo, sCC, sBCC, sSubject, nil, slMsgBody, mLog.Lines);
finally
slMsgBody.Free;
end;
end;
procedure TFrmMain.SendMail(const sSmtpHost : String; iSmtpPort : integer;
sSmtpUser, sSmtpPasswd, sFrom, sTo, sCC, sBCC, sSubject : String;
slAttachments, msgLines : TStrings; log: TObject);
var
smtp: TSMTPSend;
msg_lines: TStringList;
m:TMimemess;
p: TMimepart;
I : Integer;
slEmailList : TStringList;
begin
msg_lines := TStringList.Create;
smtp := TSMTPSend.Create;
m:=TMimemess.create;
slEmailList := TStringList.Create;
if iSmtpPort = 0 then
if sSmtpHost = 'smtp.gmail.com' then
iSmtpPort := 465
else
iSmtpPort := 25;
try
AddToLog(log, 'Creating e-mail', False);
p := m.AddPartMultipart('mixed', nil);
m.AddPartText(msgLines,p);
if slAttachments <> nil then
begin
AddToLog(log, 'Adding attachments', False);
for I := 0 to slAttachments.Count - 1 do
m.AddPartBinaryFromFile(slAttachments.Strings[I], p);
end;
m.header.from:=sFrom;
//Parse the To list.
if (Pos(';', sTo) > 0) or (Pos(',', sTo) > 0)then
begin
ParseEmailList(sTo, slEmailList);
sTo := slEmailList[0];
slEmailList.Delete(0);
for I := 0 to slEmailList.Count - 1 do
m.header.CCList.Add(Trim(slEmailList[I]));
end
else
m.header.tolist.add(sTo);
//Parse the CC list.
if sCC <> '' then
begin
ParseEmailList(sCC, slEmailList);
for I := 0 to slEmailList.Count - 1 do
m.header.CCList.Add(Trim(slEmailList[I]));
end;
//Parse the BCC list.
if sBCC <> '' then
begin
ParseEmailList(sBCC, slEmailList);
for I := 0 to slEmailList.Count - 1 do
SendMail(sSmtpHost, iSmtpPort, sSmtpUser, sSmtpPasswd,
sFrom, slEmailList.Strings[I], '', '', sSubject, slAttachments,
msgLines, log);
end;
m.header.subject:=sSubject;
AddToLog(log, 'Encoding message', False);
m.EncodeMessage;
smtp.UserName := sSmtpUser;
smtp.Password := sSmtpPasswd;
smtp.TargetHost := sSmtpHost;
smtp.TargetPort := IntToStr(iSmtpPort);
smtp.AutoTLS := False;
smtp.FullSSL := True;
smtp.Sock.SSL.SSLType := LT_SSLv3;
smtp.Sock.SSL.Username := sSmtpUser;
smtp.Sock.SSL.Password := sSmtpPasswd;
AddToLog(log, 'Opening secure SSL connection to server: ' + sSmtpHost +
' on port: ' + IntToStr(iSmtpPort), False);
smtp.Sock.Connect(sSmtpHost, IntToStr(iSmtpPort));
smtp.Sock.SSL.Connect;
AddToLog(log, 'Logging into server: ' + sSmtpHost + ' on port: ' +
IntToStr(iSmtpPort), False);
if not smtp.Login() then
begin
AddToLog(log, 'SMTP ERROR: Login:' + smtp.EnhCodeString, True);
raise ESMTP.Create('SMTP ERROR: Login:' + smtp.EnhCodeString);
end;
AddToLog(log, 'Submitting message to server', False);
if not smtp.MailFrom(sFrom, Length(sFrom)) then
begin
AddToLog(log, 'SMTP ERROR: MailFrom:' + smtp.EnhCodeString, True);
raise ESMTP.Create('SMTP ERROR: MailFrom:' + smtp.EnhCodeString);
end;
if not smtp.MailTo(sTo) then
begin
AddToLog(log, 'SMTP ERROR: MailTo:' + smtp.EnhCodeString, True);
raise ESMTP.Create('SMTP ERROR: MailTo:' + smtp.EnhCodeString);
end;
if not smtp.MailData(m.lines) then
begin
AddToLog(log, 'SMTP ERROR: MailData:' + smtp.EnhCodeString, True);
raise ESMTP.Create('SMTP ERROR: MailData:' + smtp.EnhCodeString);
end;
AddToLog(log, 'Logging out of server', False);
if not smtp.Logout() then
begin
AddToLog(log, 'SMTP ERROR: Logout:' + smtp.EnhCodeString, True);
raise ESMTP.Create('SMTP ERROR: Logout:' + smtp.EnhCodeString);
end;
AddToLog(log, 'OK!', False);
finally
msg_lines.Free;
smtp.Free;
m.free;
slEmailList.Free;
end;
end;
end.
*Form definition:*
object frmMain: TfrmMain
Left = 0
Top = 0
ActiveControl = edFrom
Caption = 'Simple Email Test'
ClientHeight = 318
ClientWidth = 578
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 0
Top = 184
Width = 578
Height = 3
Cursor = crVSplit
Align = alBottom
Beveled = True
ExplicitLeft = -8
ExplicitTop = 239
ExplicitWidth = 720
end
object mMessage: TMemo
Left = 0
Top = 84
Width = 578
Height = 100
Hint = 'Enter the body of the e-mail here.'
Align = alClient
Constraints.MinHeight = 100
Lines.Strings = (
'This is a test...')
ScrollBars = ssVertical
TabOrder = 0
ExplicitTop = 227
ExplicitWidth = 638
ExplicitHeight = 109
end
object pnlBottom: TPanel
Left = 0
Top = 277
Width = 578
Height = 41
Align = alBottom
BevelInner = bvLowered
TabOrder = 1
ExplicitTop = 442
ExplicitWidth = 655
DesignSize = (
578
41)
object btnSend: TButton
Left = 518
Top = 8
Width = 53
Height = 25
Hint = 'Click to send the e-mail.'
Anchors = [akTop, akRight]
Caption = '&Send'
TabOrder = 0
OnClick = btnSendClick
end
end
object mLog: TRichEdit
Left = 0
Top = 187
Width = 578
Height = 90
Hint = 'E-mail server responses.'
TabStop = False
Align = alBottom
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 2
ExplicitTop = 440
ExplicitWidth = 638
end
object pnlTop: TPanel
Left = 0
Top = 0
Width = 578
Height = 84
Align = alTop
BevelOuter = bvNone
Constraints.MaxHeight = 84
Constraints.MinHeight = 84
TabOrder = 3
ExplicitWidth = 638
object Splitter2: TSplitter
Left = 344
Top = 0
Height = 84
ExplicitLeft = 346
ExplicitTop = -6
end
object pnlTopLeft: TPanel
Left = 0
Top = 0
Width = 344
Height = 84
Align = alLeft
BevelInner = bvLowered
Constraints.MinHeight = 84
Constraints.MinWidth = 344
TabOrder = 0
ExplicitHeight = 145
DesignSize = (
344
84)
object Label1: TLabel
Left = 8
Top = 12
Width = 24
Height = 13
Caption = '&From'
FocusControl = edFrom
end
object Label2: TLabel
Left = 192
Top = 12
Width = 12
Height = 13
Caption = '&To'
FocusControl = edTo
end
object Label3: TLabel
Left = 8
Top = 60
Width = 36
Height = 13
Caption = 'S&ubject'
FocusControl = edSubject
end
object Label9: TLabel
Left = 192
Top = 36
Width = 20
Height = 13
Caption = '&BCC'
FocusControl = edBCC
end
object Label10: TLabel
Left = 8
Top = 36
Width = 14
Height = 13
Caption = '&CC'
FocusControl = edCC
end
object edFrom: TEdit
Left = 48
Top = 8
Width = 140
Height = 21
Hint = 'Your e-mail address that you are sending this e-mail from.'
TabOrder = 0
Text = '[email protected]'
end
object edTo: TEdit
Left = 225
Top = 8
Width = 112
Height = 21
Hint = 'The e-mail address of who you want to send the e-mail to.'
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
Text = '[email protected]'
end
object edSubject: TEdit
Left = 48
Top = 56
Width = 289
Height = 21
Hint = 'Enter the subject of your e-mail here.'
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
Text = 'Testing'
end
object edBCC: TEdit
Left = 225
Top = 32
Width = 112
Height = 21
Hint =
'BCC e-mail addresses of additional who you want to send the e-ma'
+
'il to.'
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
end
object edCC: TEdit
Left = 48
Top = 32
Width = 140
Height = 21
Hint =
'CC e-mail addresses of additional who you want to send the e-mai'
+
'l to.'
TabOrder = 2
Text = '[email protected],[email protected]'
end
end
object pnlTopRight: TPanel
Left = 347
Top = 0
Width = 231
Height = 84
Align = alClient
BevelInner = bvLowered
Constraints.MinWidth = 172
TabOrder = 1
ExplicitLeft = 375
ExplicitWidth = 202
ExplicitHeight = 81
DesignSize = (
231
84)
object Label4: TLabel
Left = 8
Top = 12
Width = 32
Height = 13
Caption = 'Ser&ver'
FocusControl = edServerName
end
object Label5: TLabel
Left = 8
Top = 36
Width = 48
Height = 13
Caption = '&Username'
FocusControl = edUserId
end
object Label6: TLabel
Left = 6
Top = 55
Width = 46
Height = 13
Caption = '&Password'
FocusControl = edPassword
end
object edUserId: TEdit
Left = 64
Top = 32
Width = 161
Height = 21
Hint = 'Enter your e-mail login name here (if applicable).'
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
Text = '[email protected]'
ExplicitWidth = 132
end
object edPassword: TEdit
Left = 64
Top = 56
Width = 161
Height = 21
Hint = 'Enter your e-mail server password here (if applicable).'
Anchors = [akLeft, akTop, akRight]
PasswordChar = '#'
TabOrder = 2
ExplicitWidth = 132
end
object edServerName: TEdit
Left = 64
Top = 5
Width = 161
Height = 21
Hint =
'Enter your e-mail server and port in the format: servername:port'
+
'. eg. mail.bigpond.com:25'
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
Text = 'smtp.gmail.com:465'
ExplicitWidth = 132
end
end
end
end
--
Suspicion is the precipice of enlightenment.
Examine all that piques your interest.
------------------------------------------------------------------------------
Let Crystal Reports handle the reporting - Free Crystal Reports 2008 30-Day
trial. Simplify your report design, integration and deployment - and focus on
what you do best, core application coding. Discover what's new with
Crystal Reports now. http://p.sf.net/sfu/bobj-july
_______________________________________________
synalist-public mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/synalist-public
