|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
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)
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Sources de la même categorie
Commentaires et avis
|
|