Italian community of Lazarus and Free Pascal

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.

var PrimaVariabile: integer;

write('Inserisci un numero da uno a dieci: ');
readln(PrimaVariabile);
writeln('Il numero da te immesso è: ', 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;}

• Collegamenti intelligenti (-CX)
• Mostra i numeri di linea nella backtrace degli errori di esecuzione (-gl)
• Esegue strip degli eseguibili (-Xs)
• Link intelligente (-XX)

• Aprire una console
• Tramite console andare nella cartella di Lazarus che contiene il programma STRIP.exe, generalmente c:\Lazarus\fpc\Numero della Versione Pascal\bin\i386-win32 o  c:\Programmi\Lazarus\fpc\Numero della Versione Pascal\bin\i386-win32
• Digitare il comando: strip --strip-all Applicazione.exe
• Digitare il comando: upx -9 Applicazione.exe