Accueil > > > ENVOYER UN EMAIL AVEC ATTACHEMENT DE FICHIER
ENVOYER UN EMAIL AVEC ATTACHEMENT DE FICHIER
Information sur la source
Description
Ce prog permet d'envoyer un email et d'attacher des fichiers si on veux........ Utilisation de thread pour l'emission(mieux que le compo antifrezze d'indy)...ceci est un bon exemple pour les newbies (tout le monde l'a été un jour!!!) Sinon j'ai un petit pb lorsque je j'utilise l evt OnWorkBegin de SMTP la constante AWorkCountMax reste toujours nul!!!!!!!! Par conséquent je ne peux pas utiliser une barre de progression........Si quelqu'un a une idée je suis ouvert a tous.... PS:Pour utiliser mon prog il vous faut les composants DcScript ces composants permettent d'avoir une application du style de winamp..
Source
- unit EmailSender1;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, DSBtExit, DSControls, DSPanel, DSMagnetic, DSMarquee, DSButton,
- DSBtMenu, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,
- IdTCPClient, IdMessageClient, IdSMTP, StdCtrls, DSPanelTools, ShellApi,
- ExtCtrls, DSPanelTitle, DSImgBarre, DSProgress, DSScope;
-
- type
- TSend1 = class(TThread)
- private
-
- protected
- procedure Execute();override;
- public
- constructor Create();
- end;
-
- TForm1 = class(TForm)
- DSPanel1: TDSPanel;
- DSBtExit1: TDSBtExit;
- DSMarquee1: TDSMarquee;
- DSBtMenu1: TDSBtMenu;
- DSButton1: TDSButton;
- DSPanelTools1: TDSPanelTools;
- Label1: TLabel;
- IdSMTP1: TIdSMTP;
- IdMessage1: TIdMessage;
- DSPanelTools2: TDSPanelTools;
- Edit1: TEdit;
- DSPanelTitle1: TDSPanelTitle;
- DSPanelTools3: TDSPanelTools;
- Memo1: TMemo;
- DSPanelTools4: TDSPanelTools;
- ListBox1: TListBox;
- DSIndicator1: TDSIndicator;
- procedure DSBtExit1Click(Sender: TObject);
- procedure DSBtMenu1Click(Sender: TObject);
- procedure DSButton1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode;
- const AWorkCount: Integer);
- private
- { Déclarations privées }
- public
- procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
- { Déclarations publiques }
- end;
-
- var
- Form1: TForm1;
-
- implementation
- Uses WinInet;
- {$R *.dfm}
-
- constructor TSend1.Create;
- begin
- //ca je c pas a koi ca sert, mais ca sert
- FreeOnTerminate := True;
- inherited Create(false);
- //changer la priorité de la boucle
- Priority := tpHigher;
- end;
-
- function Detection_Connexion :boolean;
- var
- dwFlags : DWORD;
- begin
- dwFlags :=INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN
- + INTERNET_CONNECTION_PROXY ;
- RESULT := InternetGetConnectedState(@dwFlags,0);
- end;
-
- procedure TForm1.IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode;
- const AWorkCount: Integer);
- begin
- DSIndicator1.Position := Round(AWorkCount);
- end;
-
- procedure TSend1.Execute; //code à executer par le thread
- begin
- inherited;
- if Detection_Connexion = true then
- begin
- Form1.Label1.Caption:= 'Connexion...';
- Form1.IdSMTP1.Connect; //Connexion
- try
- Form1.Label1.Caption:= 'Emission...';
- Form1.IdSMTP1.Send(Form1.IdMessage1); //Envoi du message
- finally
- Form1.IdSMTP1.Disconnect; //Déconnexion
- Form1.Label1.Caption:= 'Email envoyé...';
- end;
- Form1.ListBox1.Items.Clear;
- Form1.Memo1.Clear;
- Terminate;
- end
- else
- begin
- Form1.Label1.Caption:= 'Pas connecté à internet';
- Terminate;
- end;
- end;
-
- procedure TForm1.WMDropFiles(var msg : TMessage);
- var
- hand: THandle;
- nbFich, i : integer;
- buf:array[0..254] of Char;
- begin
- hand:=msg.wParam;
- nbFich:= DragQueryFile(hand, 4294967295, buf, 254);
- for i:= 0 to nbFich - 1 do
- begin
- DragQueryFile(hand, i, buf, 254);
- Form1.ListBox1.Items.Add(buf);
- end;
- DragFinish(hand);
- end;
-
- procedure TForm1.DSBtExit1Click(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TForm1.DSBtMenu1Click(Sender: TObject);
- begin
- Application.Minimize;
- end;
-
- procedure TForm1.DSButton1Click(Sender: TObject);
- var
- I: Integer;
- begin
- //Prepare le corps de l email
- IdMessage1.Clear; //Efface l'entête et le corps du message
- IdMessage1.From.Text:='EmailSender@hotmail.com'; //Adresse email de l'expediteur
- IdMessage1.ReplyTo.EMailAddresses:='EmailSender@hotmail.com'; //Adresse email où le destinataire pourra répondre
- IdMessage1.Recipients.EMailAddresses:=Edit1.Text; //Adresse email du destinataire
- IdMessage1.Date:=Date; //Date de l'envoi du message
- IdMessage1.Subject:='File(s) from EmailSender v2.00'; //Sujet du message
- IdMessage1.Priority:=mpNormal; //Priorité du message
- IdMessage1.Body.Assign(Memo1.Lines); //Corps du message
- //Attache les fichiers
- I:=0;
- ListBox1.Items.Add('Fin');
- Application.ProcessMessages;
- while not(ListBox1.Items[I] = 'Fin') do
- begin
- if fileexists(ListBox1.Items[I]) then
- TIdAttachment.Create(idmessage1.MessageParts,ListBox1.Items[I]);
- I:=I+1;
- end;
- //Connexion au serveur smtp
- IdSMTP1.AuthenticationType:=atLogin; //Type d'authentification
- IdSMTP1.Host:='smtp.laposte.net'; //Hôte (ou par exemple pour Free : smtp.free.fr)
- IdSMTP1.Port:=25; //Port (par exemple pour Free : 25)
- IdSMTP1.UserName:='***i.***'; //Nom d'utilisateur
- IdSMTP1.Password:='****'; //Mot de passe
- TSend1.Create;
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- Form1.Height:=205;
- Form1.Width:=285;
- DSPanel1.Left:=0;
- DSPanel1.Top:=0;
- DSPanel1.Width:=285;
- DSPanel1.Height:=205;
- DragAcceptFiles(Handle, true);
- DSIndicator1.Position := 0;
- end;
-
- end.
unit EmailSender1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DSBtExit, DSControls, DSPanel, DSMagnetic, DSMarquee, DSButton,
DSBtMenu, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdMessageClient, IdSMTP, StdCtrls, DSPanelTools, ShellApi,
ExtCtrls, DSPanelTitle, DSImgBarre, DSProgress, DSScope;
type
TSend1 = class(TThread)
private
protected
procedure Execute();override;
public
constructor Create();
end;
TForm1 = class(TForm)
DSPanel1: TDSPanel;
DSBtExit1: TDSBtExit;
DSMarquee1: TDSMarquee;
DSBtMenu1: TDSBtMenu;
DSButton1: TDSButton;
DSPanelTools1: TDSPanelTools;
Label1: TLabel;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
DSPanelTools2: TDSPanelTools;
Edit1: TEdit;
DSPanelTitle1: TDSPanelTitle;
DSPanelTools3: TDSPanelTools;
Memo1: TMemo;
DSPanelTools4: TDSPanelTools;
ListBox1: TListBox;
DSIndicator1: TDSIndicator;
procedure DSBtExit1Click(Sender: TObject);
procedure DSBtMenu1Click(Sender: TObject);
procedure DSButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
private
{ Déclarations privées }
public
procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
Uses WinInet;
{$R *.dfm}
constructor TSend1.Create;
begin
//ca je c pas a koi ca sert, mais ca sert
FreeOnTerminate := True;
inherited Create(false);
//changer la priorité de la boucle
Priority := tpHigher;
end;
function Detection_Connexion :boolean;
var
dwFlags : DWORD;
begin
dwFlags :=INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN
+ INTERNET_CONNECTION_PROXY ;
RESULT := InternetGetConnectedState(@dwFlags,0);
end;
procedure TForm1.IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
DSIndicator1.Position := Round(AWorkCount);
end;
procedure TSend1.Execute; //code à executer par le thread
begin
inherited;
if Detection_Connexion = true then
begin
Form1.Label1.Caption:= 'Connexion...';
Form1.IdSMTP1.Connect; //Connexion
try
Form1.Label1.Caption:= 'Emission...';
Form1.IdSMTP1.Send(Form1.IdMessage1); //Envoi du message
finally
Form1.IdSMTP1.Disconnect; //Déconnexion
Form1.Label1.Caption:= 'Email envoyé...';
end;
Form1.ListBox1.Items.Clear;
Form1.Memo1.Clear;
Terminate;
end
else
begin
Form1.Label1.Caption:= 'Pas connecté à internet';
Terminate;
end;
end;
procedure TForm1.WMDropFiles(var msg : TMessage);
var
hand: THandle;
nbFich, i : integer;
buf:array[0..254] of Char;
begin
hand:=msg.wParam;
nbFich:= DragQueryFile(hand, 4294967295, buf, 254);
for i:= 0 to nbFich - 1 do
begin
DragQueryFile(hand, i, buf, 254);
Form1.ListBox1.Items.Add(buf);
end;
DragFinish(hand);
end;
procedure TForm1.DSBtExit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.DSBtMenu1Click(Sender: TObject);
begin
Application.Minimize;
end;
procedure TForm1.DSButton1Click(Sender: TObject);
var
I: Integer;
begin
//Prepare le corps de l email
IdMessage1.Clear; //Efface l'entête et le corps du message
IdMessage1.From.Text:='EmailSender@hotmail.com'; //Adresse email de l'expediteur
IdMessage1.ReplyTo.EMailAddresses:='EmailSender@hotmail.com'; //Adresse email où le destinataire pourra répondre
IdMessage1.Recipients.EMailAddresses:=Edit1.Text; //Adresse email du destinataire
IdMessage1.Date:=Date; //Date de l'envoi du message
IdMessage1.Subject:='File(s) from EmailSender v2.00'; //Sujet du message
IdMessage1.Priority:=mpNormal; //Priorité du message
IdMessage1.Body.Assign(Memo1.Lines); //Corps du message
//Attache les fichiers
I:=0;
ListBox1.Items.Add('Fin');
Application.ProcessMessages;
while not(ListBox1.Items[I] = 'Fin') do
begin
if fileexists(ListBox1.Items[I]) then
TIdAttachment.Create(idmessage1.MessageParts,ListBox1.Items[I]);
I:=I+1;
end;
//Connexion au serveur smtp
IdSMTP1.AuthenticationType:=atLogin; //Type d'authentification
IdSMTP1.Host:='smtp.laposte.net'; //Hôte (ou par exemple pour Free : smtp.free.fr)
IdSMTP1.Port:=25; //Port (par exemple pour Free : 25)
IdSMTP1.UserName:='***i.***'; //Nom d'utilisateur
IdSMTP1.Password:='****'; //Mot de passe
TSend1.Create;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Height:=205;
Form1.Width:=285;
DSPanel1.Left:=0;
DSPanel1.Top:=0;
DSPanel1.Width:=285;
DSPanel1.Height:=205;
DragAcceptFiles(Handle, true);
DSIndicator1.Position := 0;
end;
end.
Conclusion
Pour ajouter un fichier il suffit de le faire glisser et de le déposer dessus...... Si vous avez des améliorations a me soumettre pas de problème.. ("C'est par les autres que l'on peut progresser" Blueangel)
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
[MIX10] KEYNOTE DEUXIèME JOURNéE - INTERNET EXPLORER 9, HTML5, VISUAL STUDIO 2010, ODATA[MIX10] KEYNOTE DEUXIèME JOURNéE - INTERNET EXPLORER 9, HTML5, VISUAL STUDIO 2010, ODATA par cyril
Le deuxième keynote du mix fut très riche en contenu. Internet Explorer 9 Juste un après le lancement de Internet Explorer 8, Microsoft a dévoilé les nouveautés de Internet Explorer 9. Désormais, IE supportera HTML5, SVG et CSS3. L'élément ...
Cliquez pour lire la suite de l'article par cyril CERTIFICATIONS BETA .NET 4CERTIFICATIONS BETA .NET 4 par KooKiz
Les inscriptions pour les certifications beta .NET 4 ont commencé. L'inscription est offerte pour les examens suivants : - 71-511, TS: Windows Applications Development with Microsoft .NET Framework 4 - 71-515, TS: Web Applications Development with...
Cliquez pour lire la suite de l'article par KooKiz [MIX 2010] - MICROSOFT TRANSLATOR TECHNOLOGY PREVIEW V2[MIX 2010] - MICROSOFT TRANSLATOR TECHNOLOGY PREVIEW V2 par redo
J'imagine que la plupart d'entre vous connaissent bien et utilisent le service de traduction de Google, mais connaissez-vous celui de Microsoft . Microsoft Translator ? Effectivement, Microsoft nous annoncé le lancement version 2 de la Technologie Preview...
Cliquez pour lire la suite de l'article par redo LANCEMENT EN PREVIEW DE CYCLONE LORS DES TECHDAYS 2010!LANCEMENT EN PREVIEW DE CYCLONE LORS DES TECHDAYS 2010! par MPOWARE
Toutes les vidéos de ce lancement sont en ligne!
Partie I - Intro
http://www.youtube.com/watch?v=LkQzTQ8T6CA
Partie II - Démo 1
http://www.youtube.com/watch?v=drAhYQ7lqvo
Partie III - Démo 2
http://www.youtube.com/watch?v=c8KM_1Gqybc...
Cliquez pour lire la suite de l'article par MPOWARE
Logiciels
Academy System (10.9.4.0)ACADEMY SYSTEM (10.9.4.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Xilisoft Convertisseur Vidéo Ultimate (5.1.39.0305)XILISOFT CONVERTISSEUR VIDéO ULTIMATE (5.1.39.0305)Xilisoft Convertisseur Vidéo Ultimate est un outil puissant de conversion vidéo, facile à utilise... Cliquez pour télécharger Xilisoft Convertisseur Vidéo Ultimate Xilisoft DVD Ripper Ultimate (5.0.64.0304)XILISOFT DVD RIPPER ULTIMATE (5.0.64.0304)Xilisoft DVD Ripper Ultimate est un logiciel excellent pour copier et convertir DVD vers presque ... Cliquez pour télécharger Xilisoft DVD Ripper Ultimate Rigs of Rods (63.3)RIGS OF RODS (63.3)c'est un jeu de multi-simulation camions,autobus voitures, avions, bateaux, hélicoptère avec défo... Cliquez pour télécharger Rigs of Rods
|