Envoyer un mail en utilisant mon compte Google Mail avec un dérivé de TSMTPSend

**JP CASSOU** · 29/04/2024, 22h38

Bjr à vous,

Je désire envoyer un mail via mon application en utilisant un dérivé de TSMTPSend décrit dans l'unité mailsendu.pas jointe:

Utilisation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
procedure TdlgTestsUnitaires.btnMailToClick(Sender: TObject);
var
 
  LSBody: TStringList;
  LSAttachments: TStringList;
  AFrom, ATo, ASubject: String;
 
begin
  AFrom         := 'xxxx@gmail.com';   // AFrom
  ATo            := 'yyyyyy@gmail.com';   // ATo
  ASubject      := 'Test subject FullSSL 2'; // ASubject
  LSBody        := TStringList.Create;
  LSAttachments := TStringList.Create;
  try
    LSBody.Clear;
    LSAttachments.Clear;
    LSBody.Add('Lorem gypsum');
    LSBody.Add('De profundis');
    LSBody.Add('Morpionibus');
    SendAMessage(AFrom, ATo, ASubject, LSBody, LSAttachments);
 
 
  finally
    FreeandNil(LSBody);
    FreeandNil(LSAttachments);
  end;

Je tombe évidemment sur des erreurs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Envoi de mail
SendAMessage(): From xxxxx@gmail.com - To yyyyyy@gmail.com - Subject: Test subject FullSSL 2 - NbRows: 3
Lorem gypsum
De profundis
Morpionibus
 
Failure!
EXCEPTION: Synapse TCP/IP Socket error 10038: Socket operation on nonsocket
------
  ResultCode: 221
ResultString: 221 2.0.0 closing connection am19-20020a170906569300b00a55bce09954sm9270123ejc.34 - gsmtp
  FullResult: 221 2.0.0 closing connection am19-20020a170906569300b00a55bce09954sm9270123ejc.34 - gsmtp
 
    AuthDone: 0

Quelques pistes ?

Cdlt

Code de l'unité

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
 
unit mailsendu;
// TODO: Voir aussi: XMailer: https://github.com/MFernstrom/xmailer
 
{$mode objfpc}{$H+}
 
{$DEFINE FORUM_DVP}
{$UNDEF FORUM_DVP}
interface
 
uses
  {$IFNDEF FORUM_DVP}
  Common,   // pour AfficherMessageErreur,
  {$ENDIF}
  Classes, SysUtils, smtpsend, blcksock;
 
type
 
{ TSink }
 
 TSink = class(TObject)
   public
     procedure Progress(Sender: TObject; Reason: THookSocketReason;const Value: String);
 end;
//*******************************************************************
type
 
  { TMySMTPSend }
 
  TMySMTPSend = class(TSMTPSend)
  private
    FSendSize: Integer;
  protected
    function SendToRaw(const AFrom, ATo: String; const AMailData: TStrings): Boolean;
  public
    function SendMessage(const AFrom, ATo, ASubject: String; const AContent, AAttachments: TStrings): Boolean;
 
    property SendSize: Integer read FSendSize write FSendSize;
 
  end;
 
function SendAMessage(const AFrom, ATo, ASubject: String; const AContent, AAttachments: TStrings): boolean;
 
 
implementation
 
uses
  ssl_openssl, mimemess, mimepart, synautil, synachar;
{$IFDEF FORUM_DVP}
procedure pass;
begin
  ;;
end;
procedure AfficherMessageErreur(const Msg: string); overload;
begin
  WriteLn(Msg);
end;
procedure AfficherMessageErreur(const FMT: string; const Argv: array of const); overload;
begin
  AfficherMessageErreur(format(FMT, Argv));
end;
{$ENDIF FORUM_DVP}
 
 
{ TSink }
 
procedure TSink.Progress(Sender: TObject; Reason: THookSocketReason; const Value: String);
begin
  case Reason  of
    {:Socket connected to IP and Port. Connected IP and Port is in parameter in
     format like: 'localhost.somewhere.com:25'.}
    HR_Connect: pass;
    {:report count of bytes writed to socket. Number is in parameter string. If
     you need is in integer, you must use StrToInt function!}
    HR_WriteCount:
      begin
        pass;
      end;
    {:report situation where communication error occured. When raiseexcept is
     @true, then exception is called after this Hook reason.}
    HR_Error: pass; //AfficherMessageErreur('Error: ', Value);
  end;
end;
 
{ TMySMTPSend }
 
function TMySMTPSend.SendToRaw(const AFrom, ATo: String; const AMailData
  : TStrings): Boolean;
var
  S, T: String;
begin
  Result := False;
  if Self.Login then
  begin
    FSendSize := Length(AMailData.Text);
    if Self.MailFrom(GetEmailAddr(AFrom), FSendSize) then
    begin
      S := ATo;
      repeat
        T := GetEmailAddr(Trim(FetchEx(S, ',', '"')));
        if T <> '' then
          Result := Self.MailTo(T);
        if not Result then
          Break;
      until S = '';
      if Result then
        Result := Self.MailData(AMailData);
    end;
    Self.Logout;
  end;
end;
 
