* * * *
25 Visitatori, 1 Utente
 

17 Ott 2011 - Mandare mail con Lazarus

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.


Share on Twitter! Digg this story! Del.icio.us Share on Facebook! Technorati Reddit StumbleUpon

Articles in « How to »

Comments *

1) Re: Mandare mail con Lazarus
Written by Narciso il Dicembre 15, 2012, 02:25:52 pm
Il problema si pone se vogliamo che qualcuno invii mail senza dover impostare i dati del server e della password...
la funzione
OpenURL('mailto:nomeo@dominio.com?subject=test&body=Hello World'); 
funziona benissimo, aprendo il client di default che ha quindi gia' tutte le impostazioni attive, purtroppo non e' in grado di aggiungere allegati alla mail...
Se qualcuno conosce il metodo per far aggiungere allegati al messaggio utilizzando il client email di default... si faccia sentire..

Magari qualcuno ci riesce....
2) Re: Mandare mail con Lazarus
Written by mauriziod il Luglio 05, 2013, 04:42:18 pm
È un casino!
Devi tradurlo  in encode64 e metterlo dopo la  &body='qui il testo normale i HTML%0D
--------------020906040306010403090604%0D
Content-Type: image/jpeg;%0D
 name="nomeallegato.jpg"%0D
Content-Transfer-Encoding: base64%0D
Content-Disposition: attachment;%0D
 filename="dati-ci-cf.jpg"%0D
%0D
QUIALLEGATOINBASE64
'%0D

Ovviamente tutto di seguito.

Commenting option has been turned off for this article.

Recenti

How To

Trascinare un file nel programma da xinyiman
DB concetti fondamentali e ZeosLib da xinyiman
Recuperare codice HTML da pagina web da xinyiman
Mandare mail con Lazarus da xinyiman
Stabilire il sistema operativo da xinyiman
Esempio lista in pascal da xinyiman
File INI da xinyiman
Codice di attivazione da xinyiman
Realizzare programmi multilingua da xinyiman
Lavorare con le directory da xinyiman
Utilizzare Unità esterne da Loryea
TTreeView da xinyiman
TTreeview e Menu da xinyiman
Generare controlli RUN-TIME da xinyiman
LazReport, PDF ed immagini da xinyiman
Intercettare tasti premuti da xinyiman
Ampliare Lazarus da xinyiman
Lazarus e la crittografia da xinyiman
System Tray con Lazarus da xinyiman
UIB: Unified Interbase da Microges2000
Il file: questo sconosciuto da Microges2000
Conferma di chiusura di un applicazione da xinyiman
Liste e puntatori da Microges2000
Overload di funzioni da Microges2000
Funzioni a parametri variabili da Microges2000
Proprietà da Microges2000
Conversione numerica da Microges2000
TImage su Form e Panel da Maverich
Indy gestiore server FTP lato Client da Maverich
PopUpMenu sotto Pulsante (TSpeedButton) da Maverich
Direttiva $macro da Microges2000
Toolbar da xinyiman
Evidenziare voci TreeView da Maverich
Visualizzare un file Html esterno da Maverich
StatusBar - aggirare l'errore variabile duplicata da Maverich
Da DataSource a Excel da xinyiman
Le permutazioni da xinyiman
Brute force da xinyiman
Indy 10 - Invio email con allegati da Maverich
La gestione degli errori in Lazarus da xinyiman
Pascal Script da xinyiman
Linux + Zeos + Firebird da xinyiman
Dataset virtuale da xinyiman
Overload di operatori da Microges2000
Lavorare con file in formato JSON con Lazarus da nomorelogic
Zeos ... dietro le quinte (prima parte) da Stilgar
Disporre le finestre in un blocco unico (come Delphi) da Maverich
Aspetto retrò (Cmd Line) da xinyiman
Come interfacciare periferica twain da Narciso
Ubuntu - aggiornare free pascal e lazarus da xinyiman
fpcup: installazioni parallele di lazarus e fpc da nomorelogic
Free Pascal e Lazarus sul Raspberry Pi da nomorelogic
Cifratura: breve guida all'uso dell'algoritmo BlowFish con lazarus e free pascal. da nomorelogic
Creare un server multithread da xinyiman
guida all'installazione di fpc trunk da subversion in linux gentoo da nomorelogic
Indice da nomorelogic
DB concetti fondamentali e connessioni standard da xinyiman
Advanced Record Syntax da nomorelogic
DB concetti fondamentali e DBGrid da xinyiman
DB concetti fondamentali e TDBEdit, TDBMemo e TDBText da xinyiman
Advanced Record Syntax: un esempio pratico da nomorelogic
Superclasse form base per programmi gestionali (e non) da nomorelogic
Superclasse form base per programmi gestionali (e non) #2 - log, exception call stack, application toolbox da nomorelogic
Superclasse form base per programmi gestionali (e non) #3 - traduzione delle form da nomorelogic
Superclasse form base per programmi gestionali (e non) #4 - wait animation da nomorelogic
Un dialog per la connessione al database:TfmSimpleDbConnectionDialog da nomorelogic
Installare lazarus su mac osx sierra da xinyiman
Utenti
Stats
  • Post in totale: 11016
  • Topic in totale: 1366
  • Online Today: 22
  • Online Ever: 74
  • (Luglio 09, 2012, 11:05:53 am)
Utenti Online
Users: 1
Guests: 25
Total: 26

Disclaimer:

Questo blog non rappresenta una testata giornalistica poiché viene aggiornato senza alcuna periodicità. Non può pertanto considerarsi un prodotto editoriale ai sensi della legge n. 62/2001.