TURBO POWER INTERNET PROFESSIONAL : ENVOYER UN EMAIL

unit Unit1;

//Programme par Yoann
//http://delphipage.free.fr/

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IpUtils, IpSock, IpMsg, IpSmtp;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    IpSmtpClient1: TIpSmtpClient;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IpSmtpClient1TaskComplete(Client: TIpCustomSmtpClient;
      Task: TIpSmtpTasks);
    procedure IpSmtpClient1Error(Sender: TObject; Socket: Cardinal;
      ErrCode: Integer; const ErrStr: String);
  private
    { Déclarations privées }
    FTask,FError:Boolean; //La variable "FTask" permet de vérifier si l'email a été envoyé
    procedure Wait;
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button3Click(Sender: TObject);
begin
Close; //Ferme le programme
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit3.Text:=OpenDialog1.FileName; //Edit affiche le fichier choisit
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Screen.Cursor:=crHourGlass; //Curseur sablier
IpSmtpClient1.Message.From :=Edit1.Text; //Adresse email de l'expediteur
IpSmtpClient1.Message.MailTo.Add(Edit2.Text); //Adresse email du destinataire
IpSmtpClient1.Message.Date:=DateToStr(Date); //Date de l'envoi du message
IpSmtpClient1.Message.Subject:=Edit4.Text; //Sujet du message
if not (Edit3.Text='') then IpSmtpClient1.AttachmentList.Add(Edit3.Text); //Attache le fichier
IpSmtpClient1.Message.EncodeBodyStrings(Memo1.Lines,''); //Corps du message
IpSmtpClient1.SendMail('xxxx',False); //Envoi du message à l'hôte (par exemple pour Free : smtp.free.fr)
//"False" permet de se déconnecter du serveur après l'envoit de l'email
Wait; //Appel la procedure "Wait"
if FError=True then ShowMessage('L''email n''a pas été envoyé.'); //Affiche un message si il y a eu une erreur
Screen.Cursor:=crDefault; //Curseur par défaut
end;

procedure TForm1.IpSmtpClient1TaskComplete(Client: TIpCustomSmtpClient;
  Task: TIpSmtpTasks);
begin
if Task = stSendMail then
FTask:=True; //Indique que l'email a été envoyé
end;

procedure TForm1.IpSmtpClient1Error(Sender: TObject; Socket: Cardinal;
  ErrCode: Integer; const ErrStr: String);
begin
//L'événement "OnError" se déclenche quand une erreur est détecté
FError:=True; //Indique qu'une erreur s'est produite
end;

procedure TForm1.Wait;
begin
FTask:=False; //Initialise la variable "FTask" à False ("FTask permet d'indiquer lorsque l'email e été envoyé")
FError:=False; //Initialise la variable "FError" à False ("FError" permet d'indiquer si il y a une erreur)
repeat //Répéter...
Sleep(100); //Attend 100ms
Application.ProcessMessages; //Interrompt l'exécution du programme pour que Windows puisse traiter la file d'attente des messages des autres programmes
until FError or FTask; //...jusqu'à ce qu'il y est une erreur ou que la tâche soit terminé
end;
end.

Télécharger le zip