function TMySMTPSend.SendMessage(const AFrom, ATo, ASubject: String; const AContent, AAttachments: TStrings): Boolean;
var
  Mime: TMimeMess;
  P: TMimePart;
  I: Integer;
begin
  Mime := TMimeMess.Create;
  try
    // Set some headers
    Mime.Header.CharsetCode := UTF_8;
    Mime.Header.ToList.Text := ATo;
    Mime.Header.Subject := ASubject;
    Mime.Header.From := AFrom;
 
    // Create a MultiPart part
    P := Mime.AddPartMultipart('mixed', Nil);
 
    // Add as first part the mail text
    Mime.AddPartTextEx(AContent, P, UTF_8, True, ME_8BIT);
 
    // Add all attachments:
    if Assigned(AAttachments) then
      for I := 0 to Pred(AAttachments.Count) do
        Mime.AddPartBinaryFromFile(AAttachments[I], P);
 
    // Compose message
    Mime.EncodeMessage;
 
    // Send using SendToRaw
    Result := Self.SendToRaw(AFrom, ATo, Mime.Lines);
 
  finally
    Mime.Free;
  end;
end;
 
function SendAMessage(const AFrom, ATo, ASubject: String; const AContent, AAttachments: TStrings): boolean;
var
  Sink: TSink;
  SMTP: TMySMTPSend;
begin
  AfficherMessageErreur('SendAMessage(): From %s - To %s - Subject: %s - NbRows: %d', [ AFrom, ATo, ASubject, AContent.Count]);
  Sink := TSink.Create;
  SMTP := TMySMTPSend.Create;
 
  try
    SMTP.TargetHost := 'smtp.gmail.com';
    SMTP.TargetPort := '587';
    SMTP.Username := 'xxxxxxxx@gmail.com';
    SMTP.Password := '<pwd>';
    SMTP.AutoTLS  := True;
    //SMTP.FullSSL  := true;
    SMTP.Sock.OnStatus := @Sink.Progress;
    SMTP.Sock.RaiseExcept := True;
    SMTP.Timeout := 5 * 60;
    AfficherMessageErreur(AContent.Text);
    try
      SMTP.Login;
      SMTP.StartTLS;
      if (SMTP.SendMessage(AFrom, ATo, ASubject, AContent, AAttachments))
      then
        AfficherMessageErreur('Success.')
      else
      begin
        AfficherMessageErreur('Failure!');
      end;
      SMTP.Logout;
    except
      on E: Exception do
        AfficherMessageErreur('EXCEPTION: %s', [E.Message]);
    end;
 
    with SMTP do
    begin
      AfficherMessageErreur('------');
      AfficherMessageErreur('  ResultCode: %d', [ ResultCode]);
      AfficherMessageErreur('ResultString: %s', [ResultString]);
      AfficherMessageErreur('  FullResult: %s', [FullResult.Text]);
      AfficherMessageErreur('    AuthDone: %s', [booltoStr(AuthDone)]);
    end;
  finally
    FreeAndNil(Sink);
    FreeAndNil(SMTP);
  end;
end;
end.

**anapurna** · 30/04/2024, 08h57

Salut

ici tu trouveras les informations de connexion

il y a des exemples de connexion à GMail avec Delphi ici

Sinon tu peux faire aussi un truc du genre afin d'utiliser le SSL :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 Const 
  SMTPPort : String = '465'; 

...   
    SMTP.TargetHost := 'smtp.gmail.com';
    SMTP.TargetPort := SMTPPort;
    SMTP.Username := 'xxxxxxxx@gmail.com';
    SMTP.Password := '<pwd>';
    SMTP.AutoTLS  := True;
    if SMTPPort <> 25 Then 
      SMTP.FullSSL  := true;

**JP CASSOU** · 30/04/2024, 19h16

Ne fonctionne pas.

Avec le paramétrage suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
SMTP.TargetHost := ASMTPHost; //  (Mon mail Google)
    SMTP.TargetPort := ASMTPPort; // 25, 465 ou 587
 
    SMTP.Username   := (Mon mail Google)
    SMTP.Password   := <password>
    SMTP.AutoTLS    := True;
 
    SMTP.FullSSL  := (SMTP.TargetPort <> '25');
    SMTP.Sock.OnStatus := @Sink.Progress;
    SMTP.Sock.RaiseExcept := True;
    SMTP.Sock.SSL.SSLType:= TSSLType.LT_TLSv1;                
SMTP.Sock.

j'ai ceci avec le port 587.
Avec les autres ports (465 ou 25), j'ai une erreur 221

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Envoi de mail
SendAMessage(): From xxxxx@gmail.com - To yyyy@sud-ouest.org - Subject: Test subject FullSSL 1- NbRows: 3
Lorem gypsum
De profundis
Morpionibus
 
TMySMTPSend.TMySMTPSend.SendToRaw():
EXCEPTION: Synapse TCP/IP Socket error 10091: error:1408F10B:SSL routines:SSL3_GET_RECORD:wrong version number
------
  ResultCode: 0
ResultString: 
  FullResult: 
    AuthDone: ---

