IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Web & réseau Delphi Discussion :

Connexion à Gmail via Delphi 2010 avec composant Indy


Sujet :

Web & réseau Delphi

  1. #1
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut Connexion à Gmail via Delphi 2010 avec composant Indy
    Bonjour à tous,

    Je sais que ce sujet a déjà été abordé, mais malgré les échanges et différentes pistes sur le forum et le Net, j'ai toujours un problème pour me connecter à Gmail avec un composant TIdImap4.
    Pour faire simple, j'ai créé une application il y a un moment déjà (delphi 2010, composant Indy V10.5.5) qui se connecte à une boîte Gmail, récupère des messages (contenant des rapports de backups de base de données), décortique le contenu et envoie un mail si un backup n'a pas pu se faire correctement.
    Cette application a fonctionné très bien jusqu'à une certaine date. Puis un jour, sans aucun changement sur l'ordinateur, plus moyen de me connecter sur le compte Gmail, il se connecte puis se déconnecte avec le message "Connection closed gracefully"... not authenticated.

    J'ai pensé à une mise à jour de sécurité de Gmail. J'ai récupéré les dll à jour de openssl, j'ai revérifié le pare-feu et compagnie et j'ai re-trituré toutes les options de TIDImap et de TIdSSLIOHandlerSocketOpenSSL. Ça fait quelques combinaisons, mais aucune amélioration. Initialement je n'ai pas activé l'authentification en deux étapes dans Gmail, mais même en faisant et en créant un mot de passe d'application, rien à faire. Je commence à être à court d'idées. En faisant un pas à pas, je bloque a priori sur "GetResponse". Pour la gestion de connexion, je me suis inspirée initialement des codes que l'on trouve sur Internet, et ça marchait. Voici la procédure:

    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
    procedure GetGmailMessages(const UserName, Password: string; Corpsdumail: TStrings);
    var
      S: string;
      MsgIndex: Integer;
      MsgObject: TIdMessage;
      PartIndex: Integer;
      Confirmes : array of integer;
      Supp, i : integer;
      Socks : TIdSocksInfo;
    begin
     
      //Création et paramétrage composant IMAP
      Corpsdumail.Clear;
      IMAPClient := TIdIMAP4.Create(nil);
     
      try
        OpenSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
     
        try
          //Paramétrage
          OpenSSLHandler.SSLOptions.Method := sslvSSLv3;
          OpenSSLHandler.SSLOptions.Mode := sslmUnassigned;//sslmClient ;//sslmUnassigned
          OpenSSLHandler.SSLOptions.VerifyMode := [];//[sslvrfClientOnce];
          OpenSSLHandler.SSLOptions.VerifyDepth := 0;
          IMAPClient.IOHandler := OpenSSLHandler;
          IMAPClient.Host := IMAPAddress;
          IMAPClient.UseTLS:=utuseExplicitTLS;
          IMAPClient.Port := IMAPPort;
          IMAPClient.Username := UserName;
          IMAPClient.Password := Password;
     
          Try
            IMAPClient.Connect;
            IMAPClient.Login;
          Except
             On e:exception do Showmessage(e.Message);
          End;
     
          try
            //Parcours boîte de réception
            if IMAPClient.SelectMailBox('INBOX') then
            begin
              Corpsdumail.BeginUpdate;
              FenPrincipale.MemEtat.Lines.Add('Parcours Boîte de réception');
              try
                for MsgIndex := 1 to IMAPClient.MailBox.TotalMsgs do
                begin
     
                  MsgObject := TIdMessage.Create(nil);
     
                  try
                    //Récup messages
                    S := '';
                    FenPrincipale.MemEtat.Lines.Add('Récupération du message');
                    IMAPClient.Retrieve(MsgIndex, MsgObject);
                    MsgObject.MessageParts.CountParts;
     
                    if MsgObject.MessageParts.TextPartCount > 0 then
                    begin
                      for PartIndex := 0 to MsgObject.MessageParts.Count - 1 do
                        if MsgObject.MessageParts[PartIndex] is TIdText then
                          S := S + TIdText(MsgObject.MessageParts[PartIndex]).Body.Text;
                          Corpsdumail.Add(S);
                    end
                    else
                      Corpsdumail.Add(MsgObject.Body.Text);
     
                    //Copie messages dans 'TRAITE' car IMAP ne connaît pas MOVE...
                    IMAPClient.CopyMsg(MsgIndex,'TRAITE');
                    FenPrincipale.MemEtat.Lines.Add('Classement comme ''TRAITE');
     
                  finally
                    //Libérations et fins de processus
                    MsgObject.Free;
                  end;
                end;  //endfor
     
                FenPrincipale.MemEtat.Lines.Add('Nettoyage Boîte de réception');
     
                //Une fois classés en Traités, on supprime les mails de Inbox
     
                //Vérification si le mail est non lu
                //FenPrincipale.IMAPClient.RetrieveFlags(MsgIndex,Flags);
                //if mfSeen in Flags  then
                Supp:=0;
                for i := 1 to IMAPClient.MailBox.TotalMsgs do
                begin
                  Setlength(Confirmes, Succ(Supp));
                  Confirmes[Supp] := i;
                  Inc(Supp);
                end;
                FenPrincipale.MemEtat.Lines.Add('Nettoyage Inbox');
                IMAPClient.DeleteMsgs(Confirmes);
                IMAPClient.ExpungeMailBox;
     
              finally
                Corpsdumail.EndUpdate;
              end;
            end;//endif
          finally
            IMAPClient.Disconnect;
          end;
        finally
          OpenSSLHandler.Free;
        end;
      finally
        IMAPClient.Free;
      end;
    end;

    Je suis preneuse de toute idée. Merci d'avance pour vos réponses.

  2. #2
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 021
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 021
    Points : 40 935
    Points
    40 935
    Billets dans le blog
    62
    Par défaut
    Bonjour,

    j'ai aussi des problèmes avec GMail mais c'est dû à la politique de sécurité de Google (application non autorisée) c'est peut être là le nœud du problème
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  3. #3
    Expert éminent sénior
    Avatar de Paul TOTH
    Homme Profil pro
    Freelance
    Inscrit en
    Novembre 2002
    Messages
    8 964
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Freelance
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Novembre 2002
    Messages : 8 964
    Points : 28 430
    Points
    28 430
    Par défaut
    oui GMail a introduit des sécurités, il faut explicitement autoriser les connexions, en consultant le compte sur le site Gmail il doit y avoir un message en ce sens si je me souviens bien.
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  4. #4
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Bonjour,

    Merci pour vos retours.

    Oui, j'ai regardé les options de sécurité du compte Google en question. J'ai activé l'accès moins sécurisé des applications, cela n'a pas suffi. Il n'y avait pas d'authentification en deux étapes initialement, mais pour autant cela ne marchait pas. Je l'ai activé et j'ai créé un mot de passe d'application, comme pour Outlook par exemple, mais ça ne marche pas mieux. Je ne sais pas ce que je pourrais encore alléger dans les options de sécurité.

    Le souci c'est que cette application que j'ai mis de côté pendant un long moment devient nécessaire pour notre entreprise, on a des dizaines de BDD à surveiller. Donc, je pense que je vais encore opter pour la solution de contournement. Je suis sûre qu'il existe des services de messagerie moins tatillons et pour ce que j'en ai à faire, cela sera suffisant.

    Je vous tiens au courant rapidement.

  5. #5
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 021
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 021
    Points : 40 935
    Points
    40 935
    Billets dans le blog
    62
    Par défaut
    À moins que ce soit le port ou la méthode d'identification (variables que l'on ne peut voir dans le code) qui ait changé (de manière plus ou moins unilatérale de la part de google coutumier du fait et n'envoyant qu'un courriel à peine explicatif
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  6. #6
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Au niveau port, en imap j'utilise le 993 Comme préconisé par Google.
    Au niveau méthode d'identification vous pensez à quoi exactement? Ça je pourrais vérifier.

  7. #7
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 021
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 021
    Points : 40 935
    Points
    40 935
    Billets dans le blog
    62
    Par défaut
    En fait je pensais à ça
    Port pour SSL : 465 // en particulier ce port qui pourrait être explicite dans SSLIOHandler
    et tout ce qui pourrait avoir changé pour le SSL
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  8. #8
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Ah d'accord.
    J'ai déjà essayé de préciser un port pour le SSLIOHandler, mais ce n'était pas le 465.
    Je vais tester.

  9. #9
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Bonjour,

    Finalement j'ai fait table rase. J'ai fait d'abord une petite appli rien que pour tester la connexion à Gmail. J'ai mis à jour mes dll pour le ssl, mais en soi cela n'a pas résolu mon problème.
    J'ai surtout viré mes composants que j'avais sur ma fiche, j'ai tout créé à la volée avec très peu d'options paramétrés. Et là, ça marche à nouveau. Petit détail: j'ai créé un mot de passe d'application dans Gmail. Voici le code:

    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
    procedure GetGmailMessages(const UserName, Password: string; Corpsdumail: TStrings);
    var
      S: string;
      MsgIndex: Integer;
      MsgObject: TIdMessage;
      PartIndex: Integer;
      Confirmes : array of integer;
      Supp, i : integer;
      Socks : TIdSocksInfo;
    begin
     
      //Création et paramétrage composant IMAP
      Corpsdumail.Clear;
      IMAPClient := TIdIMAP4.Create(nil);
     
      try
        OpenSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
     
        try
          //Paramétrage
          OpenSSLHandler.SSLOptions.Method := sslvSSLv23;
          IMAPClient.IOHandler :=OpenSSLHandler;
          IMAPClient.Host := 'imap.gmail.com';
          IMAPClient.UseTLS:=utuseImplicitTLS;
          //IMAPClient.Port := 993;
          IMAPClient.Username := UserName;
          IMAPClient.Password := Password;
          IMAPClient.Connect;
     
          try
            //Parcours boîte de réception
            if IMAPClient.SelectMailBox('INBOX') then
            begin
              Corpsdumail.BeginUpdate;
              FenPrincipale.MemEtat.Lines.Add('Parcours Boîte de réception');
              try
                for MsgIndex := 1 to IMAPClient.MailBox.TotalMsgs do
                begin
     
                  MsgObject := TIdMessage.Create(nil);
     
                  try
                    //Récup messages
                    S := '';
                    FenPrincipale.MemEtat.Lines.Add('Récupération du message');
                    IMAPClient.Retrieve(MsgIndex, MsgObject);
                    MsgObject.MessageParts.CountParts;
     
                    if MsgObject.MessageParts.TextPartCount > 0 then
                    begin
                      for PartIndex := 0 to MsgObject.MessageParts.Count - 1 do
                        if MsgObject.MessageParts[PartIndex] is TIdText then
                          S := S + TIdText(MsgObject.MessageParts[PartIndex]).Body.Text;
                          Corpsdumail.Add(S);
                    end
                    else
                      Corpsdumail.Add(MsgObject.Body.Text);
     
                    //Copie messages dans 'TRAITE' car IMAP ne connaît pas MOVE...
                    IMAPClient.CopyMsg(MsgIndex,'TRAITE');
                    FenPrincipale.MemEtat.Lines.Add('Classement comme ''TRAITE');
     
                  finally
                    //Libérations et fins de processus
                    MsgObject.Free;
                  end;
                end;  //endfor
     
                FenPrincipale.MemEtat.Lines.Add('Nettoyage Boîte de réception');
     
                //Une fois classés en Traités, on supprime les mails de Inbox
     
                //Vérification si le mail est non lu
                //FenPrincipale.IMAPClient.RetrieveFlags(MsgIndex,Flags);
                //if mfSeen in Flags  then
                Supp:=0;
                for i := 1 to IMAPClient.MailBox.TotalMsgs do
                begin
                  Setlength(Confirmes, Succ(Supp));
                  Confirmes[Supp] := i;
                  Inc(Supp);
                end;
                FenPrincipale.MemEtat.Lines.Add('Nettoyage Inbox');
                IMAPClient.DeleteMsgs(Confirmes);
                IMAPClient.ExpungeMailBox;
     
              finally
                Corpsdumail.EndUpdate;
              end;
            end;//endif
          finally
            IMAPClient.Disconnect;
          end;
        finally
          OpenSSLHandler.Free;
        end;
      finally
        IMAPClient.Free;
      end;
    end;
    Youpie! Je considère le sujet comme résolu.

  10. #10
    Nouveau Candidat au Club
    Profil pro
    Inscrit en
    Mai 2008
    Messages
    1
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2008
    Messages : 1
    Points : 1
    Points
    1
    Par défaut Besoin d'aide...
    Bonjour Feymann,

    Je suis un peu dans le même problème que toi.

    En fait, j'essaie depuis plusieurs semaine de créer une application pour me permettre de me connecter à mon compte mail sur la plateforme Office365,
    mais les pistes trouvée sur le Web sont très rares pour la méthode IMAP (c'est plus souvent POP et SMTP qui sont utilisés).

    Le but de mon application est de pourvoir réponde automatiquement à des e-mails que je reçois, à l'aide de modèles de messages pré-programmés en fonction des cas et à partir de données venant d'une DB.

    J'ai examiné le code source de ta procédure qui me semble fort intéressante, mais dans celui-ci tu fais appel à des propriétés de composants (Exemple: MemEtat).

    Pourrais-tu me fournir la liste des composants utilisés, comme par exemple MemEtat, est-ce bien un TMemo?

    Cela m'aiderait à mieux comprendre son fonctionnement et peut-être trouver la solution aux problèmes de mon programme.

    En te remerciant d'avance,

    Julien.

  11. #11
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Bonjour LeGuepard,

    Bienvenu au club de ceux qui galèrent avec Gmail ;-)
    MemEtat est en effet juste un Tmnemo où j'affiche au fur et à mesure l'avancement de mes triturages dans ma fenêtre principale. Les autres sont seulement des variables globales de mémoire.

    Nom : Appli.jpg
Affichages : 1445
Taille : 94,5 Ko

    Depuis une collègue a réutilisé la procédure car elle en avait besoin, cela marchait pour elle aussi. Il est important d'activer la validation en deux étapes et créer un mot de passe d'application. Après ce qui compte c'est de ne pas utiliser des composants mais les créer à la volée et ne pas préciser trop de paramètres.

    Si vous avez toujours un doute sur le code, je peux essayer de vous rendre accessible le code de l'appli 'en changeant juste l'adresse mail et le mot de passe, le reste n'est pas confidentiel.

    Bon courage!

    Enikö

  12. #12
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    Attention ce sujet c'est Avril 2019
    Le mode "application moins sécurisée" c'est pour de vieux clients mais si l'on développe aujourd'hui une solution mail, autant le faire bien

    IMAP4 en SSL mais surtout avec XOAuth2 : EIdReplyIMAP4Error avec le message '[AUTHENTICATIONFAILED] Invalid credentials (Failure)' en mode User/Pass
    Avec un SASL XOAuth, ça passe très bien
    Effectivement mettre à jour les DLL c'est nécessaire pour Yahoo, je n'ai pas eu besoin de faire l'effort pour Azure ou Google

    Il faut créer son client sur Azure, Google, Yahoo ... chacun ayant chacun leur propre plateforme d'identité
    Seul Microsoft propose une implémentation complète de OAuth2 avec les 4 types de flux : Authorization Code, Implicit, Resource Owner Password Credentials, Client Credentials ...
    En Delphi, si le Azure Consent Screen supporte un TWebBrowser normal, pour Google, il faut activer l'émulation IE11 en base de registre (tout comme Yahoo)


    J'ai failli la semaine dernière compléter mon sujet "Adoption de Microsoft Graph avec Auth Azure AD en remplacement de IMAP4 Basic Auth" sur Yahoo mais le support de Verizon m'a bien éclairé, chez Yahoo c'est juste de la merdasse bureaucratique pour obtenir les scopes mail-r et mail-w, justement, je m'y colle à remplir leur formulaire plus que pénible ... Google c'est moins chiant mais cela fait cheap leur console d'administration (moins pire que celle de Yahoo qui ressemble à une page Web de 1990)

    sinon tient voici un code qui peut vous aider (la gestion du Auth Code via le Consent Screen est dans un autre programme avec une toute autre version mon implémentation de OAuth, Graph et IMAP, ci-dessus, c'est la version ultra simplifiée qui fait le strict minimum nécessaire à mon projet, consigne de mon chef de faire le code le plus réduit pour le minimum de maintenance), on doit pouvoir utiliser le REST.Authenticator.OAuth.TOAuth2Authenticator pour la récupération du Code via un TWebBrowser par contre, la gestion de la transformation du Code en Token via ChangeAuthCodeToAccesToken mais j'ai fait à ce sujet mon propre code car je n'ai pas eu grand succès avec le code par défaut pour le mode ROPC ou CC de Azure ou alors le paramètre access_type pour le refresh token

    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
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
    556
    557
    558
    559
    560
    561
    562
    563
    564
    565
    566
    567
    568
    569
    570
    571
    572
    573
    574
    575
    576
    577
    578
    579
    580
    581
    582
    583
    584
    585
    586
    587
    588
    589
    590
    591
    592
    593
    594
    595
    596
    597
    598
    599
    600
    601
    602
    603
    604
    605
    606
    607
    608
    609
    610
    611
    612
    613
    614
    615
    616
    617
    618
    619
    620
    621
    622
    623
    624
    625
    626
    627
    628
    629
    630
    631
    632
    633
    634
    635
    636
    637
    638
    639
    640
    641
    642
    643
    644
    645
    646
    647
    648
    649
    650
    651
    652
    653
    654
    655
    656
    657
    658
    659
    660
    661
    662
    663
    664
    665
    666
    667
    668
    669
    670
    671
    672
    673
    674
    675
    676
    677
    678
    679
    680
    681
    682
    683
    684
    685
    686
    687
    688
    689
    690
    691
    692
    693
    694
    695
    696
    697
    698
    699
    700
    701
    702
    703
    704
    705
    706
    707
    708
    709
    710
    711
    712
    713
    714
    715
    716
    717
    718
    719
    720
    721
    722
    723
    724
    725
    726
    727
    728
    729
    730
    731
    732
    733
    734
    735
    736
    737
    738
    739
    740
    741
    742
    743
    744
    745
    746
    747
    748
    749
    750
    751
    752
    753
    754
    755
    756
    757
    758
    759
    760
    761
    762
    763
    764
    765
    766
    767
    768
    769
    770
    771
    772
    773
    774
    775
    776
    777
    778
    779
    780
    781
    782
    783
    784
    785
    786
    787
    788
    789
    790
    791
    792
    793
    794
    795
    796
    797
    798
    799
    800
    801
    802
    803
    804
    805
    806
    807
    808
    809
    810
    811
    812
    813
    814
    815
    816
    817
    818
    819
    820
    821
    822
    823
    824
    825
    826
    827
    828
    829
    830
    831
    832
    833
    834
    835
    836
    837
    838
    839
    840
    841
    842
    843
    844
    845
    846
    847
    848
    849
    850
    851
    852
    853
    854
    855
    856
    857
    858
    859
    860
    861
    862
    863
    864
    865
    866
    867
    868
    869
    870
    871
    872
    873
    874
    875
    876
    877
    878
    879
    880
    881
    882
    883
    884
    885
    886
    887
    888
    889
    890
    891
    892
    893
    894
    895
    896
    897
    898
    899
    900
    901
    902
    903
    904
    905
    906
    907
    908
    909
    910
    911
    912
    913
    914
    915
    916
    917
    918
    919
    920
    921
    922
    923
    924
    925
    926
    927
    928
    929
    930
    931
    932
    933
    934
    935
    936
    937
    938
    939
    940
    941
    942
    943
    944
    945
    946
    947
    948
    949
    950
    951
    952
    953
    954
    955
    956
    957
    958
    959
    960
    961
    962
    963
    964
    965
    966
    967
    968
    969
    970
    971
    972
    973
    974
    975
    976
    977
    978
    979
    980
    981
    982
    983
    984
    985
    986
    987
    988
    989
    990
    991
    992
    993
    994
    995
    996
    997
    998
    999
    1000
    1001
    1002
    1003
    1004
    1005
    1006
    1007
    1008
    1009
    1010
    1011
    1012
    1013
    1014
    1015
    1016
    1017
    1018
    1019
    1020
    1021
    1022
    1023
    1024
    1025
    1026
    1027
    1028
    1029
    1030
    1031
    1032
    1033
    1034
    1035
    1036
    1037
    1038
    1039
    1040
    1041
    1042
    1043
    1044
    1045
    1046
    1047
    1048
    1049
    1050
    1051
    1052
    1053
    1054
    1055
    1056
    1057
    1058
    1059
    1060
    1061
    1062
    1063
    1064
    1065
    1066
    1067
    1068
    1069
    1070
    1071
    1072
    1073
    1074
    1075
    1076
    1077
    1078
    1079
    1080
    1081
    1082
    1083
    1084
    1085
    1086
    1087
    1088
    1089
    1090
    1091
    1092
    1093
    1094
    1095
    1096
    1097
    1098
    1099
    1100
    1101
    1102
    1103
    1104
    1105
    1106
    1107
    1108
    1109
    1110
    1111
    1112
    1113
    1114
    1115
    1116
    1117
    1118
    1119
    1120
    1121
    1122
    1123
    1124
    1125
    1126
    1127
    1128
    1129
    1130
    1131
    1132
    1133
    1134
    1135
    1136
    1137
    1138
    1139
    1140
    1141
    1142
    1143
    1144
    1145
    1146
    1147
    1148
    1149
    1150
    1151
    1152
    1153
    1154
    1155
    1156
    1157
    1158
    1159
    1160
    1161
    1162
    1163
    1164
    1165
    1166
    1167
    1168
    1169
    1170
    1171
    1172
    1173
    1174
    1175
    1176
    1177
    1178
    1179
    1180
    1181
    1182
    1183
    1184
    1185
    1186
    1187
    1188
    1189
    1190
    1191
    1192
    1193
    1194
    1195
    1196
    1197
    1198
    1199
    1200
    1201
    1202
    1203
    1204
    1205
    1206
    1207
    1208
    1209
    1210
    1211
    1212
    1213
    1214
    1215
    1216
    1217
    1218
    1219
    1220
    1221
    1222
    1223
    1224
    1225
    1226
    1227
    1228
    1229
    1230
    1231
    1232
    1233
    1234
    1235
    1236
    1237
    1238
    1239
    1240
    1241
    1242
    1243
    1244
    1245
    1246
    1247
    1248
    1249
    1250
    1251
    1252
    1253
    1254
    1255
    1256
    1257
    1258
    1259
    1260
    1261
    1262
    1263
    1264
    1265
    1266
    1267
    1268
    1269
    1270
    1271
    1272
    1273
    1274
    1275
    1276
    1277
    1278
    1279
    1280
    1281
    1282
    1283
    1284
    1285
    1286
    1287
    1288
    1289
    1290
    1291
    1292
    1293
    1294
    1295
    1296
    1297
    1298
    1299
    1300
    1301
    1302
    1303
    1304
    1305
    1306
    1307
    1308
    1309
    1310
    1311
    1312
    1313
    1314
    1315
    1316
    1317
    1318
    1319
    1320
    1321
    1322
    1323
    1324
    1325
    1326
    1327
    1328
    1329
    1330
    1331
    1332
    1333
    1334
    1335
    1336
    1337
    1338
    1339
    1340
    1341
    1342
    1343
    1344
    1345
    1346
    1347
    1348
    1349
    1350
    1351
    1352
    1353
    unit SLTOAuth2;
     
    interface
     
    uses System.SysUtils, System.Classes,
      // REST Standard Delphi
      REST.Client, REST.Types, REST.Authenticator.OAuth,
      // Dépendance du REST Standard Delphi : IPPeerCommon & IPPeerClient
      // Sans IPPeerCommon - EIPAbstractError : 'IPProcs is not defined.  Make sure IPPeerCommon (or an alternative IP Implementation unit) is in the uses clause'.
      IPPeerCommon,
      // Sans IPPeerClient - EIPAbstractError : 'No peer with the interface with guid {E0125434-B354-482C-BD99-7E61623721FF} has been registered'.
      // TRESTHTTPProcs is implemented with IPPeerAPI. So, IPPeerClient must be used by the application in order to register the actual IPPeerAPI.IIPPeerProcs implementation.
      IPPeerClient,
      // Indy
      IdMessage, IdMessageClient, IdIMAP4, IdSASL, IdException, IdExceptionCore;
     
    type
      TSLTOAuth2Kind = (oakNone, oakAzure, oakGMail, oakYahoo);
      TSLTOAuth2FlowType = (oaftNone, oaftROPC, oaftClientCredentials, oaftAuthorizationCode);
      TSLTOAuth2Descriptor = record
        Kind: TSLTOAuth2Kind;
        ClientID: string;
        ClientSecret: string;
        Tenant: string;
      public
        class function Create(AKind: TSLTOAuth2Kind; const AClientID, AClientSecret, ATenant: string): TSLTOAuth2Descriptor; static;
      end;
      TSLTOAuth2Tokens = record
        AccessToken: string;
        AccessTokenExpiry: TDateTime;
        RefreshToken: string;
        AuthorizationCode: string;
      public
        class function Create(const AAccessToken: string; AAccessTokenExpiry: TDateTime; const ARefreshToken: string; const AAuthorizationCode: string = ''): TSLTOAuth2Tokens; static;
      end;
     
      TSLTOAuth2Context = record
        Descriptor: TSLTOAuth2Descriptor;
        Tokens: TSLTOAuth2Tokens;
        FlowType: TSLTOAuth2FlowType;
        AccessOffline: Boolean;
        RedirectionEndpoint: string;
        UserName: string;
        Password: string; // https://tools.ietf.org/html/rfc6749#page-9
      public
        class function Create(AKind: TSLTOAuth2Kind; const AClientID, AClientSecret, ATenant: string; const ATokens: TSLTOAuth2Tokens): TSLTOAuth2Context; overload; static;
      end;
     
    type
      TSLTOAuth2Authenticator = class;
      TSLTOAuth2AuthenticatorEngine = class;
      TSLTOAuth2AuthenticatorEngineClass = class of TSLTOAuth2AuthenticatorEngine;
      TSLTOAuth2AuthenticatorAzure = class;
      TSLTOAuth2AuthenticatorGoogle = class;
      TSLTOAuth2AuthenticatorYahoo = class;
      TSLTSASLXOAuth2 = class;
      TSLTMicrosoftGraph = class;
      TSLTIMAP4XOAuth2 = class;
     
      ESLTOAuth2AuthenticatorError = class(Exception);
      ESLTOAuth2AuthenticatorParamError = class(ESLTOAuth2AuthenticatorError);
      ESLTMicrosoftGraphError = class(ESLTOAuth2AuthenticatorError);
      ESLTIMAP4XOAuth2Error = class(ESLTOAuth2AuthenticatorError);
     
      TSLTOAuth2Authenticator = class(TObject)
      strict private
        FOAuth2Authenticator: TOAuth2Authenticator;
        FContext: TSLTOAuth2Context;
        FEngine: TSLTOAuth2AuthenticatorEngine;
        FTimeOut: Integer;
     
        function GetClientID(): string;
        function GetClientSecret(): string;
        function GetScope(): string;
        function GetOfflineAccess(): Boolean;
        function GetOAuth2Authenticator(): TOAuth2Authenticator;
        function GetAccessToken(): string;
        function GetAccessTokenExpiry(): TDateTime;
        function GetRefreshToken(): string;
        function GetAuthorizationCode(): string;
        function GetRedirectionEndpoint(): string;
     
        function GetEngine(): TSLTOAuth2AuthenticatorEngine;
     
        // Only Input
        procedure SetContext(const Value: TSLTOAuth2Context);
     
        function Authenticate(): Boolean;
        function RenewAuth(): Boolean;
      private
        // Engine Friend
        function Execute(ARequest: TRESTRequest): Boolean;
        function ExtractError(AJSONContent: TCustomRESTResponse): string;
        // herited TIdMessageClient Friend
        procedure SetScope(const AScope: string);
      public
        constructor Create();
        destructor Destroy(); override;
     
        // Only Input
        property Context: TSLTOAuth2Context read FContext write SetContext;
     
        // Read Only Context Explained
        property Kind: TSLTOAuth2Kind read FContext.Descriptor.Kind;
        property ClientID: string read GetClientID;
        property Tenant: string read FContext.Descriptor.Tenant;
        property ClientSecret: string read GetClientSecret;
        property Scope: string read GetScope;
        property OfflineAccess: Boolean read GetOfflineAccess;
        property AuthorizationCode: string read GetAuthorizationCode;
        property RedirectionEndpoint: string read GetRedirectionEndpoint;
     
        // Options
        property TimeOut: Integer read FTimeOut write FTimeOut;
     
        // Outputs
        property OAuth2Authenticator: TOAuth2Authenticator read GetOAuth2Authenticator;
        property AccessToken: string read GetAccessToken;
        property AccessTokenExpiry: TDateTime read GetAccessTokenExpiry;
        property RefreshToken: string read GetRefreshToken;
      end;
     
      TSLTOAuth2AuthenticatorEngine = class abstract(TObject)
      strict protected
        [Weak] FOwner: TSLTOAuth2Authenticator;
        FAccessTokenEndpoint: string;
      public
        constructor Create(AOwner: TSLTOAuth2Authenticator);
     
        function Authenticate(): Boolean; virtual; abstract;
        function RenewAuth(): Boolean; virtual; abstract;
     
        procedure SetTenant(const Value: string); virtual; abstract;
     
        property AccessTokenEndpoint: string read FAccessTokenEndpoint;
      end;
     
      /// <summary>Plateforme d’identités Microsoft</summary>
      /// <seealso href="https://docs.microsoft.com/fr-fr/azure/active-directory/develop/">Plateforme d’identités Microsoft</seealso>
      /// <remarks>Cela reprend un concept similaire à un REST.Authenticator.OAuth.TOAuth2Authenticator mais plus finement adapté au mode ROPC du OAuth2 à la sauce Microsoft</remarks>
      TSLTOAuth2AuthenticatorAzure = class(TSLTOAuth2AuthenticatorEngine)
      public
        const
          SCOPE_OFFLINE_ACCESS = 'offline_access';
          SCOPE_AS_APPLICATION = 'https://graph.microsoft.com/.default';
      public
        function Authenticate(): Boolean; override;
        function RenewAuth(): Boolean; override;
     
        procedure SetTenant(const Value: string); override;
      end;
     
      /// <seealso href="https://developers.google.com/identity/protocols/oauth2/web-server">Using OAuth 2.0 for Web Server Applications</seealso>
      TSLTOAuth2AuthenticatorGoogle = class(TSLTOAuth2AuthenticatorEngine)
      private
        FOfflineAccess: Boolean;
      public
        function Authenticate(): Boolean; override;
        function RenewAuth(): Boolean; override;
     
        procedure SetTenant(const Value: string); override;
     
        property OfflineAccess: Boolean read FOfflineAccess write FOfflineAccess;
      end;
     
      /// <seealso href="https://developer.yahoo.com/oauth2/guide/#yahoo-oauth-2-0-guide">Yahoo OAuth 2.0 Guide</seealso>
      TSLTOAuth2AuthenticatorYahoo = class(TSLTOAuth2AuthenticatorEngine)
      private
        FOfflineAccess: Boolean;
      public
        function Authenticate(): Boolean; override;
        function RenewAuth(): Boolean; override;
     
        procedure SetTenant(const Value: string); override;
     
        property OfflineAccess: Boolean read FOfflineAccess write FOfflineAccess;
      end;
     
      TSLTMicrosoftGraph = class(TIdMessageClient)
      public
        const
          SCOPE_MAIL_RW = 'https://graph.microsoft.com/mail.readwrite';
          REQUEST_CONTENT_TYPE = 'application/x-www-form-urlencoded';
      private
        type
          TFolder = class(TObject)
          private
            FID: string;
            FTotalItemCount: Integer;
          public
            constructor Create(AJSONContent: TCustomRESTResponse);
     
            property ID: string read FID;
            property TotalItemCount: Integer read FTotalItemCount;
          end;
      strict private
        FAuthenticator: TSLTOAuth2Authenticator;
        FAuthenticatorOwned: Boolean;
        FUserName: string;
        FConnected: Boolean;
        FTimeOut: Integer;
     
        FFolder: TFolder;
        FMessageIDs: TArray<string>;
     
        function GetAuthenticator(): TSLTOAuth2Authenticator;
        function GetOAuth2Context(): TSLTOAuth2Context;
        function GetOfflineAccess(): Boolean;
     
        procedure SetAuthenticator(const Value: TSLTOAuth2Authenticator);
        procedure SetOAuth2Context(const Value: TSLTOAuth2Context);
     
        function CreateRESTClientForUser(): TRESTClient;
        procedure Execute(ARequest: TRESTRequest; const AAcceptedErrorCodes: TArray<Integer>);
        function ExtractError(AJSONContent: TCustomRESTResponse): string;
      public
        destructor Destroy(); override;
     
        procedure Connect(); override;
        function Connected(): Boolean; override;
        procedure Disconnect(ANotifyPeer: Boolean); override;
     
        function SelectMailBox(const AWellKnownFolderNameOrIdentifer: string): Boolean;
        function CheckMessages(): Integer;
        function Retrieve(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
        function Delete(const AMsgNum: Integer): Boolean;
     
        property Authenticator: TSLTOAuth2Authenticator read GetAuthenticator write SetAuthenticator;
        property OAuth2Context: TSLTOAuth2Context read GetOAuth2Context write SetOAuth2Context;
     
        property UserName: string read FUserName write FUserName;
     
        // Options
        property TimeOut: Integer read FTimeOut write FTimeOut;
        property OfflineAccess: Boolean read GetOfflineAccess;
      end;
     
      TSLTIMAP4XOAuth2 = class(TIdIMAP4)
      public
        const
          HOSTS: array[TSLTOAuth2Kind] of string = ('', 'outlook.office365.com', 'imap.gmail.com', 'imap.mail.yahoo.com');
          SCOPE_IMAP4: array[TSLTOAuth2Kind] of string = ('', 'https://outlook.office365.com/IMAP.AccessAsUser.All', 'https://mail.google.com/', '');
          IMAP4_IS_SUPPORTED_AS_APPLICATION_RIGHTS: array[TSLTOAuth2Kind] of Boolean = (False, False, False, False);
      private
        function GetOAuth2SASL: TSLTSASLXOAuth2;
        function GetOAuth2Context(): TSLTOAuth2Context;
     
        procedure SetOAuth2Context(const Value: TSLTOAuth2Context);
     
        function GetOfflineAccess(): Boolean;
      protected
        procedure InitComponent(); override;
      public
        property OAuth2SASL: TSLTSASLXOAuth2 read GetOAuth2SASL;
        property OAuth2Context: TSLTOAuth2Context read GetOAuth2Context write SetOAuth2Context;
     
        property OfflineAccess: Boolean read GetOfflineAccess;
      end;
     
      TSLTSASLXOAuth2 = class(TIdSASL)
      strict private
        FAuthenticator: TSLTOAuth2Authenticator;
        FAuthenticatorOwned: Boolean;
        FUserName: string;
     
        FStatusCode: string;
        FErrorScope: string;
        FErrorSchemes: string;
     
        function GetAuthenticator(): TSLTOAuth2Authenticator;
        procedure SetAuthenticator(const Value: TSLTOAuth2Authenticator);
      protected
        procedure InitComponent(); override;
      public
        destructor Destroy(); override;
     
        function TryStartAuthenticate(const AHost, AProtocolName: string; var VInitialResponse: string): Boolean; override;
        function StartAuthenticate(const AChallenge, AHost, AProtocolName : string) : string; override;
        function ContinueAuthenticate(const ALastResponse, AHost, AProtocolName : string): string; override;
     
        class function ServiceName(): TIdSASLServiceName; override;
     
      public
        property Authenticator: TSLTOAuth2Authenticator read GetAuthenticator write SetAuthenticator;
     
        property UserName: string read FUserName write FUserName;
     
        property StatusCode: string read FStatusCode;
        property ErrorSchemes: string read FErrorSchemes;
        property ErrorScope: string read FErrorScope;
      end;
     
     
    implementation
     
    uses System.DateUtils,
      System.JSON;
     
    { TSLTOAuth2Authenticator }
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.Authenticate: Boolean;
    begin
      Result := GetEngine().Authenticate();
    end;
     
    //------------------------------------------------------------------------------
    constructor TSLTOAuth2Authenticator.Create();
    begin
      inherited Create();
     
      FOAuth2Authenticator := TOAuth2Authenticator.Create(nil);
      FOAuth2Authenticator.TokenType := TOAuth2TokenType.ttBEARER;
     
      FTimeOut := 30000;
    end;
     
    //------------------------------------------------------------------------------
    destructor TSLTOAuth2Authenticator.Destroy();
    begin
      FreeAndNil(FOAuth2Authenticator);
      FreeAndNil(FEngine);
     
      inherited Destroy();
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.Execute(ARequest: TRESTRequest): Boolean;
    var
      VValue: string;
      VIntValue: int64;
    begin
      Result := False;
     
      ARequest.Timeout := FTimeOut;
      ARequest.Execute();
      if ARequest.Response.StatusCode = 200 then
      begin
        if ARequest.Response.JSONValue.TryGetValue('access_token', VValue) then
        begin
          FOAuth2Authenticator.AccessToken := VValue;
          Result := True;
        end;
        if ARequest.Response.JSONValue.TryGetValue('refresh_token', VValue) then
          FOAuth2Authenticator.RefreshToken := VValue;
     
        // if provided by the service, the field "expires_in" contains
        // the number of seconds an access-token will be valid
        if ARequest.Response.JSONValue.TryGetValue('expires_in', VValue) then
        begin
          VIntValue := StrToIntdef(VValue, -1);
          if (VIntValue > -1) then
            FOAuth2Authenticator.AccessTokenExpiry := IncSecond(Now, VIntValue)
          else
            FOAuth2Authenticator.AccessTokenExpiry := 0.0;
        end;
      end
      else
        raise ESLTOAuth2AuthenticatorError.Create(ExtractError(ARequest.Response));
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.ExtractError(AJSONContent: TCustomRESTResponse): string;
    var
      Error, ErrorDescription, ErrorURI: string;
      ErrorCodes: array of Integer;
      ErrorCode: Integer;
    begin
      if AJSONContent.ContentType = 'application/json' then
      begin
        AJSONContent.JSONValue.TryGetValue('error', Error);
        AJSONContent.JSONValue.TryGetValue('error_description', ErrorDescription);
        AJSONContent.JSONValue.TryGetValue('error_uri', ErrorURI);
        ErrorCodes := AJSONContent.JSONValue.GetValue('ErrorCodes', ErrorCodes);
     
        if ErrorDescription <> '' then
          Result := 'Error Description: ' + sLineBreak + ErrorDescription;
     
        if Error <> '' then
        begin
          if Result <> '' then
            Result := Result + sLineBreak;
          Result := Result + 'Error: ' + Error;
        end;
     
        if Length(ErrorCodes) > 0 then
        begin
          if Result <> '' then
            Result := Result + sLineBreak;
          Result := Result + 'Error Codes: ';
          for ErrorCode in ErrorCodes do
            Result := Result + IntToStr(ErrorCode) + ', ';
          Result[Length(Result) - 1] := '.';
        end;
     
        if ErrorURI <> '' then
        begin
          if Result <> '' then
            Result := Result + sLineBreak;
          Result := Result + 'See Detail: ' + ErrorURI;
        end;
      end
      else if AJSONContent.ContentType = 'text/html' then
      begin
        Result := AJSONContent.Content;
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetAccessToken(): string;
    var
      Changed: Boolean;
    begin
      FOAuth2Authenticator.AccessToken := FContext.Tokens.AccessToken;
      FOAuth2Authenticator.AccessTokenExpiry := FContext.Tokens.AccessTokenExpiry;
      FOAuth2Authenticator.RefreshToken := FContext.Tokens.RefreshToken;
     
      if FOAuth2Authenticator.AccessTokenExpiry < Now() then
      begin
        if FOAuth2Authenticator.RefreshToken <> '' then
          Changed := RenewAuth()
        else
          Changed := Authenticate();
      end
      else
        Changed := False;
     
      if Changed then
      begin
        FContext.Tokens.AccessToken := FOAuth2Authenticator.AccessToken;
        FContext.Tokens.AccessTokenExpiry := FOAuth2Authenticator.AccessTokenExpiry;
        FContext.Tokens.RefreshToken := FOAuth2Authenticator.RefreshToken;
      end;
     
      Result := FOAuth2Authenticator.AccessToken;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetAccessTokenExpiry(): TDateTime;
    begin
      Result := FOAuth2Authenticator.AccessTokenExpiry;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetAuthorizationCode(): string;
    begin
      Result := FOAuth2Authenticator.AuthCode;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetClientID(): string;
    begin
      Result := FOAuth2Authenticator.ClientID;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetClientSecret(): string;
    begin
      Result := FOAuth2Authenticator.ClientSecret;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetEngine(): TSLTOAuth2AuthenticatorEngine;
    const
      ENGINES: array[TSLTOAuth2Kind] of TSLTOAuth2AuthenticatorEngineClass = (nil, TSLTOAuth2AuthenticatorAzure, TSLTOAuth2AuthenticatorGoogle, TSLTOAuth2AuthenticatorYahoo);
    begin
      if FContext.Descriptor.Kind = oakNone then
       raise ESLTOAuth2AuthenticatorParamError.Create('Must define Kind before use Authenticator');
     
      if not Assigned(FEngine) then
        FEngine := ENGINES[FContext.Descriptor.Kind].Create(Self);
     
      Result := FEngine;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetOAuth2Authenticator(): TOAuth2Authenticator;
    begin
      GetAccessToken();
      Result := FOAuth2Authenticator;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetOfflineAccess(): Boolean;
    begin
      Result := Scope.Contains(TSLTOAuth2AuthenticatorAzure.SCOPE_OFFLINE_ACCESS)
        or ((GetEngine() is TSLTOAuth2AuthenticatorGoogle) and (TSLTOAuth2AuthenticatorGoogle(GetEngine()).OfflineAccess))
        or ((GetEngine() is TSLTOAuth2AuthenticatorYahoo) and (TSLTOAuth2AuthenticatorYahoo(GetEngine()).OfflineAccess));
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetRedirectionEndpoint(): string;
    begin
      Result := FOAuth2Authenticator.RedirectionEndpoint;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetRefreshToken(): string;
    begin
      Result := FOAuth2Authenticator.RefreshToken;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.GetScope(): string;
    begin
      Result := FOAuth2Authenticator.Scope;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2Authenticator.RenewAuth(): Boolean;
    begin
      Result := GetEngine().RenewAuth();
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTOAuth2Authenticator.SetContext(const Value: TSLTOAuth2Context);
     
      //--
      procedure SetKind(const Value: TSLTOAuth2Kind);
      begin
        if FContext.Descriptor.Kind <> Value then
        begin
          FContext.Descriptor.Kind := Value;
          FreeAndNil(FEngine);
        end;
      end;
     
    begin
      // Nettoyage éventuellement nécesaire si entre l'ancien Context et le nouveau Context, il y a des éléments majeurs qui ont été modifiés
      if (FContext.Descriptor.Kind <> Value.Descriptor.Kind) or
         (FContext.Descriptor.Tenant <> Value.Descriptor.Tenant) then
        FreeAndNil(FEngine);
     
      // Copie du Context fourni
      FContext := Value;
     
      if FContext.FlowType <> oaftNone then
      begin
        // Initialisation du moteur d'Authentification
        GetEngine().SetTenant(FContext.Descriptor.Tenant);
     
        // Copie du Context dans l'objet interne de classe TOAuth2Authenticator
        FOAuth2Authenticator.ClientID := FContext.Descriptor.ClientID;
        FOAuth2Authenticator.ClientSecret := FContext.Descriptor.ClientSecret;
        FOAuth2Authenticator.AccessTokenEndpoint := GetEngine().AccessTokenEndpoint;
        FOAuth2Authenticator.AccessToken := FContext.Tokens.AccessToken;
        FOAuth2Authenticator.AccessTokenExpiry := FContext.Tokens.AccessTokenExpiry;
        FOAuth2Authenticator.RefreshToken := FContext.Tokens.RefreshToken;
        FOAuth2Authenticator.AuthCode := FContext.Tokens.AuthorizationCode;
        FOAuth2Authenticator.RedirectionEndpoint := FContext.RedirectionEndpoint;
     
        // Pour le Flow Client Credentials, il ne peut y avoir qu'un seul scope, c'est le mode avec Droit Type Application
        // Pour le Flow Resource Owner Password Credentials (ROPC), la valeur du Scope est conservé et doit être renseigner AVANT le Context !
        case FContext.FlowType of
          oaftClientCredentials:
            FOAuth2Authenticator.Scope := TSLTOAuth2AuthenticatorAzure.SCOPE_AS_APPLICATION;
     
          oaftROPC:
            if FOAuth2Authenticator.Scope = '' then
              raise ESLTOAuth2AuthenticatorError.Create('Friendly method TSLTOAuth2Authenticator.SetScope must be call before assign Context');
        end;
     
        // Modification du Scope
        if GetEngine() is TSLTOAuth2AuthenticatorAzure then
        begin
          if FContext.AccessOffline then
          begin
            if not FOAuth2Authenticator.Scope.Contains(TSLTOAuth2AuthenticatorAzure.SCOPE_OFFLINE_ACCESS) then
              FOAuth2Authenticator.Scope := FOAuth2Authenticator.Scope + ' ' + TSLTOAuth2AuthenticatorAzure.SCOPE_OFFLINE_ACCESS;
          end
          else
          begin
            FOAuth2Authenticator.Scope := StringReplace(FOAuth2Authenticator.Scope, TSLTOAuth2AuthenticatorAzure.SCOPE_OFFLINE_ACCESS, '', []);
            FOAuth2Authenticator.Scope := StringReplace(FOAuth2Authenticator.Scope, '  ', ' ', []);
          end;
        end
        else if GetEngine() is TSLTOAuth2AuthenticatorGoogle then
        begin
          TSLTOAuth2AuthenticatorGoogle(GetEngine()).OfflineAccess := FContext.AccessOffline;
        end
        else if GetEngine() is TSLTOAuth2AuthenticatorYahoo then
        begin
          TSLTOAuth2AuthenticatorYahoo(GetEngine()).OfflineAccess := FContext.AccessOffline;
        end;
      end
      else
      begin
        FOAuth2Authenticator.ClientID := '';
        FOAuth2Authenticator.ClientSecret := '';
        FOAuth2Authenticator.AccessTokenEndpoint := '';
        FOAuth2Authenticator.AccessToken := '';
        FOAuth2Authenticator.AccessTokenExpiry := 0;
        FOAuth2Authenticator.RefreshToken := '';
        FOAuth2Authenticator.AuthCode := '';
        FOAuth2Authenticator.Scope := '';
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTOAuth2Authenticator.SetScope(const AScope: string);
    begin
      FOAuth2Authenticator.Scope := AScope;
    end;
     
    { TSLTOAuth2AuthenticatorEngine }
     
    //------------------------------------------------------------------------------
    constructor TSLTOAuth2AuthenticatorEngine.Create(AOwner: TSLTOAuth2Authenticator);
    begin
      inherited Create();
     
      FOwner := AOwner;
    end;
     
    { TSLTOAuth2AuthenticatorAzure }
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2AuthenticatorAzure.Authenticate(): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      // On vérifie les valeurs avant d'envoyer inutilement une requête
      // En débogage, vous pouvez tenter de laisser les valeurs être envoyé dans l'état pour obtenir le message d'erreur Microsoft
      // voir - https://docs.microsoft.com/fr-fr/azure/active-directory/develop/reference-aadsts-error-codes
      // ClientID, GrantType & Scope also UserName/Password are required if ROPC
      // ClientSecret are recommended but not required (only if defined in Portal Azure)
      if FOwner.Tenant = '' then
        raise ESLTOAuth2AuthenticatorError.Create('Tenant is required for use ' + ClassName());
     
      if FOwner.ClientID = '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('ClientID is required for use ' + ClassName() + ' : See Error "AADSTS900144: The request body must contain the following parameter: ''client_id''."');
     
      if FOwner.Scope = '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('Scope is required for use ' + ClassName() + ' : See Error "AADSTS900144: The request body must contain the following parameter: ''scope''."');
     
      if not FOwner.Scope.Contains(TSLTOAuth2AuthenticatorAzure.SCOPE_AS_APPLICATION) then
        if (FOwner.Context.UserName = '') or (FOwner.Context.Password = '') then
          raise ESLTOAuth2AuthenticatorParamError.Create('UserName and Password has required for use ' + ClassName() + ' : See Error "AADSTS900144: The request body must contain the following parameter: ''username''." or "AADSTS900144: The request body must contain the following parameter: ''password''."');
     
      VClient := TRESTClient.Create(FAccessTokenEndpoint);
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmPOST;
     
        VRequest.AddAuthParameter('client_id', FOwner.ClientID, TRESTRequestParameterKind.pkGETorPOST);
        if FOwner.ClientSecret <> '' then
          VRequest.AddAuthParameter('client_secret', FOwner.ClientSecret, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('scope', FOwner.Scope, TRESTRequestParameterKind.pkGETorPOST);
        if not FOwner.Scope.Contains(TSLTOAuth2AuthenticatorAzure.SCOPE_AS_APPLICATION) then
        begin
          VRequest.AddAuthParameter('grant_type', 'password', TRESTRequestParameterKind.pkGETorPOST);
          VRequest.AddAuthParameter('username', FOwner.Context.UserName, TRESTRequestParameterKind.pkGETorPOST);
          VRequest.AddAuthParameter('password', FOwner.Context.Password, TRESTRequestParameterKind.pkGETorPOST);
        end
        else
          VRequest.AddAuthParameter('grant_type', 'client_credentials', TRESTRequestParameterKind.pkGETorPOST);
     
        Result := FOwner.Execute(VRequest);
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2AuthenticatorAzure.RenewAuth(): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      // On vérifie les valeurs avant d'envoyer inutilement une requête
      // En débogage, vous pouvez tenter de laisser les valeurs être envoyé dans l'état pour obtenir le message d'erreur Microsoft
      // voir - https://docs.microsoft.com/fr-fr/azure/active-directory/develop/reference-aadsts-error-codes
      // ClientID, GrantType & Scope also RefreshToken are required
      // ClientSecret are recommended but not required (only if defined in Portal Azure)
      if FOwner.Tenant = '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('Tenant is required for use ' + ClassName());
     
      if FOwner.ClientID = '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('ClientID is required for use ' + ClassName() + ' : See Error "AADSTS900144: The request body must contain the following parameter: ''client_id''."');
     
      if FOwner.Scope = '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('Scope is required for use ' + ClassName() + ' : See Error "AADSTS900144: The request body must contain the following parameter: ''scope''."');
     
      if FOwner.RefreshToken = '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('RefreshToken is required for use ' + ClassName() + ' : See Error "AADSTS900144: The request body must contain the following parameter: ''refresh_token''."');
     
      VClient := TRESTClient.Create(FAccessTokenEndpoint);
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmPOST;
     
        VRequest.AddAuthParameter('client_id', FOwner.ClientID, TRESTRequestParameterKind.pkGETorPOST);
        if FOwner.ClientSecret <> '' then
          VRequest.AddAuthParameter('client_secret', FOwner.ClientSecret, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('scope', FOwner.Scope, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('grant_type', 'refresh_token', TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('refresh_token', FOwner.RefreshToken, TRESTRequestParameterKind.pkGETorPOST);
     
        Result := FOwner.Execute(VRequest);
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTOAuth2AuthenticatorAzure.SetTenant(const Value: string);
    begin
      if Value <> '' then
        FAccessTokenEndpoint := Format('https://login.microsoftonline.com/%s/oauth2/v2.0/token', [Value])
      else
        raise ESLTOAuth2AuthenticatorParamError.Create('Tenant is required by ' + ClassName());
    end;
     
    { TSLTOAuth2AuthenticatorGoogle }
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2AuthenticatorGoogle.Authenticate(): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      FAccessTokenEndpoint := 'https://oauth2.googleapis.com/token';
      // A etudier le flux "https://developers.google.com/identity/protocols/oauth2/service-account#delegatingauthority"
      // Pour le moment c'est le flux "https://developers.google.com/identity/protocols/oauth2/web-server"
     
      VClient := TRESTClient.Create(FAccessTokenEndpoint);
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmPOST;
     
        VRequest.AddAuthParameter('client_id', FOwner.ClientID, TRESTRequestParameterKind.pkGETorPOST);
        if FOwner.ClientSecret <> '' then
          VRequest.AddAuthParameter('client_secret', FOwner.ClientSecret, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('grant_type', 'authorization_code', TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('code', FOwner.AuthorizationCode, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('redirect_uri', FOwner.RedirectionEndpoint, TRESTRequestParameterKind.pkGETorPOST);
        // Offline doit être défini dans lors de l'obtention du code, le répéter ici ne semble pas avoir grande influence
        if FOfflineAccess then
          VRequest.AddAuthParameter('access_type', 'offline', TRESTRequestParameterKind.pkGETorPOST);
     
        Result := FOwner.Execute(VRequest);
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2AuthenticatorGoogle.RenewAuth(): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      FAccessTokenEndpoint := 'https://oauth2.googleapis.com/token';
     
      VClient := TRESTClient.Create(FAccessTokenEndpoint);
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmPOST;
     
        VRequest.AddAuthParameter('client_id', FOwner.ClientID, TRESTRequestParameterKind.pkGETorPOST);
        if FOwner.ClientSecret <> '' then
          VRequest.AddAuthParameter('client_secret', FOwner.ClientSecret, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('grant_type', 'refresh_token', TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('refresh_token', FOwner.RefreshToken, TRESTRequestParameterKind.pkGETorPOST);
     
        Result := FOwner.Execute(VRequest);
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTOAuth2AuthenticatorGoogle.SetTenant(const Value: string);
    begin
      if Value <> '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('Tenant is not supported by ' + ClassName());
    end;
     
    { TSLTOAuth2AuthenticatorYahoo }
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2AuthenticatorYahoo.Authenticate(): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      FAccessTokenEndpoint := 'https://api.login.yahoo.com/oauth2/get_token';
     
      VClient := TRESTClient.Create(FAccessTokenEndpoint);
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmPOST;
     
        VRequest.AddAuthParameter('client_id', FOwner.ClientID, TRESTRequestParameterKind.pkGETorPOST);
        if FOwner.ClientSecret <> '' then
          VRequest.AddAuthParameter('client_secret', FOwner.ClientSecret, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('grant_type', 'authorization_code', TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('code', FOwner.AuthorizationCode, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('redirect_uri', FOwner.RedirectionEndpoint, TRESTRequestParameterKind.pkGETorPOST);
        if FOfflineAccess then
          VRequest.AddAuthParameter('access_type', 'offline', TRESTRequestParameterKind.pkGETorPOST);
     
        Result := FOwner.Execute(VRequest);
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTOAuth2AuthenticatorYahoo.RenewAuth(): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      FAccessTokenEndpoint := 'https://api.login.yahoo.com/oauth2/get_token';
     
      VClient := TRESTClient.Create(FAccessTokenEndpoint);
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmPOST;
     
        VRequest.AddAuthParameter('client_id', FOwner.ClientID, TRESTRequestParameterKind.pkGETorPOST);
        if FOwner.ClientSecret <> '' then
          VRequest.AddAuthParameter('client_secret', FOwner.ClientSecret, TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('grant_type', 'refresh_token', TRESTRequestParameterKind.pkGETorPOST);
        VRequest.AddAuthParameter('refresh_token', FOwner.RefreshToken, TRESTRequestParameterKind.pkGETorPOST);
     
        Result := FOwner.Execute(VRequest);
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTOAuth2AuthenticatorYahoo.SetTenant(const Value: string);
    begin
      if Value <> '' then
        raise ESLTOAuth2AuthenticatorParamError.Create('Tenant is not supported by ' + ClassName());
    end;
     
    { TSLTSASLXOAuth2 }
     
    //------------------------------------------------------------------------------
    function TSLTSASLXOAuth2.ContinueAuthenticate(const ALastResponse, AHost, AProtocolName: string): String;
    var
      JSONResponse: System.JSON.TJSONObject;
    begin
      JSONResponse := TJSONObject.ParseJSONValue(ALastResponse) as TJSONObject;
      try
        if Assigned(JSONResponse) then
        begin
          FStatusCode := JSONResponse.Values['status'].Value;
          FErrorSchemes := JSONResponse.Values['schemes'].Value;
          FErrorScope := JSONResponse.Values['scope'].Value;
        end;
      finally
        JSONResponse.Free;
      end;
    end;
     
    //------------------------------------------------------------------------------
    destructor TSLTSASLXOAuth2.Destroy();
    begin
      if FAuthenticatorOwned then
        FreeAndNil(FAuthenticator);
     
      inherited Destroy();
    end;
     
    //------------------------------------------------------------------------------
    function TSLTSASLXOAuth2.GetAuthenticator(): TSLTOAuth2Authenticator;
    begin
      if not Assigned(FAuthenticator) then
      begin
        FAuthenticator := TSLTOAuth2Authenticator.Create();
        FAuthenticatorOwned := True;
      end;
     
      Result := FAuthenticator;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTSASLXOAuth2.InitComponent();
    begin
      inherited InitComponent();
     
      FSecurityLevel := 1000000; // pretty darn good
    end;
     
    //------------------------------------------------------------------------------
    class function TSLTSASLXOAuth2.ServiceName(): TIdSASLServiceName;
    begin
      (*
        Returns the service name of the descendant class,
        this is a string[20] in accordance with the SASL specification.
      *)
      Result := 'XOAUTH2';   {Do not translate}
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTSASLXOAuth2.SetAuthenticator(const Value: TSLTOAuth2Authenticator);
    begin
      if FAuthenticator <> Value then
      begin
        if FAuthenticatorOwned then
          FreeAndNil(FAuthenticator);
     
        FAuthenticator := Value;
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTSASLXOAuth2.StartAuthenticate(const AChallenge, AHost, AProtocolName: string): string;
    begin
      FStatusCode := '';
      FErrorSchemes := '';
      FErrorScope := '';
     
      Result := 'user=' + UserName + Chr($01) + 'auth=Bearer ' + Authenticator.AccessToken + Chr($01) + Chr($01);
    end;
     
    //------------------------------------------------------------------------------
    function TSLTSASLXOAuth2.TryStartAuthenticate(const AHost, AProtocolName: string; var VInitialResponse: string): Boolean;
    begin
      FStatusCode := '';
      FErrorSchemes := '';
      FErrorScope := '';
     
      VInitialResponse := 'user=' + UserName + Chr($01) + 'auth=Bearer ' + Authenticator.AccessToken + Chr($01) + Chr($01);
      Result := True;
    end;
     
    { TSLTIMAP4XOAuth2 }
     
    //------------------------------------------------------------------------------
    function TSLTIMAP4XOAuth2.GetOAuth2Context(): TSLTOAuth2Context;
    begin
      Result := GetOAuth2SASL().Authenticator.Context;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTIMAP4XOAuth2.GetOAuth2SASL(): TSLTSASLXOAuth2;
    begin
      if SASLMechanisms.Count = 1 then
        if SASLMechanisms.Items[0].SASL is TSLTSASLXOAuth2 then
          Exit(TSLTSASLXOAuth2(SASLMechanisms.Items[0].SASL));
     
      raise ESLTIMAP4XOAuth2Error.Create('SASLMechanisms.Items[0].SASL must be an TSLTSASLXOAuth2');
    end;
     
    //------------------------------------------------------------------------------
    function TSLTIMAP4XOAuth2.GetOfflineAccess(): Boolean;
    begin
      Result := GetOAuth2SASL().Authenticator.OfflineAccess;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTIMAP4XOAuth2.InitComponent();
    begin
      inherited InitComponent();
     
      AuthType := iatSASL;
      SASLMechanisms.Clear();
      SASLMechanisms.Add().SASL := TSLTSASLXOAuth2.Create(Self);
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTIMAP4XOAuth2.SetOAuth2Context(const Value: TSLTOAuth2Context);
    begin
      if not (Value.Descriptor.Kind in [oakAzure, oakGMail, oakYahoo]) then
        raise ESLTIMAP4XOAuth2Error.Create('Kind Context must be defnied for use IMAP4 with XOAuth2');
     
      // Nécessaire pour construire la chaine SASL XOAuth2
      if Value.UserName = '' then
        raise ESLTIMAP4XOAuth2Error.Create('Username in context must be defnied for use IMAP4 with XOAuth2');
     
      // Juillet 2020 :
      // Azure ne fournit pas d'autorisation d'application pour IMAP4 mais uniquement pour GRAPH
      // Gmail autorisation d'application non vérifiée
      // Yahoo! autorisation d'application non vérifiée
      if Value.FlowType = oaftClientCredentials then
        if not IMAP4_IS_SUPPORTED_AS_APPLICATION_RIGHTS[Value.Descriptor.Kind] then
          raise ESLTIMAP4XOAuth2Error.Create('The authorization server don''t supports IMAP4 with XOAuth2 for Client Credentials Flow');
     
      Username := Value.UserName;
      Password := Value.Password;
      with GetOAuth2SASL() do
      begin
        UserName := Value.UserName;
     
        Authenticator.SetScope(SCOPE_IMAP4[Value.Descriptor.Kind]);
        Authenticator.Context := Value;
      end;
    end;
     
    { TSLTMicrosoftGraph }
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.CheckMessages(): Integer;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
      VMails: System.JSON.TJSONArray;
      VMail: System.JSON.TJSONValue;
    begin
      if not Assigned(FFolder) then
        raise EIdException.Create('Must be call SelectMailBox() before CheckMessages()');
     
      if not Connected() then
        raise EIdConnectionStateError.Create('Must be call Connect() [and more] before CheckMessages()');
     
      Result := 0;
      if FFolder.TotalItemCount > 0 then
      begin
        VClient := CreateRESTClientForUser();
        try
          VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
          VRequest.Method := TRESTRequestMethod.rmGet;
          VRequest.Resource := Format('mailFolders/%s/messages', [FFolder.ID]);
     
          VRequest.AddParameter('$select', 'id', TRESTRequestParameterKind.pkGETorPOST);
          VRequest.AddParameter('$orderby', 'createdDateTime asc', TRESTRequestParameterKind.pkGETorPOST);
          VRequest.AddParameter('$top', FFolder.TotalItemCount.ToString(), TRESTRequestParameterKind.pkGETorPOST);
     
          Execute(VRequest, [200]);
     
          VMails := (VRequest.Response.JSONValue as TJSONObject).GetValue('value') as System.JSON.TJSONArray;
          for VMail in VMails do
          begin
            FMessageIDs[Result] := VMail.GetValue('id', '');
            Inc(Result);
          end;
     
        finally
          VClient.Free();
        end;
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTMicrosoftGraph.Connect();
    begin
      Disconnect();
     
      if Authenticator.AccessToken = '' then
        raise ESLTMicrosoftGraphError.Create('Connect error: No Access Token available');
     
      FConnected := True;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.Connected(): Boolean;
    begin
      Result := FConnected and (Authenticator.AccessToken <> '');
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.CreateRESTClientForUser(): TRESTClient;
    begin
      Result := TRESTClient.Create(Format('https://graph.microsoft.com/v1.0/users/%s', [FUserName]));
      try
        Result.ContentType := REQUEST_CONTENT_TYPE;
        Result.Authenticator := FAuthenticator.OAuth2Authenticator;
      except
        FreeAndNil(Result);
        raise;
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.Delete(const AMsgNum: Integer): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      if AMsgNum < 1 then
        raise EIdException.Create('Must be call Delete() with an AMsgNum as an one-based index');
     
      if AMsgNum > Length(FMessageIDs) then
        raise EIdException.Create('Must be call Retrieve() with an valid AMsgNum index');
     
      if not Assigned(FFolder) then
        raise EIdException.Create('Must be call SelectMailBox() [and more] before Delete()');
     
      if not Connected() then
        raise EIdConnectionStateError.Create('Must be call Connect() [and more] before Delete()');
     
      VClient := CreateRESTClientForUser();
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmDELETE;
        VRequest.Resource := Format('messages/%s', [FMessageIDs[AMsgNum - 1]]);
     
        try
          Execute(VRequest, [204]);
          Result := True;
        except
          Result := False;
        end;
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    destructor TSLTMicrosoftGraph.Destroy();
    begin
      Disconnect();
     
      if FAuthenticatorOwned then
        FreeAndNil(FAuthenticator);
     
      inherited Destroy();
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTMicrosoftGraph.Disconnect(ANotifyPeer: Boolean);
    begin
      FreeAndNil(FFolder);
     
      FConnected := False;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTMicrosoftGraph.Execute(ARequest: TRESTRequest; const AAcceptedErrorCodes: TArray<Integer>);
    var
      AcceptedErrorCode: Integer;
    begin
      ARequest.Timeout := FTimeOut;
      ARequest.Execute();
     
      for AcceptedErrorCode in AAcceptedErrorCodes do
        if ARequest.Response.StatusCode = AcceptedErrorCode then
          Exit;
     
      raise ESLTMicrosoftGraphError.Create('Request : ' + ARequest.Client.BaseURL + ' ' + ARequest.Resource + sLineBreak + ExtractError(ARequest.Response));
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.ExtractError(AJSONContent: TCustomRESTResponse): string;
    var
      Error: System.JSON.TJSONValue;
      ErrorCode, ErrorMessage: string;
    begin
      if AJSONContent.JSONValue.TryGetValue('error', Error) then
      begin
        ErrorCode := Error.GetValue('code', '');
        ErrorMessage := Error.GetValue('message', '');
     
        if (ErrorCode <> '') and (ErrorMessage <> '') then
          Result := Format('Error: "%s" (%s)', [ErrorMessage, ErrorCode])
        else if ErrorCode <> '' then
          Result := Format('Error: (%s)', [ErrorCode])
        else if ErrorMessage <> '' then
          Result := Format('Error: "%s"', [ErrorMessage])
        else
          Result := 'Error: incomplete JSON';
      end
      else
        Result := Format('HTTP Error %d', [AJSONContent.StatusCode]);
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.GetAuthenticator(): TSLTOAuth2Authenticator;
    begin
      if not Assigned(FAuthenticator) then
      begin
        FAuthenticator := TSLTOAuth2Authenticator.Create();
        FAuthenticatorOwned := True;
      end;
     
      Result := FAuthenticator;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.GetOAuth2Context(): TSLTOAuth2Context;
    begin
      Result := GetAuthenticator().Context;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.GetOfflineAccess(): Boolean;
    begin
      Result := GetAuthenticator().OfflineAccess;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.Retrieve(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
      VContent: TStringStream;
    begin
      if not Assigned(AMsg) then
        raise EIdException.Create('Must be call Retrieve() with instanciated TIdMessage in parameters AMsg');
     
      if AMsgNum < 1 then
        raise EIdException.Create('Must be call Retrieve() with an AMsgNum as an one-based index');
     
      if AMsgNum > Length(FMessageIDs) then
        raise EIdException.Create('Must be call Retrieve() with an valid AMsgNum index');
     
      if not Assigned(FFolder) then
        raise EIdException.Create('Must be call SelectMailBox() [and more] before Retrieve()');
     
      if not Connected() then
        raise EIdConnectionStateError.Create('Must be call Connect() [and more] before Retrieve()');
     
      VClient := CreateRESTClientForUser();
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmGet;
        VRequest.Resource := Format('messages/%s/$value', [FMessageIDs[AMsgNum - 1]]);
     
        try
          Execute(VRequest, [200]);
     
          VContent := TStringStream.Create(VRequest.Response.Content);
          try
            AMsg.LoadFromStream(VContent);
            Result := True;
          finally
            VContent.Free();
          end;
        except
          Result := False;
        end;
     
      finally
        VClient.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TSLTMicrosoftGraph.SelectMailBox(const AWellKnownFolderNameOrIdentifer: string): Boolean;
    var
      VClient: TRESTClient;
      VRequest: TRESTRequest;
    begin
      if not Connected() then
        raise EIdConnectionStateError.Create('Must be call Connect() before SelectMailBox()');
     
      Result := False;
     
      VClient := CreateRESTClientForUser();
      try
        VRequest := TRESTRequest.Create(VClient); // The Client owns the Request (will free it) and it will assign as Client property
        VRequest.Method := TRESTRequestMethod.rmGet;
        VRequest.Resource := Format('mailFolders/%s', [AWellKnownFolderNameOrIdentifer]);
     
        VRequest.AddParameter('$select', 'id,totalItemCount', TRESTRequestParameterKind.pkGETorPOST);
     
        Execute(VRequest, [200]);
     
        FFolder := TFolder.Create(VRequest.Response);
        if (FFolder.ID <> '') and (FFolder.TotalItemCount >= 0) then
        begin
          SetLength(FMessageIDs, FFolder.TotalItemCount);
          Result := True;
        end;
     
      finally
        VClient.Free();
     
        if not Result then
        begin
          FreeAndNil(FFolder);
          SetLength(FMessageIDs, 0);
        end;
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTMicrosoftGraph.SetAuthenticator(const Value: TSLTOAuth2Authenticator);
    begin
      if Assigned(Value) and (Value.Kind <> oakAzure) then
        raise ESLTMicrosoftGraphError.Create('OAuth2Authenticator must support Azure for use Microsoft Graph');
     
      if FAuthenticator <> Value then
      begin
        if FAuthenticatorOwned then
          FreeAndNil(FAuthenticator);
     
        FAuthenticator := Value;
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TSLTMicrosoftGraph.SetOAuth2Context(const Value: TSLTOAuth2Context);
    begin
      if Value.Descriptor.Kind <> oakAzure then
        raise ESLTMicrosoftGraphError.Create('Kind Context must be Azure for use Microsoft Graph');
     
      // Nécessaire pour construire la chaine URL Get .../mailFolders/...
      if Value.UserName = '' then
        raise ESLTMicrosoftGraphError.Create('Username in context must be defined for use Microsoft Graph');
     
      UserName := Value.UserName;
     
      with GetAuthenticator() do
      begin
        SetScope(SCOPE_MAIL_RW);
        Context := Value;
      end;
    end;
     
    { TSLTMicrosoftGraph.TFolder }
     
    //------------------------------------------------------------------------------
    constructor TSLTMicrosoftGraph.TFolder.Create(AJSONContent: TCustomRESTResponse);
    begin
      inherited Create();
     
      if not AJSONContent.JSONValue.TryGetValue('id', FID) then
        FID := '';
     
      if not AJSONContent.JSONValue.TryGetValue('totalItemCount', FTotalItemCount) then
        FTotalItemCount := -1;
    end;
     
    { TSLTOAuth2Descriptor }
     
    //------------------------------------------------------------------------------
    class function TSLTOAuth2Descriptor.Create(AKind: TSLTOAuth2Kind; const AClientID, AClientSecret, ATenant: string): TSLTOAuth2Descriptor;
    begin
      Result.Kind := AKind;
      Result.ClientID := AClientID;
      Result.ClientSecret := AClientSecret;
      Result.Tenant := ATenant;
    end;
     
    { TSLTOAuth2Tokens }
     
    //------------------------------------------------------------------------------
    class function TSLTOAuth2Tokens.Create(const AAccessToken: string; AAccessTokenExpiry: TDateTime; const ARefreshToken: string; const AAuthorizationCode: string = ''): TSLTOAuth2Tokens;
    begin
      Result.AccessToken := AAccessToken;
      Result.AccessTokenExpiry := AAccessTokenExpiry;
      Result.RefreshToken := ARefreshToken;
      Result.AuthorizationCode := AAuthorizationCode;
    end;
     
    { TSLTOAuth2Context }
     
    //------------------------------------------------------------------------------
    class function TSLTOAuth2Context.Create(AKind: TSLTOAuth2Kind; const AClientID, AClientSecret, ATenant: string; const ATokens: TSLTOAuth2Tokens): TSLTOAuth2Context;
    begin
      Result.Descriptor := TSLTOAuth2Descriptor.Create(AKind, AClientID, AClientSecret, ATenant);
      Result.Tokens := ATokens;
    end;
     
    end.
    le code d'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
    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
    procedure TOffice365MailLiteMainForm.btnASTDownloadClick(Sender: TObject);
    var
      VIdMessageClient: TIdMessageClient;
      VIMAP4: TIdIMAP4;
      VGraph: TSLTMicrosoftGraph;
      VAuth: TSLTOAuth2Authenticator;
      VTokens: TSLTOAuth2Tokens;
      VMsgCount, I, J: Integer;
      VMessage: TIdMessage;
    begin
      Memo1.Lines.Clear();
      VIdMessageClient := nil;
      VIMAP4 := nil;
      VGraph := nil;
      VAuth := nil;
     
      case rgrpScope.ItemIndex of
        0: VIdMessageClient := TSLTMicrosoftGraph.Create(nil);
        1: VIdMessageClient := TSLTIMAP4XOAuth2.Create(nil);
        2: VIdMessageClient := TIdIMAP4.Create(nil);
      else
        Abort;
      end;
     
      VTokens := TSLTOAuth2Tokens.Create(edAuthAccessToken.Text, DateOf(edAuthAccessTokenDateExpiryDay.Date) + TimeOf(edAuthAccessTokenDateExpiryHour.Time), edAuthRefreshToken.Text);
     
      try
        if VIdMessageClient is TSLTIMAP4XOAuth2 then
        begin
          Memo1.Lines.Add('IMAP4 OAuth2');
          VIMAP4 := TSLTIMAP4XOAuth2(VIdMessageClient);
          TSLTIMAP4XOAuth2(VIMAP4).OAuth2Context := BuildMailBoxOAuth2Context(VTokens, True);
          VAuth := TSLTIMAP4XOAuth2(VIMAP4).OAuth2SASL.Authenticator;
     
          VIdMessageClient.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(VIdMessageClient);
          TIdSSLIOHandlerSocketOpenSSL(VIdMessageClient.IOHandler).SSLOptions.Method := sslvSSLv23;
          TIdSSLIOHandlerSocketOpenSSL(VIdMessageClient.IOHandler).SSLOptions.Mode := sslmUnassigned;
     
          VIMAP4.UseTLS := utUseImplicitTLS;
          VIMAP4.Port := 993; // 143
          VIMAP4.Host := TSLTIMAP4XOAuth2.HOSTS[TSLTIMAP4XOAuth2(VIMAP4).OAuth2Context.Descriptor.Kind];
        end
        else if VIdMessageClient is TSLTMicrosoftGraph then
        begin
          Memo1.Lines.Add('Graph');
          VGraph := TSLTMicrosoftGraph(VIdMessageClient);
          VGraph.OAuth2Context := BuildMailBoxOAuth2Context(VTokens, True);
          VAuth := VGraph.Authenticator;
        end
        else if VIdMessageClient is TIdIMAP4 then
        begin
          Memo1.Lines.Add('IMAP4 Basic');
          ConnectionIMAP4Basic(TIdIMAP4(VIdMessageClient));
     
          VIMAP4 := TIdIMAP4(VIdMessageClient);
        end;
     
        Memo1.Lines.Add('Connect ...');
        try
          if VIdMessageClient is TIdIMAP4 then
            VIMAP4.Connect() // reintroduce
          else
            VIdMessageClient.Connect();
        except
          FPassword := '';
          raise;
        end;
     
        if Assigned(VAuth) then
        begin
          edAuthAccessToken.Text := VAuth.AccessToken;
          edAuthAccessTokenDateExpiryDay.Date := VAuth.AccessTokenExpiry;
          edAuthAccessTokenDateExpiryHour.Time := VAuth.AccessTokenExpiry;
          if ckbOfflineAccess.Checked then
            edAuthRefreshToken.Text := VAuth.RefreshToken;
        end;
     
        Memo1.Lines.Add(Format('SelectMailBox %s ...', [edFolder.Text]));
        if (Assigned(VGraph) and VGraph.SelectMailBox(edFolder.Text)) or (Assigned(VIMAP4) and VIMAP4.SelectMailBox(edFolder.Text)) then
        begin
          Memo1.Lines.Add('CheckMessages ...');
          VMsgCount := 0;
          if Assigned(VGraph) then
            VMsgCount := VGraph.CheckMessages()
          else if Assigned(VIMAP4) then
            VMsgCount := VIMAP4.MailBox.TotalMsgs
          else
            Abort;
     
          try
            Memo1.Lines.Add(Format('for %d message(s) ...', [VMsgCount]));
     
            if chkOnlyCheckCount.Checked then
              Exit;
     
            for I := 1 To VMsgCount do
            begin
              VMessage := TIdMessage.create(nil) ;
              try
                Memo1.Lines.Add(Format('Retrieve %d / %d ...', [I, VMsgCount]));
                if (Assigned(VGraph) and VGraph.Retrieve(I, VMessage)) or (Assigned(VIMAP4) and VIMAP4.Retrieve(I, VMessage)) then
                begin
                  Memo1.Lines.Add('--');
                  Memo1.Lines.Add('Subject: ' + VMessage.Subject);
                  Memo1.Lines.Add('ContentType: ' + VMessage.ContentType);
                  Memo1.Lines.Add('Auto-Submitted: ' + VMessage.Headers.Values['Auto-Submitted']);
                  Memo1.Lines.Add('From.Name: ' + VMessage.From.Name);
                  Memo1.Lines.Add('From.Address: ' + VMessage.From.Address);
                  for J := 0 to VMessage.Recipients.Count - 1 do
                  begin
                    Memo1.Lines.Add(Format('Recipients[%d].Name: %s', [J, VMessage.Recipients[J].Name]));
                    Memo1.Lines.Add(Format('Recipients[%d].Address: %s', [J, VMessage.Recipients[J].Address]));
                  end;
                  for J := 0 to VMessage.CCList.Count - 1 do
                  begin
                    Memo1.Lines.Add(Format('CCList[%d].Name: %s', [J, VMessage.CCList[J].Name]));
                    Memo1.Lines.Add(Format('CCList[%d].Address: %s', [J, VMessage.CCList[J].Address]));
                  end;
     
                  if VMessage.MessageParts.Count > 0 then
                  begin
                    for J := 0 to VMessage.MessageParts.Count - 1 do
                    begin
                      Memo1.Lines.Add(Format('MessageParts[%d] as %s:', [J, VMessage.MessageParts[J].ClassName()]));
                      if VMessage.MessageParts[J] is TIdText then
                      begin
                        Memo1.Lines.Add('Body :');
                        Memo1.Lines.AddStrings(TIdText(VMessage.MessageParts[J]).Body);
                      end
                      else if VMessage.MessageParts[J] is TIdAttachmentFile then
                      begin
                        Memo1.Lines.Add('FileName :' + TIdAttachmentFile(VMessage.MessageParts[J]).FileName);
                        Memo1.Lines.Add('StoredPathName :' + TIdAttachmentFile(VMessage.MessageParts[J]).StoredPathName);
                        Memo1.Lines.Add('ContentID :' + TIdAttachmentFile(VMessage.MessageParts[J]).ContentID);
                        Memo1.Lines.Add('ContentType :' + TIdAttachmentFile(VMessage.MessageParts[J]).ContentType);
                        Memo1.Lines.Add('ContentDisposition :' + TIdAttachmentFile(VMessage.MessageParts[J]).ContentDisposition);
                      end;
                    end;
                  end
                  else
                  begin
                    Memo1.Lines.Add('Body :');
                    Memo1.Lines.AddStrings(VMessage.Body);
                  end;
     
                  if Assigned(VGraph) and VMessage.Subject.Contains('Test Delete') then
                  begin
                    Memo1.Lines.Add('--');
                    Memo1.Lines.Add('Deleting');
                    if VGraph.Delete(I) then
                      Memo1.Lines.Add('Deleted');
                  end;
     
                  Memo1.Lines.Add('--');
                end;
              finally
                VMessage.Free();
              end;
            end;
     
          finally
            Memo1.Lines.Add('Disconnect ...');
            if VIdMessageClient is TIdIMAP4 then
              VIMAP4.Disconnect()
            else
              VIdMessageClient.Disconnect();
          end;
        end;
      finally
        VIdMessageClient.Free();
      end;
    end;
    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
    function TOffice365MailLiteMainForm.BuildMailBoxOAuth2Context(const ATokens: TsmoOAuth2Tokens; AInputAllowed: Boolean): TsmoOAuth2Context;
    var
      LKind: TsmoOAuth2Kind;
    begin
      if ContainsText(edASTMailUser.Text, '@GMAIL') then
        LKind := oakGMail
      else if ContainsText(edASTMailUser.Text, '@Yahoo') then
        LKind := oakYahoo
      else
        LKind := oakAzure;
     
      Result := TsmoOAuth2Context.Create(LKind, edClient.Text, edClientSecret.Text, edTenant.Text, ATokens);
     
      Result.UserName := edASTMailUser.Text;
     
      if LKind = oakAzure then
      begin
        if AInputAllowed and (FPassword = '') then
          FPassword := InputBox(Result.UserName, #9'Password', '');
     
        if FPassword <> '' then
        begin
          Result.Password := FPassword;
          Result.FlowType := oaftROPC;
        end
        else
          Result.FlowType := oaftClientCredentials;
      end
      else
      begin
        if AInputAllowed then
          Result.Tokens.AuthorizationCode := InputBox(Result.UserName, 'Authorization Code', '');
     
        Result.Password := '';
        Result.FlowType := oaftAuthorizationCode;
        Result.RedirectionEndpoint := lblRedirectionURI.Caption;
      end;
     
      Result.AccessOffline := ckbOfflineAccess.Checked;
    end;
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  13. #13
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Bonjour ShaiLeTroll,

    Merci pour ces astuces, cela m'aurait dépanné à l'époque de la création de mon sujet. A ce moment, j'ai bien vu que XOAuth2 peut être la clé de la solution. Mais il me semble que cela ne peut pas fonctionner avec Delphi 2010. Au boulot c'est ce qu'on a, je n'ai pas de XE. D'où ma solution moins bien, mais qui fonctionne.

  14. #14
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    Citation Envoyé par Feymann Voir le message
    Bonjour ShaiLeTroll,

    Merci pour ces astuces, cela m'aurait dépanné à l'époque de la création de mon sujet. A ce moment, j'ai bien vu que XOAuth2 peut être la clé de la solution. Mais il me semble que cela ne peut pas fonctionner avec Delphi 2010. Au boulot c'est ce qu'on a, je n'ai pas de XE. D'où ma solution moins bien, mais qui fonctionne.

    Delphi 2010, ça date un peu maintenant,
    En 2015, j'ai totalement écrit en XE2 l'obtention de Token Bearer pour Symfony ce qui n'est pas très éloigné, cela ressemblait au mode ROPC de OAuth2

    Je ne sais pas ce qui manquerait en 2010, je dirais pour commencer le THTTPClient qu'il faudrait remplacer par Indy TIdHTTP
    Si j'ai un moment, je tenterais de faire un bout de code, il sera moche mais ça sera un début avec Indy TIdHTTP sur XE2 et utilisé l'objet JSON dans un autre namespace (Data.DBXJSON vs System.JSON), rien d'insurmontable.
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  15. #15
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Citation Envoyé par ShaiLeTroll Voir le message
    Delphi 2010, ça date un peu maintenant,
    C'est le moins que l'on puisse dire. Mais nous sommes une petite entreprise, travaillant pour les pays du monde entier, nos moyens ne sont pas les mêmes que dans d'autres entreprises. Mais on fait avec les moyens du bord. Cela ne nous empêche pas de développer pour des clients dans des secteurs divers et variés et si même en plein COVID on croule sous le travail, c'est qu'on ne bosse pas si mal.

    Je pense que le jour où mon appli ne remarchera plus avec Gmail, je vais simplement faire la suggestion à mon patron d'acheter quelque chose de plus récent ;-)

  16. #16
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    Citation Envoyé par Feymann Voir le message
    Il est important d'activer la validation en deux étapes et créer un mot de passe d'application.
    J'ai eu un point avec mon Chef, on va implémenter OAuth2 mais le temps de se taper cette lourdeur Yahoo (https://developer.verizonmedia.com/m...il-api-access/), je dois aussi regarder pour GMail le mode "mot de passe d'application", j'en ai créé un mais c'est ce qui remplace le Password ? comment avez-vous utilisé ce code ?
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  17. #17
    Membre à l'essai Avatar de Feymann
    Femme Profil pro
    Automaticienne - informaticienne industrielle
    Inscrit en
    Juillet 2012
    Messages
    27
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Automaticienne - informaticienne industrielle
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2012
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Bonjour,

    Oui, à la place de votre mot de passe habituel pour le compte gmail il faut mettre celui qui ressemble à un gloubiboulga genre: jfqevtbbwuywafdn.

    Côté utilisation je l'ai utilisé dans la procédure décrite plus haut dans cette discussion.

  18. #18
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    Merci, semble que l'ajout de "validation en deux étapes" débloque le bazar
    Je supprimerais tout et j'en referais une toute neuve pour voir et bien documenter la procédure pour les utilisateurs fous qui voudrait utiliser gMail au lieu de leur Office365
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Connexion SSL avec composants INDY
    Par Tenguryu dans le forum C++Builder
    Réponses: 3
    Dernier message: 12/11/2009, 10h41
  2. Problème avec composant Indy
    Par yoshï dans le forum C++Builder
    Réponses: 2
    Dernier message: 17/09/2007, 12h50
  3. Pièces Jointes avec composant Indy 10 IDMessage
    Par kimlee dans le forum Composants VCL
    Réponses: 0
    Dernier message: 12/08/2007, 20h26
  4. DELPHI 7 avec composants Web en acces avec Oracle et/ou Sql-Server
    Par fgerard dans le forum Bases de données
    Réponses: 2
    Dernier message: 06/07/2007, 12h07
  5. probleme avec composant indy IDhttp
    Par ulysse66x dans le forum Composants VCL
    Réponses: 3
    Dernier message: 16/06/2003, 10h35

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo