Se una delle vostre esigenze č mandare una mail tramite un programma scritto in Lazarus, questo How To vi spiegherą come farlo.
Come prima cosa bisogna andare al sito http://www.ararat.cz/synapse/doku.php e scaricare l'ultima versione di Synapse disponibile per Lazarus.
Scompattate il file che avete scaricato e copiare tutti i file contenuti in source\lib dentro la cartella che contiene il vostro progetto.
Dopodiche aggiungete al vostro progetto una nuova unit che chiamerete MyLibMail e che conterrą le seguenti righe.
{
Libreria realizzata da Sammarco Francesco
Mail: francesco.sammarco@gmail.com
Utilitą: mandare email (anche con google)
}
unit MyLibMail;
{$mode objfpc}{$H+}
interface
uses
blcksock, smtpsend, pop3send, ssl_openssl //librerie di synapse
, MimePart, MimeMess,SynaChar
,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
MyMailObject=class
private
StrList: TStringList;
Mime : TMimeMess;
SMTP : TSMTPSend;
MyUser, MyPassword, MySMTPHost, MyPorta, MyNome, MyFrom, MyRisposta, MyOggetto, MyCorpoMail: string;
MySicurezza: integer;
MyTesto, MyToList, MyCCList, MyAllegatoList:TStringList;
tmp : TMemoryStream;
function RetNomeFile(PathFile: string): string;
public
constructor Create();
destructor Destroy();
function MySendMail(var Errore: string): boolean;
procedure SetMyUser(UserP: string);
procedure SetMyPassword(PasswordP: string);
procedure SetMySMTPHost(SMTPHostP: string);
procedure SetMyPorta(PortaP: string);
procedure SetSSLTLS(SicurezzaP: boolean);
procedure SetMyNome(NomeP: string);
procedure SetMyFrom(FromP: string);
procedure SetMyRisposta(RispostaP: string);
procedure AddDestinatario(DestP: string);
procedure AddMyAllegatoList(AllegatoListP: string);
procedure SetMyOggetto(OggettoP: string);
procedure AddRowCorpoMail(RigaP: string);
end;
implementation
constructor MyMailObject.Create();
begin
StrList := TStringList.Create;
MyToList := TStringList.Create;
MyTesto := TStringList.Create;
MyCCList := TStringList.Create;
MyAllegatoList := TStringList.Create;
Mime := TMimeMess.Create;
SMTP := TSMTPSend.Create;
SetMyUser('');
SetMyNome('');
SetMyFrom('');
SetMyPassword('');
SetMyPorta('25');
SetMySMTPHost('');
SetMyOggetto('');
SetSSLTLS(false);
SetMyRisposta('');
end;
Destructor MyMailObject.Destroy();
begin
//Free finale degli oggetti
StrList.Free; //Prova
MyTesto.Free;
MyToList.Free;
MyCCList.Free;
MyAllegatoList.Free;
Mime.Free; //Prova
smtp.Free;
end;
procedure MyMailObject.SetMyUser(UserP: string);
begin
MyUser:=UserP;
end;
procedure MyMailObject.SetMyPassword(PasswordP: string);
begin
MyPassword:=PasswordP;
end;
procedure MyMailObject.SetMySMTPHost(SMTPHostP: string);
begin
MySMTPHost:=SMTPHostP;
end;
procedure MyMailObject.SetMyPorta(PortaP: string);
begin
MyPorta:=PortaP;
end;
procedure MyMailObject.SetSSLTLS(SicurezzaP: boolean);
begin
if SicurezzaP=TRUE then
MySicurezza:=2
else
MySicurezza:=1;
end;
procedure MyMailObject.SetMyNome(NomeP: string);
begin
MyNome:=NomeP;
end;
procedure MyMailObject.SetMyFrom(FromP: string);
begin
MyFrom:=FromP;
end;
procedure MyMailObject.SetMyRisposta(RispostaP: string);
begin
MyRisposta:=RispostaP;
end;
procedure MyMailObject.AddDestinatario(DestP: string);
begin
MyToList.Add(DestP);
end;
procedure MyMailObject.AddMyAllegatoList(AllegatoListP: string);
begin
MyAllegatoList.Add(AllegatoListP);
end;
procedure MyMailObject.SetMyOggetto(OggettoP: string);
begin
MyOggetto:=OggettoP;
end;
procedure MyMailObject.AddRowCorpoMail(RigaP: string);
begin
StrList.Add(RigaP);
end;
function MyMailObject.MySendMail(var Errore: string): boolean;
var
ret: boolean;
k: integer;
begin
ret:=FALSE;
Errore:='';
try
//====================================
//If authorization is required, then fill in username
smtp.UserName := MyUser;
//Specify user's password
smtp.Password := MyPassword;
//Specify target server IP (or symbolic name)
smtp.TargetHost := MySMTPHost;
//Specify target server port
if (Trim(MyPorta) = '') then begin
//Porta non impostata
smtp.TargetPort := '25'; //Porta di default
end
else begin
smtp.TargetPort := MyPorta;
end;
//Enable SSL|TLS protocols
smtp.autoTLS := True;
//smtp.Timeout := 60;
if (MySicurezza = 2) then begin
//SSL/TLS
smtp.FullSSL := True;
end;
//Connect to SMTP server
if not smtp.Login() then Errore:=Concat(Errore, #13#10 , 'SMTP ERROR: Login:' , smtp.EnhCodeString);
//if not smtp.StartTLS () then showmessage('SMTP ERROR: StartTLS:' + smtp.EnhCodeString);
//If you successfully pass authorization to the remote server
if smtp.AuthDone then begin
//Corpo mail
for k := 0 to (MyTesto.Count - 1) do begin
StrList.Add(MyTesto[k]);
end;
//Mime.Header.CharsetCode := UTF_8; //Da' errore
Mime.Header.From := MyNome + ' <' + MyFrom + '>';
//E-mail per rispondere (eventuale)
if (Trim(MyRisposta) = '') then begin
//E-Mail di risposta non indicata
Mime.Header.ReplyTo := MyFrom; //Indirizzo di risposta = indirizzo mittente
end
else begin
//E-Mail di risposta indicata
Mime.Header.ReplyTo := MyRisposta;
end;
//To
for k := 0 to (MyToList.Count - 1) do begin
Mime.Header.ToList.Add(Trim(MyToList[k]));
end;
//CC (eventuale)
if (MyCCList.Count > 0) then begin
for k := 0 to (MyCCList.Count - 1) do begin
Mime.Header.CCList.Add(Trim(MyCCList[k]));
end;
end;
//Oggetto
Mime.Header.Subject := MyOggetto;
//Corpo mail
Mime.AddPartMultipart(MyCorpoMail, Nil);
Mime.AddPartText(StrList, Mime.MessagePart);
//Eventuali allegati
if (MyAllegatoList.Count > 0) then begin
//Ci sono allegati
{//Questo blocco funziona correttamente, ma non e' possibile impostare il nome degli allegati che vengono poi visualizzati dal destinatario
for k := 0 to (MyAllegatoList.Count - 1) do begin
hdAttach := Trim(MyAllegatoList[k]);
if (hdAttach <> '') then begin
Mime.AddPartBinaryFromFile(hdAttach, Mime.MessagePart);
end;
end;
}
tmp := TMemoryStream.Create;
for k := 0 to (MyAllegatoList.Count - 1) do begin
try
tmp.Clear; //Cmq. non sembra necessario
tmp.LoadFromFile(Trim(MyAllegatoList[k]));
Mime.AddPartBinary(tmp, RetNomeFile(MyAllegatoList[k]), Mime.MessagePart); //Nome da visualizzare allegato
finally
//tmp.Free;
end;
end;
tmp.Free;
end;
//Codifica messaggio
Mime.EncodeMessage;
//Invio: From
if not SMTP.MailFrom(MyFrom, Length(Mime.Lines.Text)) then exit;
//Invio: To
for k := 0 to (MyToList.Count - 1 ) do begin
if not SMTP.MailTo(Trim(MyToList[k])) then exit;
end;
//Invio: CC
if (MyCCList.Count > 0) then begin
//Ci sono indirizzi CC
for k := 0 to (MyCCList.Count - 1) do begin
if not SMTP.MailTo(Trim(MyCCList[k])) then exit;
end;
end;
//Invio: Corpo messaggio + eventuali allegati
if not SMTP.MailData(Mime.Lines) then exit;
end;
//Logout
if not smtp.Logout() Then
Errore:=Concat(Errore, #13#10 , 'SMTP ERROR: Logout:' , smtp.EnhCodeString);
//Se arrivati qui tutto OK
ret := True; //OK
Result:=ret;
finally
//Processa messaggi
Application.ProcessMessages;
end;
end;
function MyMailObject.RetNomeFile(PathFile: string): string;
var
car, car2, ret: string;
i: integer;
begin
ret:='';
car:='/';
{$IFDEF WIN32}
car:='\';
{$ENDIF}
for i:=1 to Length(PathFile) do
begin
car2:=PathFile[i];
if car2=car then
begin
ret:='';
end
else
begin
ret:=Concat(ret, car2);
end;
end;
RetNomeFile:=ret;
end;
end.
Ora ipotizziamo che il progetto contiene solo una form di nome Unit1 e che a sua volta contiene solo un pulsante chiamato Button1. Il codice del programma sarą.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls
,MyLibMail
;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
app: MyMailObject;
elenco: TStringList;
Errore: string;
begin
app:=MyMailObject.Create;
{setto i parametri}
app.SetMyUser('xxx@lazaruspascal.it');
app.SetMyNome('xxx');
app.SetMyFrom('xxx@lazaruspascal.it');
app.SetMyPassword('*****');
app.SetMyPorta('25'); //set to gmail
app.SetMySMTPHost('smtp.xxx.it'); //set to gmail
app.SetMyOggetto('MyObject');
//app.SetSSLTLS(TRUE);
app.AddDestinatario('francesco.sammarco@mauli.it');
//app.AddMyAllegatoList('c:\1.txt');
//app.AddMyAllegatoList('c:\2.txt');
app.AddRowCorpoMail('PIPPO');
app.AddRowCorpoMail('PLUTO2');
{ invio la mail }
app.MySendMail(Errore);
if Length(TRim(Errore))>0 then
ShowMessage(Errore);
{ libero la memoria }
app.Destroy();
ShowMessage('FINISH');
end;
end.
Potete trovare un esempio di quanto appena fatto e detto qui: www.lazaruspascal.it/esempi/Libreria_Posta.zip
In linux bisogna installare: libssl-dev
In windows: la dll necessaria per far funzionare il tutto č nella cartella Libreria_Posta.
Libreria_Posta\ = cartella con le librerie necessarie
Libreria_Posta\ProvaLib = test di esempio
Spero che questo articolo vi sia stato d'aiuto.