Pénible +++
PS: La fonction smtpsend.SendToEx() ne marche pas non plus

Envoyé par anapurna

salut

ici tu trouvera les information de connexion

il y a des exemple de connexion a gmail avec delphi ici

sinon tu peut faire aussi un truc du genre afin d'utiliser le SSL

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 Const 
  SMTPPort : String = '465'; 

...   
    SMTP.TargetHost := 'smtp.gmail.com';
    SMTP.TargetPort := SMTPPort;
    SMTP.Username := 'xxxxxxxx@gmail.com';
    SMTP.Password := '<pwd>';
    SMTP.AutoTLS  := True;
    if SMTPPort <> 25 Then 
      SMTP.FullSSL  := true;

**Chrispi** · 01/05/2024, 11h27

Bonjour,

Attention, depuis quelques temps déjà, pour envoyer avec une application un email via Gmail il faut utiliser un «*mot de passe d'application*» pour la configuration du serveur SMTP.

https://support.google.com/mail/answer/185833?hl=fr

Pour info, je suis en attente de validation d'un tuto pour envoyer des emails en utilisant la bibliothèque CDO de Microsoft.

Bonne journée.

Chrispi

**Guesset** · 02/05/2024, 09h36

Bonjour

Sous Windows, il y a aussi la solution du ShellExecute comme montré ici : https://www.tek-tips.com/viewthread.cfm?qid=1071099

Salutations

**JP CASSOU** · 04/05/2024, 01h45

Envoyé par Chrispi

Bonjour,

Attention, depuis quelques temps déjà, pour envoyer avec une application un email via Gmail il faut utiliser un «*mot de passe d'application*» pour la configuration du serveur SMTP.

https://support.google.com/mail/answer/185833?hl=fr

Pour info, je suis en attente de validation d'un tuto pour envoyer des emails en utilisant la bibliothèque CDO de Microsoft.

Bonne journée.

Chrispi

C'était donc pour cette raison que çà ne fonctionnait pas avec gmail

J'ai testé avec le service smtp de mon FAI: Cà fonctionne avec mon exemple 'De profundis Morpionibus'
donc: Résolu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
function SendAMessage(const ASSLType: byte; const ASMTPHost, ASMTPPort, AFrom, ATo, ASubject: String; const AContent, AAttachments: TStrings): boolean;
var
  Sink: TSink;
  SMTP: TMySMTPSend;
  B: Boolean;
begin
  AfficherMessageErreur('SendAMessage(): From %s - To %s - Subject: %s - NbRows: %d', [ AFrom, ATo, ASubject, AContent.Count]);
 
  Sink := TSink.Create;
  SMTP := TMySMTPSend.Create;
  try
    SMTP.TargetHost := ASMTPHost;
    SMTP.TargetPort := ASMTPPort;
    SMTP.Sock.SSL.SSLType:= TSSLType(ASSLType);
 
    SMTP.Username   := <mon adresse mail>
    SMTP.Password   := <mon mot de passe>
    SMTP.AutoTLS    := True;
    SMTP.FullSSL    := (SMTP.TargetPort <> '25');
    SMTP.Sock.OnStatus := @Sink.Progress;
    SMTP.Sock.RaiseExcept := True;
    SMTP.Timeout := 5 * 60 * 1000; // Timeout est en ms
    AfficherMessageErreur(AContent.Text);
    try
      //SMTP.Login; // Inutile: TMySMTPSend.Login() et TMySMTPSend.Logout() sont appelés par TMySMTPSend.SendMessage();
      if (SMTP.SendMessage(AFrom, ATo, ASubject, AContent, AAttachments))
      then
        AfficherMessageErreur('Success.')
      else
      begin
        AfficherMessageErreur('Failure!');
      end;
    except
      on E: Exception do AfficherMessageErreur('EXCEPTION: %s', [E.Message]);
    end;
    with SMTP do
    begin
      AfficherMessageErreur('------');
      AfficherMessageErreur('  ResultCode: %d', [ ResultCode]);
      AfficherMessageErreur('ResultString: %s', [ResultString]);
      AfficherMessageErreur('  FullResult: %s', [FullResult.Text]);
      AfficherMessageErreur('    AuthDone: %s', [booltoStr(AuthDone, 'Done', '---')]);
    end;
  finally
    FreeAndNil(Sink);
    FreeAndNil(SMTP);
  end;
end;

**bb84000** · 04/05/2024, 08h17

Bonjour,

Envoyé par JP CASSOU

J'ai testé avec le service smtp de mon FAI: Cà fonctionne avec mon exemple 'De profundis Morpionibus'

Certes, mais le problème se posera à nouveau lorsque votre FAI passera à une double authentification, ce qui finira par arriver un jour ou l'autre.

Il me semble qu'il existe avec Synapse des solutions pour gérer la double authentification OAUTH2 de Google et d'autres. Comme j'utilise Indy qui ne la gère pas, je ne peux pas en dire plus. J'explique simplement dans l'aide de mes programmes comment obtenir et utiliser un mot de passe unique d'application.

bb

Envoyer un mail en utilisant mon compte Google Mail avec un dérivé de TSMTPSend [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager