Envoyer un mail au format html avec images incorporées dans le corps du message, éventuellement avec pièces jointes.

Télécharger le projet
Commenter

Description

Bonjour, ce code source illustre de façon non exhaustive, l?utilisation de la librairie Microsoft CDO pour l?envoi de mail.
CDO (Collaboration Data objects) est une des interfaces fournies par Microsoft pour accéder à la couche MAPI. CDO ne fonctionne qu?à partir de Windows 2000.
CDO doit être installé sur le poste client. Dans le cas contraire, un message d?erreur du genre « N?a pas pu créer l?objet CDO.Message », s?affichera.
Pourquoi utiliser CDO, alors qu?Indy est fourni avec Delphi. Tout simplement parce qu?Indy est loin d?être parfait.
- Pour ma part, je n?ai pas pu envoyer une pièce jointe avec Indy (ver. 10.5). Avec une pièce jointe, le message n?arrivait tout simplement pas à destination.
- En cas d?erreur, la plus part des messages sont en anglais et ne sont pas traduits dans les ResourcesStrings.
- Il y a à mon avis beaucoup trop de bugs pour un composant qui se veut professionnel.
- En jetant un ?il sur le code source, il est loin d?être impeccable.
En ce qui concerne l?objet CDO :
- Il est relativement simple à utiliser.
- Les messages d?erreur sont dans la langue de l?OS.
- Il fonctionne et à priori, Il ne plante pas.
Ca fait déjà 3 bonnes raisons de l?utiliser pour l'envoi de mails.
Ceci étant dit, on peut voir que la fonction utilisée pour l?envoi de mails est relativement simple et courte, la fonction la plus complexe a été finalement celle qui analyse le fichier html afin d?y extraire le nom des fichiers image.
L?unité USendMail est l?unité qui utilise CDO.
L?unité UMain n?est là que pour illustrer l?utilisation de la fonction SendEmail.
Le cas des envois de mail à partir de serveur SMTP sécurisés SSL, n?a pas été abordé, mais CDO peut l?implémenter, plus d?info sur le site de Microsoft.
L'unité U2007 ne sert que pour ceux qui veulent compiler avec une version de Delphi antérieure à Delphi 2009

Source / Exemple : 


unit USendMail;

interface

uses
  System.Classes, System.SysUtils;

type
  TRelatedBodyPart = array of array of string;
  TAttachments = array of string;
  TCdoPriority  = (cdoLow, cdoNormal, cdoHigh);

  TSendMsg = record
    Subject: string;
    HTMLFileName: string;
    Attachments: TAttachments;
  end;

  TSendCfg = record
    SMTPServer: string;
    SMTPServerPort: Word;
    AddrFrom: string;
    PrioriTy: TCdoPriority;
    MDNRequested: Boolean;
  end;

  function SetSendMsg(Subject, HtmlFileName: string; Attachments: TAttachments): TSendMsg;
  function SetSendCfg(AddrFrom, SMTPServer: string; SMTPServerPort: Word=25;
    Priority: TCdoPriority=cdoNormal; MDNRequested: Boolean=False): TSendCfg;
  function SendEmail(AddrTo: string; SendCfg: TSEndCfg; SendMsg: TSendMsg): string;

implementation

Uses
  ComObj;

resourcestring
  {Messages d'erreur}
  ER_STREAM_NOT_ASSIGNED = 'Le flux à analyser n''est pas assigné.';
  ER_STREAM_EMPTY = 'Le flux à analyser est vide';
  ER_BAD_DELIMITER = 'La valeur de l''attribut "src" ou "id" d''une image est mal délimitée';
  ER_BAD_DELIMITER_SRC = 'Le délimiteur de valeur pour l''attribut SRC doit être un guillemet double.'
                       + #$A#$D + 'Url de l''image en cause : %s';
  ER_READ_ERROR = 'Une erreur s''est produite pendant la lecture du Flux';
  ER_NOT_FILE_EXIST = 'Le fichier %s est introuvable.';

function GetFullPathName(FileName: string): string;
begin
  {Si Filename est un chemin relatif, le converti en chemin complet}
  Result := FileName;
  try
    if Copy(Result, 2, 1) <> ':' then
      Result := ExpandFileName(FileName);
  except
  end;
end;

function _BodyParse(BodyStream: TStringStream; var RelatedBodyPart: TRelatedBodyPart): string; overload;
{
  Cette fonction analyse un fichier html pour en extraire la valeur des attributs src et id
  des balises <img
  RelatedBodyPart récupère dans un tableau :
    - La valeur de l'attribut src de l'image. (chemin complet)
    - La valeur de l'attribut id de l'image (identifiant unique de l'image)
  Les paramètres :
    - BodyStream: Un flux contenant le texte du fichier html
    - RelatedBodypart Un tableau de string à 2 dimensions récupérant
      les chemins complets et id des images
  La valeur de retour de la fonction est une chaine vide en cas de succès ou le message
  d'erreur en cas d'échec.
}
type
  TSearchAttrib = (saUrl, saId);
const
  {Liste des balises et attributs image}
  TagOpen = '<img ';
  TagClose = '>';
  AttrUrl = ' src';
  AttrId = ' id';
  SymChar = '=';
var
  Index, CurPos, BodySize, RemStrSize, MaxLen, NewLength: Integer;
  SymPos, TagOpenPos, AttrSearchPos: Integer;
  ParseStr, SRead, SearchStr: string;
  FindValue: array[0..1] of string;
  Quote: Char;
  SearchAttrib: TSearchAttrib;
begin
  {Initialise La valeur de retour}
  Result := '';
  if not Assigned(BodyStream) then
  begin
    {En cas d'erreur, on quitte}
    Result := ER_STREAM_NOT_ASSIGNED;
    Exit;
  end;
  {Initialise le tableau}
  SetLength(RelatedBodyPart, 0, 2);
  {Récupère la taille du flux}
  BodySize := BodyStream.Size;
  {Affecte sa taille à la taille de la chaine restant à analyser}
  RemStrSize := BodySize;
  if BodySize = 0 then
  begin
    {En cas d'erreur, on quitte}
    Result := ER_STREAM_EMPTY;
    Exit;
  end;
  {On se positionne au début du flux}
  BodyStream.Seek(0, soFromBeginning);
  {On récupère la position en cours}
  CurPos := BodyStream.Position;
  while BodyStream.Position < BodySize do
  try
    {Lit la chaine restante complète}
    SRead := BodyStream.ReadString(RemStrSize);
    {On convertit la chaine en minuscule}
    SRead := AnsiLowerCase(SRead);
    {On recherche la balise '<img' dans la chaine}
    TagOpenPos := Pos(TagOpen, SRead);
    {Si aucune balise '<img' n'est trouvée, on quitte}
    if TagOpenPos = 0 then Break;
    {On se positionne au début de la balise image}
    BodyStream.Seek(CurPos + TagOpenPos - 1, soFromBeginning);
    {On recalcule la taille de la chaine restante}
    RemStrSize := BodySize - BodyStream.Position;
    {Lit le reste de la chaine}
    SRead := BodyStream.ReadString(RemStrSize);
    {On convertit la chaine en minuscule}
    SRead := AnsiLowerCase(SRead);
    {Initialise le tableau des valeurs d'attribut 'src' et 'id'}
    FindValue[0] := ''; FindValue[1] := '';
    {Détermine la longuer maximum de la balise <img}
    MaxLen := Pos(TagClose, SRead);
    for Index := 0 to 1 do
    begin
      if Index = 0 then SearchAttrib := saUrl else SearchAttrib := saId;
      case SearchAttrib of
        saUrl: SearchStr := AttrUrl;
        saId: SearchStr := AttrId;
      end;
      {On initialise le séparateur pour les valeurs d'attributs à #0}
      Quote := #0;
      {On recherche l'attribut SearchStr dans la chaine}
      AttrSearchPos := Pos(SearchStr, Copy(SRead, 1, MaxLen));
      {Si l'attribut SearchStr de l'image n'existe pas, on quitte}
      if AttrSearchPos = 0 then Break;
      {Si le caractère qui suit SearchStr n'est ni un espace ni un signe =, on quitte}
      if (Length(SRead) > Length(SearchStr) + AttrSearchPos) then
        if not CharInSet(SRead[AttrSearchPos + Length(SearchStr)], [' ', '=']) then Break;
      {On récupère la chaine à partir de l'attribut SearchStr}
      ParseStr := Copy(SRead, AttrSearchPos, length(SRead));
      {On recherche le caractère '='}
      SymPos := Pos(SymChar, ParseStr);
      if SymPos <> 0 then
      begin
        {On récupère la chaine à partir du symbole '='}
        ParseStr := Copy(ParseStr, SymPos + 1, length(ParseStr));
        {On supprime les espaces de début}
        ParseStr := TrimLeft(ParseStr);
        {On récupère le caractère quote " ou '}
        if Length(ParseStr) > 0 then Quote := ParseStr[1];
        {On supprime le caractère quote de gauche}
        Delete(ParseStr, 1, 1);
        {Vérifie s'il s'agit d'une image intégrée au fichier}
        if Pos('data:', AnsiLowerCase(TrimLeft(ParseStr))) = 1 then Break;
        {On recherche le 2ème caractère quote}
        SymPos := Pos(Quote, ParseStr);
        if SymPos <> 0 then
        begin
          {On récupère la chaine correspondant à l'url}
          ParseStr := Copy(ParseStr, 1, SymPos - 1);
          if (SearchAttrib = saUrl) and (Quote <> '"') then
          begin
            {Le délimiteur de la valeur d'attribut src doit être un guillemet double}
             Result := Format(ER_BAD_DELIMITER_SRC, [ParseStr]);
             Exit;
          end else if SearchAttrib = saUrl then
          begin
            {Récupère le chemin complet s'il s'agit d'un chemin relatif}
            ParseStr := GetFullPathName(ParseStr);
          end;
          FindValue[Ord(SearchAttrib)] := ParseStr;
        end else Quote := #0;
      end;
    end;
    if Quote = #0 then
    begin
      {Le délimiteur de valeur d'attribut n'a pas été trouvé}
      Result := ER_BAD_DELIMITER;
      Exit;
    end;
    if (FindValue[0] <> '') and (FindValue[1] <> '') then
    begin
      {On redimensionne le tableau ImgBodyPart}
      NewLength := Length(RelatedBodyPart) + 1;
      SetLength(RelatedBodyPart, NewLength, 2);
      {On insère les valeurs url et id dans le tableau}
      RelatedBodyPart[NewLength - 1, 0] := FindValue[0];
      RelatedBodyPart[NewLength - 1, 1] := FindValue[1];
    end;
    {On se positionne après la balise image}
    BodyStream.Seek(CurPos + TagOpenPos + Length(TagOpen) - 1, soFromBeginning);
    {On recalcule la taille de la chaine restante}
    RemStrSize := BodySize - BodyStream.Position;
    {On récupère la position en cours}
    CurPos := BodyStream.Position;
  except
    Result := ER_READ_ERROR;
  end;
end;

function _BodyParse(HtmlFileName: string; var RelatedBodyPart: TRelatedBodyPart): string; overload;
{
  Cette fonction analyse un fichier html pour en extraire la valeur des attributs src et id
  des balises <img
  RelatedBodyPart récupère dans un tableau :
    - La valeur de l'attribut src de l'image. (chemin complet)
    - La valeur de l'attribut id de l'image (identifiant unique de l'image)
  Les paramètres :
    - HtmlFileName: le nom et chemin du fichier html à analyser.
    - RelatedBodypart Un tableau de string à 2 dimensions récupérant
      les chemins complets et id des images
  La valeur de retour de la fonction est une chaine vide en cas de succès ou le message
  d'erreur en cas d'échec.
}
var
  BodyStream: TStringStream;
begin
    Result := '';
    BodyStream := TStringStream.Create;
    try
      if not FileExists(HtmlFileName) then
        Result := Format(ER_NOT_FILE_EXIST, [htmlFileName]) else
        begin
          BodyStream.LoadFromFile(HtmlFileName);
          Result := _BodyParse(BodyStream, RelatedBodyPart);
        end;
    except
      on e: Exception do
        Result := e.Message;
    end;
    BodyStream.Free;
end;

function SetSendMsg(Subject, HtmlFileName: string; Attachments: TAttachments): TSendMsg;
begin
  {Retourne un enregistrement de type TSendMsg}
  Result.Subject := Subject;
  Result.HTMLFileName := HtmlFileName;
  Result.Attachments := Attachments;
end;

function SetSendCfg(AddrFrom, SMTPServer: string; SMTPServerPort: Word;
  Priority: TCdoPriority; MDNRequested: Boolean): TSendCfg;
begin
  {Retourne un enregistrement de type TSendCfg}
  Result.AddrFrom := AddrFrom;
  Result.SMTPServer := SMTPServer;
  Result.SMTPServerPort := SMTPServerPort;
  Result.PrioriTy := Priority;
  Result.MDNRequested := MDNRequested;
end;

function SendEmail(AddrTo: string; SendCfg: TSendCfg; SendMsg: TSendMsg): string;
{
  Fonction simplifiée d'envoi de mail depuis un fournisseur standard (Free, sfr, orange etc.)
  Envoi un mail au format html avec images en ligne et pièces jointes
  Envoi sans authentification, sans nom d'utilisateur et sans mot de passe
  L'envoi à partir de serveur smtp avec utilisateur et mot de passe type yahoo est possible
  également, voir l'objet CDO sur le site Microsoft.
  La fonction utilise l'objet OLE CDO.Message de Microsoft (OS mini: Windows 2000)
  Plus d'info sur cette objet à l'adresse :
    http://msdn.microsoft.com/en-us/library/ms527568(v=exchg.10).aspx
  Paramètres :
    AddrTo: adresse mail pour l'envoi
    SendCfg: enregistrement de type TSendCfg
      - SendCfg.AddrFrom: adresse mail de l'expéditeur (peut être: 'nom usuel<adresse@fai.fr>')
      - SendCfg.SMTPServer: nom du serveur smtp (ex: smtp.orange.fr)
      - SendCfg.PrioriTy: Priorité du message (cdoLow, cdoNormal, cdoHight)
      - SendCfg.MDNRequested: Spécifie si un accusé de lecture est demandé
    SendMsg: enregistrement de type TSendMsg:
      - SendMsg.Subject: Objet du message
      - SendMsg.HTMLFileName: Nom complet du fichier html à envoyer
      - SendMsg.Attachments: tableau contenant le nom complet des fichiers joints
      - SendMsg.RelatedBodyParts: tableau de chaines contenant les médias inclus
                                  dans le fichier html
          Sous la forme : nom du fichier|identification de la ressource
          ex.: <img src="c:\image.jpg" id="id001" alt="image" /> donne : c:\image.jpg|id001
      A NOTER dans le fichier html l'attribut id est obligatoire et doit contenir un
              identifiant unique pour cette image. Les délimiteurs pour la valeur
              de l'attribut src doivent être des guillemets doubles et non pas simples.
}
const
  CdoMailImportance   = 'urn:schemas:httpmail:importance';
  CdoHeaderXPriority  = 'urn:schemas:mailheader:X-Priority';
  CdoMailPriority     = 'urn:schemas:httpmail:priority';
  CdoConfiguration    = 'http://schemas.microsoft.com/cdo/configuration/';
  CdoSMTPServer       = CdoConfiguration + 'smtpserver';
  CdoSMTPServerPort   = CdoConfiguration + 'smtpserverport';
  CdoSMTPAuthenticate = CdoConfiguration + 'smtpauthenticate';
  CdoSMTPUseSSL       = CdoConfiguration + 'smtpusessl';
  CdoSendUsing        = CdoConfiguration + 'sendusing';
  cdoSendUsingPort    = 2;
  cdoRefTypeId        = 0;
  cdoRefTypeLocation  = 1;
  CdoSuppressNone     = 0;
  CdoAnonymous        = 0;
var
  iMsg: OleVariant;
  Index: Integer;
  RelatedBodyPart: TRelatedBodyPart;
begin
  Result := '';
  with SendMsg do
    if not (FileExists(HTMLFileName)) then
    begin
      Result := Format(ER_NOT_FILE_EXIST, [HTMLFileName]);;
      Exit;
    end else
      _BodyParse(HTMLFileName, RelatedBodyPart);
  {Instancie l'objet ole}
  Imsg := CreateOleObject('CDO.Message');
  with SendCfg, SendMsg do
  try
    iMsg.configuration.fields.item(CdoSMTPServer) := SMTPServer;
    iMsg.configuration.fields.item(CdoSMTPServerPort) := SMTPServerPort;
    iMsg.configuration.fields.item(CdoSendUsing) := cdoSendUsingPort;
    iMsg.configuration.fields.item(CdoSMTPAuthenticate) := CdoAnonymous;
    iMsg.configuration.fields.item(CdoSMTPUseSSL) := False;
    iMsg.configuration.fields.Update;
    iMsg.fields.item(CdoMailImportance) := PrioriTy;
    if SendCfg.PrioriTy < cdoHigh then
      iMsg.fields.item(CdoHeaderXPriority) := -1 else
      iMsg.fields.item(CdoHeaderXPriority) := 0;
    iMsg.fields.item(CdoMailPriority) := ord(PrioriTy) - 1;
    iMsg.fields.Update;
    iMsg.From := SendCfg.AddrFrom;
    iMsg.To := AddrTo;
    iMsg.Subject := Subject;
    iMsg.MDNRequested := MDNRequested;
    iMsg.CreateMHTMLBody(HTMLFileName, CdoSuppressNone);
    for Index := 0 to Length(RelatedBodyPart) - 1 do
    begin
      iMsg.AddRelatedBodyPart(
        RelatedBodyPart[Index, 0],
        RelatedBodyPart[Index, 1],
        cdoRefTypeId);
    end;
    for Index := 0 to High(Attachments) do
      iMsg.AddAttachment(Attachments[Index]);
    iMsg.Send;
  except
    on e: Exception do
      Result := e.Message;
  end;
  {Libère la mémoire allouée à l'objet ole}
  iMsg := VarNull;
end;

end.

Conclusion :


Le programme a été testé sur XP, Vista et Seven. L?exécutable fourni a été compilé avec Delphi 2007(moins lourd qu?avec XE), il est fourni pour ceux qui auraient des problèmes pour compiler le source. Le source a été créé à partir de Delphi XE2.
Lire Notes.txt pour compiler avec des versions antérieures jusqu?à Delphi 2007 et peut-être Delphi 2005.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.