[WIN32][D7] Envoi de mail via MAPI

Version imprimable

Salut à tous,

Je souhaiterais permettre la génération d'un mail via le client mail par défaut. Pour cela, j'ai utilisé le code présent dans la FAQ (avec quelques modifs) :
Code:

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 function SendMail(const Subject, MessageText, MailFromName, MailFromAddress, MailToName, MailToAddress: String; const attachments: TStringList; WinHandle: THandle = 0): boolean; var MAPIError: DWord; MapiMessage: TMapiMessage; Originator, Recipient: TMapiRecipDesc; Files, FilesTmp: PMapiFileDesc; FilesCount: Integer; begin FillChar(MapiMessage, Sizeof(TMapiMessage), 0); MapiMessage.lpszSubject := PChar(Subject); MapiMessage.lpszNoteText := PChar(MessageText); FillChar(Originator, Sizeof(TMapiRecipDesc), 0); Originator.lpszName := PChar(MailFromName); Originator.lpszAddress := PChar(MailFromAddress); MapiMessage.lpOriginator := @Originator; MapiMessage.nRecipCount := 1; FillChar(Recipient, Sizeof(TMapiRecipDesc), 0); Recipient.ulRecipClass := MAPI_TO; Recipient.lpszName := PChar(MailToName); Recipient.lpszAddress := PChar(MailToAddress); MapiMessage.lpRecips := @Recipient; MapiMessage.nFileCount := attachments.Count; Files := AllocMem(SizeOf(TMapiFileDesc) * MapiMessage.nFileCount); MapiMessage.lpFiles := Files; FilesTmp := Files; for FilesCount := 0 to attachments.Count-1 do begin FilesTmp.nPosition := $FFFFFFFF; FilesTmp.lpszPathName := PChar(attachments[FilesCount]); Inc(FilesTmp) end; try MAPIError := MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0); result:= MAPIError = 0; finally FreeMem(Files) end end;
Puis j'appelle cette fonction de la manière suivante :
Code:

1 2 3 bMailSent := SendMail( 'Mon Sujet', 'Le contenu de mon mail','Mon Adresse Mail','Mon Adresse Mail','Le mail du destinataire', 'Le mail du destinataire', slAttachments); // slAttachments étant un Tstringlist
Malgré tout, je rencontre un problème assez étrange.
Lors de l'envoi de ce mail, ce dernier semble tout à fait correct cependant, lors de la reception de celui-ci, je me rends compte que le mail du destinataire a été modifié :

Code:

toto@domaine.com

devient

Code:

''toto@domaine.com''@orange.fr

Je n'arrive pas a saisir pourquoi cette adresse est modifiée et cela semble très problématique pour l'envoi de la plus part des mails.
Il s'agit surement d'un problème tout bête, mais impossible de mettre le doigt dessus...

Quelqu'un a-t-il déjà été confronté au problème ?
Avez vous une idée de ce qui provoquerait cela ?

Merci d'avance.

Je ne te donne pas de solution, mais simplement ma fonction que j'ai aussi tiré de la FAQ et que j'ai aussi modifié.

Elle fonctionne bien (bien que il n'est pas exclu qu'il y ait des fuites de mémoires, il y en avait dans le code original).

Simplement pour voir si cela fait la même chose, et éventuellement les mettre en parallèle pour déceler une anomalie

Code:

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
function EnvoyerMail( const SDestinataire, SSujet, STexte : String;
                      LFichiers: TStringList;
                      BAfficherErreur : Boolean = True;
                      BEnvoiAuto : Boolean = False ) : Boolean;
var
   DD : MapiRecipDesc; // description destinataire
   DF : array[ 0..49 ] of MapiFileDesc; // description fichier, 50 maxi.
   DM : MapiMessage; // description du message
   IError : Cardinal;
   MailHandle : THandle;
   i: Integer;
begin
     Result := False;
     if LFichiers.Count > 50 then
       begin
       ShowMessage( '50 fichiers joints maxi. Opération annulée' );
       Exit;
       end;
     // Destinataire
     if SDestinataire <> '' then
     with DD do
       begin
       ulReserved := 0;
       ulRecipClass := MAPI_TO;
       lpszName := PChar( SDestinataire );
       lpszAddress := nil;
       ulEIDSize := 0;
       lpEntryID := nil;
       end;
     // Fichier joint
     if LFichiers.Count > 0 then
       for i := 0 to LFichiers.Count - 1 do
         with DF[ i ] do
           begin
           ulReserved := 0;
           flFlags := 0;
           nPosition := $FFFFFFFF;
           lpszPathName := StrNew( PChar( ExpandUNCFileName( LFichiers[ i ] ) )) ; // Chemin + fichier
           lpszFileName := StrNew( PChar( ExtractFileName( LFichiers[ i ] ) ) ); // Fichier uniquement
           lpFileType := nil;
           end;
     // Message
     with DM do
       begin
       ulReserved := 0;
       lpszSubject := PChar( SSujet );
       lpszNoteText := PChar( AdjustLineBreaks( STexte ) );
       lpszMessageType := nil;
       lpszDateReceived := nil;
       lpszConversationID := nil;
       flFlags := 0;
       lpOriginator := nil;
       if SDestinataire <> '' then
         begin
         nRecipCount := 1;
         lpRecips := @DD
         end
       else
         begin
         nRecipCount := 0;
         lpRecips := Nil;
         end;
       if LFichiers.Count > 0 then
         begin
         nFileCount := LFichiers.Count;
         lpFiles := @( DF[0] );
         end
       else
         begin
         nFileCount := 0;
         lpFiles := nil;
         end;
       end;
     if MailLogon( MailHandle, BAfficherErreur ) then
       try
       // Envoi du mail
       if BEnvoiAuto
         then IError := MapiSendMail( MailHandle, Application.Handle, DM, 0, 0 )
         else IError := MapiSendMail( MailHandle, Application.Handle, DM, MAPI_DIALOG , 0 );
       Result := SErreurSendMail( IError ) = '';
       if ( not Result ) and BAfficherErreur
         then ShowMessage( 'ERREUR d''envoi du mail vers ' + SDestinataire + #13 +
                           SErreurSendMail( IError ) );
       finally MailLogoff( MailHandle ); end;
     // Libérations
     for i := 0 to LFichiers.Count - 1 do
       begin
       StrDispose( DF[ i ].lpszPathName );
       StrDispose( DF[ i ].lpszFileName );
       end;
end;

Pour info, mes envoie passe par un outlook express et le destinataire n'a pas se probleme.

12/01/2007, 10h22
Benjamin GAGNEUX

Excellent :ccool:

Merci :D

Je n'ai pas vraiment compris pourquoi cela ne fonctionnait pas avec ma fonction...
Je regarderais cela de plus près chez moi dès que j'aurais ma connection perso

Je passe en résolu tout de même, je rajouterais un commentaire si je comprends le pourquoi du comment :)