Sign in Join
Wiki copytemporary

Synapse - Email Examples: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: Synapse - Email Examples

OldNewLine
1+## Example 1 - sending to Gmail
2+
3+(forum user **ludob**). This works for me with Gmail using [[Synapse]].
4+
5+``` pascal
6+uses
7+ ..., smtpsend, ssl_openssl;
8+
9+function SendMail(const User, Password, MailFrom, MailTo, SMTPHost, SMTPPort, MailData: string): Boolean;
10+var
11+ SMTP: TSMTPSend;
12+ sl:TStringList;
13+begin
14+ Result:=False;
15+ SMTP:=TSMTPSend.Create;
16+ sl:=TStringList.Create;
17+ try
18+ sl.text:=Maildata;
19+ SMTP.UserName:=User;
20+ SMTP.Password:=Password;
21+ SMTP.TargetHost:=SMTPHost;
22+ SMTP.TargetPort:=SMTPPort;
23+ SMTP.AutoTLS:=true;
24+ if SMTPPort<> '25' then
25+ SMTP.FullSSL:=true;
26+ if SMTP.Login then
27+ begin
28+ Result:=SMTP.MailFrom(MailFrom, Length(MailData)) and
29+ SMTP.MailTo(MailTo) and
30+ SMTP.MailData(sl);
31+ SMTP.Logout;
32+ end;
33+ finally
34+ SMTP.Free;
35+ sl.Free;
36+ end;
37+end;
38+```
39+
40+## Example 2 - sending attachments
41+
42+(forum user **y.ivanov**). Here is my small helper unit for [[Synapse]]. The password is the sender password (for SMTP).
43+
44+``` pascal
45+unit mailsendu;
46+
47+{$mode objfpc}{$H+}
48+
49+interface
50+
51+uses
52+ Classes, SysUtils, smtpsend;
53+
54+type
55+
56+ { TMySMTPSend }
57+
58+ TMySMTPSend = class(TSMTPSend)
59+ private
60+ FSendSize: Integer;
61+ protected
62+ function SendToRaw(const AFrom, ATo: String; const AMailData: TStrings)
63+ : Boolean;
64+ public
65+ function SendMessage(AFrom, ATo, ASubject: String; AContent,
66+ AAttachments: TStrings): Boolean;
67+
68+ property SendSize: Integer read FSendSize write FSendSize;
69+
70+ end;
71+
72+implementation
73+
74+uses
75+ ssl_openssl, mimemess, mimepart, synautil, synachar;
76+
77+{ TMySMTPSend }
78+
79+function TMySMTPSend.SendToRaw(const AFrom, ATo: String; const AMailData
80+ : TStrings): Boolean;
81+var
82+ S, T: String;
83+begin
84+ Result := False;
85+ if Self.Login then
86+ begin
87+ FSendSize := Length(AMailData.Text);
88+ if Self.MailFrom(GetEmailAddr(AFrom), FSendSize) then
89+ begin
90+ S := ATo;
91+ repeat
92+ T := GetEmailAddr(Trim(FetchEx(S, ',', '"')));
93+ if T <> '' then
94+ Result := Self.MailTo(T);
95+ if not Result then
96+ Break;
97+ until S = '';
98+ if Result then
99+ Result := Self.MailData(AMailData);
100+ end;
101+ Self.Logout;
102+ end;
103+end;
104+
105+function TMySMTPSend.SendMessage(AFrom, ATo, ASubject: String; AContent,
106+ AAttachments: TStrings): Boolean;
107+var
108+ Mime: TMimeMess;
109+ P: TMimePart;
110+ I: Integer;
111+begin
112+ Mime := TMimeMess.Create;
113+ try
114+ // Set some headers
115+ Mime.Header.CharsetCode := UTF_8;
116+ Mime.Header.ToList.Text := ATo;
117+ Mime.Header.Subject := ASubject;
118+ Mime.Header.From := AFrom;
119+
120+ // Create a MultiPart part
121+ P := Mime.AddPartMultipart('mixed', Nil);
122+
123+ // Add as first part the mail text
124+ Mime.AddPartTextEx(AContent, P, UTF_8, True, ME_8BIT);
125+
126+ // Add all attachments:
127+ if Assigned(AAttachments) then
128+ for I := 0 to Pred(AAttachments.Count) do
129+ Mime.AddPartBinaryFromFile(AAttachments[I], P);
130+
131+ // Compose message
132+ Mime.EncodeMessage;
133+
134+ // Send using SendToRaw
135+ Result := Self.SendToRaw(AFrom, ATo, Mime.Lines);
136+
137+ finally
138+ Mime.Free;
139+ end;
140+end;
141+
142+end.
143+```
144+
145+This is how to use that unit:
146+
147+``` pascal
148+program mailsend_test;
149+
150+uses
151+ Classes, SysUtils, mailsendu, blcksock;
152+
153+type
154+
155+ { TSink }
156+
157+ TSink = class(TObject)
158+ procedure Progress(Sender: TObject; Reason: THookSocketReason;const Value: String);
159+ end;
160+
161+var
162+ Content, Attach: TStringList;
163+ SMTP: TMySMTPSend;
164+ Sink: TSink;
165+ Written: Integer;
166+
167+{ TSink }
168+
169+procedure TSink.Progress(Sender: TObject; Reason: THookSocketReason;
170+ const Value: String);
171+begin
172+ case Reason of
173+ {:Socket connected to IP and Port. Connected IP and Port is in parameter in
174+ format like: 'localhost.somewhere.com:25'.}
175+ HR_Connect: Written := 0;
176+ {:report count of bytes writed to socket. Number is in parameter string. If
177+ you need is in integer, you must use StrToInt function!}
178+ HR_WriteCount:
179+ begin
180+ Written := Written + StrToInt(Value);
181+ WriteLn('Written ', Written, ' of ', SMTP.SendSize, ' bytes');
182+ end;
183+ {:report situation where communication error occured. When raiseexcept is
184+ @true, then exception is called after this Hook reason.}
185+ HR_Error: WriteLn('Error: ', Value);
186+ end;
187+end;
188+
189+begin
190+ Sink := TSink.Create;
191+ Content := TStringList.Create;
192+ Content.Add('Hello!');
193+ Content.Add('This is a SMTP send test.');
194+ Content.Add('Hello from the other side!');
195+ Content.Add('Regards,');
196+ Attach := TStringList.Create;
197+ Attach.Add('mismisc.pas');
198+ Attach.Add('notused.pas');
199+
200+ SMTP := TMySMTPSend.Create;
201+ try
202+ SMTP.TargetHost := 'smtp.googlemail.com';
203+ SMTP.TargetPort := '465';
204+ SMTP.Username := 'user@gmail.com';
205+ SMTP.Password := 'password here';
206+ SMTP.FullSSL := True;
207+ SMTP.Sock.OnStatus := @Sink.Progress;
208+ SMTP.Sock.RaiseExcept := True;
209+ try
210+ if SMTP.SendMessage(
211+ 'user@gmail.com', // AFrom
212+ 'recipient@domain.com', // ATo
213+ 'Test subject FullSSL 2', // ASubject
214+ Content,
215+ Attach)
216+ then
217+ WriteLn('Success.')
218+ else
219+ begin
220+ WriteLn('Failure!');
221+ end;
222+ except
223+ on E: Exception do
224+ WriteLn('EXCEPTION: ', E.Message);
225+ end;
226+
227+ with SMTP do
228+ begin
229+ WriteLn;
230+ WriteLn(' ResultCode: ', ResultCode);
231+ WriteLn('ResultString: ', ResultString);
232+ WriteLn(' FullResult: ', FullResult.Text);
233+ WriteLn(' AuthDone: ', AuthDone) ;
234+ end;
235+ finally
236+ SMTP.Free;
237+ end;
238+
239+end.
240+```
241+
242+## Example 3 - using the XMailer wrapper
243+
244+(forum user **Silvio Clécio**). I use [XMailer plugin](https://github.com/MFernstrom/xmailer) (it uses Synapse framework). Works fine with Gmail, Hotmail, Yahoo etc.
245+
246+It is also available in the [[Online Package Manager]].
247+
248+## Example 4 - with error checking for debugging
249+
250+This version is "advanced" in so far as it does a lot of error checking and shows you the responses from the remote mail server. It is very useful for debugging especially when you do not have access to the remote mail server's logs.
251+
252+``` pascal
253+unit Unit1;
254+
255+{$mode objfpc}{$H+}
256+
257+interface
258+
259+uses
260+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
261+
262+type
263+
264+ { TForm1 }
265+
266+ TForm1 = class(TForm)
267+ Button1: TButton;
268+ Memo1: TMemo;
269+ procedure Button1Click(Sender: TObject);
270+ private
271+ public
272+ end;
273+
274+var
275+ Form1: TForm1;
276+
277+implementation
278+
279+{$R *.lfm}
280+uses
281+ // "ssl_openssl" unit is required to use SSL / TLS
282+ ssl_openssl, SMTPsend;
283+
284+// MailData is the text of the mail.
285+procedure SendMail(User, Password, MailFrom, MailTo, SMTPHost, SMTPPort: string; MailData: string);
286+var
287+ SMTP: TSMTPSend;
288+ email_lines: TStringList;
289+begin
290+ SMTP := TSMTPSend.Create;
291+ email_lines := TStringList.Create;
292+
293+ try
294+ email_lines.text := Maildata;
295+ SMTP.UserName := User;
296+ SMTP.Password := Password;
297+ SMTP.TargetHost := SMTPHost;
298+ SMTP.TargetPort := SMTPPort;
299+ //SMTP.AutoTLS := True; // upgrade to SSL/TLS if remote server supports it
300+
301+ if Trim(SMTPPort) <> '25' then
302+ SMTP.FullSSL := true; // if sending to port 25, don't use encryption
303+
304+ Form1.Memo1.Clear; // clear memo text
305+
306+ if not SMTP.Login() then
307+ begin
308+ Form1.Memo1.Append('SMTP ERROR: Login:' + SMTP.EnhCodeString);
309+ Form1.Memo1.Append('SMTP Login: Failed - does server exist? does it accept mail?');
310+ Exit
311+ end
312+ else
313+ begin
314+ Form1.Memo1.Append('SMTP Login: OK');
315+ Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
316+ end;
317+
318+ if(SMTP.ESMTP) then
319+ Form1.Memo1.Append('SMTP: ' + SMTPHost + ' supports ESMTP')
320+ else
321+ Form1.Memo1.Append('SMTP: ' + SMTPHost + ' supports plain SMTP');
322+
323+ // Insist on SSL/TLS connection to remote server
324+ // - if the server might not support it, omit and then
325+ // uncomment SMTP.AutoTLS above
326+ if not SMTP.StartTLS() then
327+ Form1.Memo1.Append('SMTP ERROR: StartTLS:' + SMTP.EnhCodeString)
328+ else
329+ begin
330+ Form1.Memo1.Append('SMTP StartTLS: OK');
331+ Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
332+ end;
333+
334+ if not SMTP.MailFrom(MailFrom, Length(MailFrom)) then
335+ Form1.Memo1.Append('SMTP ERROR: MailFrom:' + SMTP.EnhCodeString)
336+ else
337+ begin
338+ Form1.Memo1.Append('SMTP MailFrom: OK');
339+ Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
340+ end;
341+
342+ if not SMTP.MailTo(MailTo) then
343+ Form1.Memo1.Append('SMTP ERROR: MailTo:' + SMTP.EnhCodeString)
344+ else
345+ begin
346+ Form1.Memo1.Append('SMTP MailTo: OK');
347+ Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
348+ end;
349+
350+ if not SMTP.MailData(email_lines) then
351+ Form1.Memo1.Append('SMTP ERROR: MailData:' + SMTP.EnhCodeString)
352+ else
353+ begin
354+ Form1.Memo1.Append('SMTP MailData: OK');
355+ Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
356+ end;
357+
358+ if not SMTP.Logout() then
359+ Form1.Memo1.Append('SMTP ERROR: Logout:' + SMTP.EnhCodeString)
360+ else
361+ begin
362+ Form1.Memo1.Append('SMTP Logout: OK');
363+ Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
364+ end;
365+
366+ finally
367+ SMTP.Free;
368+ email_lines.Free;
369+ end;
370+end;
371+
372+procedure TForm1.Button1Click(Sender: TObject);
373+begin
374+ SendMail(
375+ '', // Name if authentication required
376+ '', // Password if authentication required
377+ 'trev@example.com', // MailFrom
378+ 'trev@example.org', // MailTo
379+ 'shadow.example.org', // Mail server to send to
380+ '25', // Mail server port
381+ 'To: trev@example.org' // Otherwise To: is blank on receipt
382+ + LineEnding + 'Subject: Test' // Otherwise Subject: is blank on receipt
383+ + LineEnding +'Gday!' // Email body
384+ + LineEnding);
385+end;
386+
387+end.
388+```
389+
390+**Example Memo1 output on success**
391+
392+`SMTP Login: OK`\
393+`-- Remote response: 250-shadow.example.org Hello macmini8.example.org [192.168.1.21], pleased to meet you`\
394+`SMTP: shadow.example.org supports ESMTP`\
395+`SMTP StartTLS: OK`\
396+`-- Remote response: 220 2.0.0 Ready to start TLS`\
397+`SMTP MailFrom: OK`\
398+`-- Remote response: 250 2.1.0 <trev@example.com>... Sender ok`\
399+`SMTP MailTo: OK`\
400+`-- Remote response: 250 2.1.5 <trev@example.org>... Recipient ok`\
401+`SMTP MailData: OK`\
402+`-- Remote response: 250 2.0.0 22G97AqL046395 Message accepted for delivery`\
403+`SMTP Logout: OK`\
404+`-- Remote response: 221 2.0.0 shadow.example.org closing connection`
405+
406+**Example Memo1 output on failure**
407+
408+`SMTP Login: OK`\
409+`-- Remote response: 250-shadow.example.org Hello 103-216-191-138.dyn.launtel.net.au [103.216.191.138], pleased to meet you`\
410+`SMTP: shadow.example.org supports ESMTP`\
411+`SMTP StartTLS: OK`\
412+`-- Remote response: 220 2.0.0 Ready to start TLS`\
413+`SMTP MailFrom: OK`\
414+`-- Remote response: 250 2.1.0 <trev@example.com>... Sender ok`\
415+`SMTP ERROR: `[`MailTo:Persistent`](MailTo:Persistent)` Transient Failure-Delivery not authorized, message refused`\
416+`-- Remote response: 451 4.7.1 Spam alert: 103-116-191-138.dyn.launtel.net.au [103.116.191.138] mail delivery delayed`\
417+`SMTP ERROR: MailData:Permanent Failure-Other undefined Status`\
418+`-- Remote response: 503 5.0.0 Need RCPT (recipient)`\
419+`SMTP Logout: OK`\
420+`-- Remote response: 221 2.0.0 shadow.example.org closing connection`
421+
422+## See also
423+
424+- [RFC2821](https://www.ietf.org/rfc/rfc2821.txt) - Simple Mail Transfer Protocol (SMTP).
425+
426+- [RFC3207](https://www.ietf.org/rfc/rfc3207.txt) - SMTP Service Extension for Secure SMTP over Transport Layer Security (TLS).
427+
428+- [RFC5246](https://www.ietf.org/rfc/rfc5246.txt) - The Transport Layer Security (TLS) Protocol Version 1.2.
429+
430+- [RFC8446](https://www.ietf.org/rfc/rfc8446.txt) - The Transport Layer Security (TLS) Protocol Version 1.3.
431+
432+- [[Synapse]]
433+
434+- [Synapse documentation](https://synapse.ararat.cz/doku.php/public:howto:tmimepart) on sending attachments.
435+
436+- [Article (PDF)](https://www.freepascal.org/~michael/articles/lazmail/lazmail-en.pdf) that covers sending email, including attachments, using Synapse.
437+
438+- [[lNet examples]] - email example using [[lNet]] library.
439+
440+---
441+*From the Free Pascal wiki, page "Synapse - Email Examples", as it stood on 2022-05-19 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
442+Category: Example programs
443+Category: Networking

Back to history