Se non siete riusciti a reperire l'informazione che cercavate nei nostri articoli o sul nostro forum vi consiglio di visitare il
Forum ufficiale di Lazarus in lingua inglese.




(Rates: 1)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.
Citazionevar PrimaVariabile: integer;
write('Inserisci un numero da uno a dieci: ');
readln(PrimaVariabile);
writeln('Il numero da te immesso è: ', PrimaVariabile);
repeat until keypressed;clrscr();
writeln('La costante da me dichiarata con il nome MiaCostante ha un valore di:', MiaCostante);
PrimaVariabile := 'A';
SecondaVariabile := 3;
TerzaVariabile := 3.3;
QuartaVariabile := TerzaVariabile + 1;
QuintaVariabile := 'Ecco a cosa servono le variabili!';
writeln('PrimaVariabile: ', PrimaVariabile);
writeln('SecondaVariabile: ', SecondaVariabile);
writeln('TerzaVariabile: ', TerzaVariabile);
writeln('QuartaVariabile: ', QuartaVariabile);
writeln('QuintaVariabile: ', QuintaVariabile);
writeln('La costante da me dichiarata con il nome MiaCostante ha un valore di:', MiaCostante);
PrimaVariabile := 'B';
SecondaVariabile := SecondaVariabile + 2;
TerzaVariabile := 3.3 + 1;
QuartaVariabile := TerzaVariabile + 1;
QuintaVariabile := 'Ecco a cosa servono le variabili! Fine';
writeln('PrimaVariabile: ', PrimaVariabile);
writeln('SecondaVariabile: ', SecondaVariabile);
writeln('TerzaVariabile: ', TerzaVariabile);
writeln('QuartaVariabile: ', QuartaVariabile);
writeln('QuintaVariabile: ', QuintaVariabile);
repeat until keypressed;
var
ErrorMsg: String;
var
ErrorMsg: String;
PrimaVariabile: char;
SecondaVariabile: integer;
TerzaVariabile, QuartaVariabile: real;
QuintaVariabile: string;
const
MiaCostante = 5;
| Tipo | Range | Dimensione in bytes |
| Byte | 0..255 | 1 |
| Shortint | -128..127 | 1 |
| Smallint | -32768..32767 | 2 |
| Word | 0..65535 | 2 |
| Integer | o Smallint o Longint | 2 o 4 |
| Cardinal | Longword | 4 |
| Longint | -2147483648 .. 2147483647 | 4 |
| Longword | 0..4294967295 | 4 |
| Int64 | -9223372036854775808 .. 9223372036854775807 | 8 |
| QWord | 0 .. 18446744073709551615 | 8 |
| Nome | Dimensione in bytes | Valore TRUE/VERO |
| Boolean | 1 | 1 |
| ByteBool | 1 | Qualsiasi valore diverso da zero |
| WordBool | 2 | Qualsiasi valore diverso da zero |
| LongBool | 4 | Qualsiasi valore diverso da zero |
NomeVariabile: string[50];NomeVariabile: AnsiString; program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, Crt
{ you can add units after this };
type
{TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
PrimaVariabile: string[10];
SecondaVariabile: AnsiString;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg'' then
begin
ShowException(Exception.Create(ErrorMsg));
Halt;
end;
// parse parameters
if HasOption('h','help') then
begin
WriteHelp;
Halt;
end;
{ add your program here }
clrscr();
PrimaVariabile:='sono 10 lettere mie';
SecondaVariabile:='sono 10 lettere';
writeln(PrimaVariabile);
writeln(SecondaVariabile);
repeat until keypressed;
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.Run;
Application.Free;
end.
var
PrimaVariabile: Pchar;
PrimaVariabile:='Questa stringa termina con il null';
writeln(PrimaVariabile);
repeat
until keypressed;
const
SecondaVariabile: Pchar = 'Questa stringa termina con il null';
writeln(PrimaVariabile);
repeat
until keypressed;program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
{ you can add units after this };
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
Esco: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg'' then begin
ShowException(Exception.Create(ErrorMsg));
Halt;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Halt;
end;
{ add your program here }
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.Run;
Application.Free;
end. { add your program here }
writeln('Primo programma');
Clrscr;
writeln('Hello world!');
write('Ciao');
write(' ');
write('mondo!');
readkey; {volendo avrei potuto usare anche la dicitura: repeat until keypressed;}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp
{ you can add units after this };
, Crt.
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, Crt
{ you can add units after this };
program project1; program PrimoProgramma;writeln('Primo programma');Clrscr;writeln('Hello world!');write('Ciao');Write(' ');write('mondo!'); readkey; {volendo avrei potuto usare anche la dicitura: repeat until keypressed;}