Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Internet
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Colaboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 13-07-2025
Avatar de Carmelo Cash
Carmelo Cash Carmelo Cash is offline
Miembro
 
Registrado: jul 2003
Ubicación: Buenos Aires
Posts: 265
Poder: 23
Carmelo Cash Va por buen camino
OAuth indy10

Buenos días

Estoy usando Delphi 7 + Indy 10
Tengo un sistema que emite facturas y las envía por email.

El cliente tiene desde hace varios años una cuentapaga de gmail, pero ahora me encuentro con esto.

A partir del 1 de mayo del 2025, las cuentas de Google Workspace ya no admitirán las aplicaciones menos seguras, las aplicaciones de terceros ni los dispositivos que te pidan que inicies sesión en tu cuenta de Google con tu nombre de usuario y contraseña. Debes usar OAuth para permitir que estas aplicaciones y dispositivos accedan a tu cuenta

Estoy viendo estos links, pero no encuentro la forma de solucionarlo.

https://support.google.com/a/answer/...53262637903-SA

https://developers.google.com/worksp...ent_response_2

Tal vez alguien ya lo haya resuelto o me de una idea de por donde encarar esta solución.

Desde ya muchas gracias por su atención.
Responder Con Cita
  #2  
Antiguo 13-07-2025
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 90
Poder: 22
Garada Va por buen camino
Creo que Gmail aún permite contraseñas de aplicación, con eso no necesitas cambiar código. Busca información de cómo crearlas y prueba.

Para implementar OAuth vas a tener que leer bastante documentación.
Primero tienes que actualizar la versión de Indy a la última que hace unos meses añadieron soporte para el uso de tokens.
Entonces es fácil enviar un email con Oauth2, sólo hay que añadir unas líneas como estas:
Código Delphi [-]
      
      SASLEntry := SMTP.SASLMechanisms.Add;
      SASLEntry.SASL := TIdSASLXOAuth2.Create(nil);
      TIdSASLXOAuth2(SASLEntry.SASL).UserPassProvider := TIdUserPassProvider.Create(SMTP);
      TIdSASLXOAuth2(SASLEntry.SASL).UserPassProvider.Username := SmtpUser;
      TIdSASLXOAuth2(SASLEntry.SASL).UserPassProvider.Password := AccessToken;

      SMTP.AuthType := satSASL;

Pero lo complicado es obtener el Token.
Antes tienes que darte de alta en Google y obtener un ID y un secreto de cliente (tu aplicación)
Aquí tienes la documentación de Google:
https://developers.google.com/identi...-app?hl=es-419

Y además tienes que crearte el código para solicitar permiso al usuario y obtener el token.
Y una vez obtenido, renovarlo si es necesario antes de un envío.
Aquí un enlace aun proyecto de prueba con código para gestionar el token.
https://github.com/geoffsmith82/GmailAuthSMTP

Es todo un coñazo, pq si el cliente mañana se pasa a Outlook tendrás que investigar cómo darse de alta con Microsoft y las direcciones y parámetros de llamada para la solicitud OAuth.
Responder Con Cita
  #3  
Antiguo 14-07-2025
Avatar de Carmelo Cash
Carmelo Cash Carmelo Cash is offline
Miembro
 
Registrado: jul 2003
Ubicación: Buenos Aires
Posts: 265
Poder: 23
Carmelo Cash Va por buen camino
Muchas gracias

Muchas gracias

Sabes donde puedo conseguir la ultima versión de las Indy?
Responder Con Cita
  #4  
Antiguo 14-07-2025
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 90
Poder: 22
Garada Va por buen camino
Aquí lo tienes:
https://github.com/IndySockets/Indy
Responder Con Cita
  #5  
Antiguo 15-07-2025
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 90
Poder: 22
Garada Va por buen camino
Buscando encontré un objeto que creé para probar como iba la funcionalidad nueva en Indy.
Está hecho con Delphi 2010 y habrá funciones propias o de librerías de terceros pero te valdría como plantilla para adaptarlo a D7.
Y es mejorable, para no complicarme tiro de Application.ProcessMessages. Lo suyo serían Threads y Eventos.
Te añado comentarios si hay alguna parte que no entiendes pregunta, pero antes léete en los enlaces cómo funciona el proceso de autorización y obtención de token de Oauth2 😉

Código Delphi [-]
unit OAuth2Utils;

interface

uses
  Classes,
  IdHTTPServer, IdSSLOpenSSL, IdContext, IdCustomHTTPServer;

type
  TOAuth2Authorizer = class(TObject)
  protected
    fHttpServer: TIdHTTPServer; // Servidor interno dónde recibir las respuestas de la autorización
    fSslHandler: TIdServerIOHandlerSSLOpenSSL; // No olvides poner las librería OpenSSL dónde las encuentre el ejecutable
    fSslRedirect: Boolean;

    fResponseHtmlOk,
    fResponseHtmlError: string;
    fCodeResponse: string;

    fUserId,
    fAccessToken,
    fRefreshToken: string;
    fExpires: TDateTime;

    fAuthorizeEndpoint,
    fAccessTokenEndpoint,
    fClientId,
    fClientSecret,
    fScope: string;

    procedure HttpServerQuerySSLPort(APort: Word; var VUseSSL: Boolean);
    procedure HttpServerCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  private
    fState: string;

    function base64url(s: AnsiString): string;
    function GenerarCodeVerifier: string;
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;

    property SslHandler: TIdServerIOHandlerSSLOpenSSL read fSslHandler;
    property IsSslRedirect: Boolean read fSslRedirect write fSslRedirect;
    property ResponseHtmlOk: string read fResponseHtmlOk write fResponseHtmlOk;
    property ResponseHtmlError: string read fResponseHtmlError write fResponseHtmlError;

    // Valores de los token que hayas guardado, vacíos en el primer uso
    property UserId: string read fUSerId write fUserId;
    property AccessToken: string read fAccessToken write fAccessToken;
    property RefreshToken: string read fRefreshToken write fRefreshToken;
    property Expires: TDateTime read fExpires write fExpires;

    // Las direcciones y variables para obtener las autorizaciones y tokens
    property AuthorizeEndpoint: string read fAuthorizeEndpoint write fAuthorizeEndpoint;
    property AccessTokenEndpoint: string read fAccessTokenEndpoint write fAccessTokenEndpoint;
    property ClientId: string read fClientId write fClientId;
    property ClientSecret: string read fClientSecret write fClientSecret;
    property Scope: string read fScope write fScope;

    // Estas llamadas facilitan rellenar los campos anteriores según el proveedor  
    procedure SetGoogle(const ClientId: string = ''; const ClientSecret: string = '');
    procedure SetMicrosoft(const ClientId: string = ''; const ClientSecret: string = '');
    procedure SetOutlook(const ClientId: string = ''; const ClientSecret: string = '');

    procedure GetAccessToken; // con esto obtienes el token
    procedure DoRefreshToken; // con esto lo renuevas si ha caducado, GetAccessToken lo llama si es necesario
  end;

const
  SCOPE_MS_ALL    = 'https://outlook.office.com/IMAP.AccessAsUser.All https://outlook.office.com/POP.AccessAsUser.All https://outlook.office.com/SMTP.Send offline_access';
  SCOPE_MS_SEND   = 'https://outlook.office.com/SMTP.Send offline_access';
  SCOPE_LIVE_SEND = 'wl.imap wl.emails wl.offline_access';

implementation

uses
  DECFmt, DECHash, // cálculo de hash
  DBXJSON, JsonHelper, // Manejo de JSON
  IdHTTP, IdGlobal,
  SysUtils, StrUtils, ShellAPI, Forms, DateUtils,
  Varios;

{ TOAuth2Authorizer }

// un codificador en base64 especial para el code_verifier
function TOAuth2Authorizer.base64url(s: AnsiString): string;
begin
  Result := string(TFormat_MIME64.Encode(s));
  Result := ReplaceStr(Result, '=', '');
  Result := ReplaceStr(Result, '+', '-');
  Result := ReplaceStr(Result, '/', '_');
end;

constructor TOAuth2Authorizer.Create(AOwner: TComponent);
begin
  FUserId := '';
  FAccessToken := '';
  FRefreshToken := '';
  FExpires := 0;

  fSslRedirect := False;

  // montamos un servidor HTTP interno para recibir las respuestas
  fHttpServer := TIdHTTPServer.Create(nil);
  with fHttpServer.Bindings.Add do
  begin
    IP := '127.0.0.1';
    Port := 0;
    IPVersion := Id_IPv4;
  end;
//  FHttpServer.AutoStartSession := True;
//  FHttpServer.SessionState := True;
  fHttpServer.DefaultPort := 0;
  fHttpServer.OnCommandGet := HttpServerCommandGet;
  fHttpServer.OnQuerySSLPort := HttpServerQuerySSLPort;

  fSslHandler := TIdServerIOHandlerSSLOpenSSL.Create(fHttpServer);
  fHttpServer.IOHandler := fSslHandler;
  fSslHandler.SSLOptions.Mode := sslmServer;
  fSslHandler.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
  fSslHandler.SSLOptions.VerifyDepth := 0;
  fSslHandler.SSLOptions.VerifyMode := [];
end;

destructor TOAuth2Authorizer.Destroy;
begin
  fHttpServer.Free;

  inherited;
end;

procedure TOAuth2Authorizer.DoRefreshToken;
var
  HTTP: TIdHTTP;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
  Params: TStringList;
  r, s: string;

  vJson: TJSONObject;
begin
  // se prepara la llamada para renovar el token
  Params := TStringList.Create;
  HTTP := TIdHTTP.Create(nil);
  try
    SSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);

    SSL.DefaultPort := 443;
    SSL.SSLOptions.Method := sslvTLSv1_2;
    HTTP.IOHandler := SSL;

    Params.Append('grant_type=refresh_token');
    Params.Append('client_id=' + fClientId);
    if fClientSecret <> '' then
      Params.Append('client_secret=' + fClientSecret);
    Params.Append('refresh_token=' + fRefreshToken);

    HTTP.Request.Clear;
    HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
    HTTP.HTTPOptions := HTTP.HTTPOptions + [hoNoProtocolErrorException, hoWantProtocolErrorContent];

    r := HTTP.Post(fAccessTokenEndpoint, Params);
  finally
    HTTP.Free;
    Params.Free;
  end;

  // se decodifica la respuesta (JSON)
  vJson := TJSONObject(TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(StripNonJson(r)),0));
  if Assigned(vJson) then
  try
    if vJson.TryGetValue('access_token', s) then
      fAccessToken := s;

    if vJson.TryGetValue('refresh_token', s) then
      fRefreshToken := s;

    if vJson.TryGetValue('expires_in', s) then
      fExpires := Now + StrToIntDef(s, 0) * OneSecond;
  finally
    vJson.Free;
  end;
end;

// genera un code_verifier necesario en el protocolo OAuth2
function TOAuth2Authorizer.GenerarCodeVerifier: string;
var
  i: Integer;
  octec32: string[32];
begin
  SetLength(octec32, 32);

  for i := 1 to 32 do
    octec32[i] := AnsiChar(Random(255));

  Result := base64url(octec32);
end;

procedure TOAuth2Authorizer.GetAccessToken;
var
  url,
  RedirectUri,
  CodeVerifier,
  CodeChallenge: string;

  HTTP: TIdHTTP;
  HTTPSSL: TIdSSLIOHandlerSocketOpenSSL;
  Params: TStringList;
  r, s: string;

  vJson: TJSONObject;
begin
  // si hay token y no ha caducado salimos
  if fAccessToken <> '' then
  if fExpires > Now then
    Exit;
 
  // si hay RefreshToken lo renovamos y salimos
  if fRefreshToken <> '' then
  begin
    DoRefreshToken;
    Exit;
  end;

  // si llegamos aquí no tenemos token y hay que solicitarlo
  // generamos la petición según el protocolo
  CodeVerifier := GenerarCodeVerifier;
  fCodeResponse := '';

  CodeChallenge := base64url(THash_SHA256.CalcBinary(RawByteString(CodeVerifier)));
  FState := base64url(THash_SHA256.CalcBinary(RawByteString(IntToStr(Random(MaxInt)))));

  // activamos el servidor interno y preparamos la variable con la info de dónde encontrarlo
  fHttpServer.Active := True;

  RedirectUri := IfThen(fSslRedirect, 'https', 'http') + '://localhost:' + IntToStr(fHttpServer.Bindings.Items[0].Port);

  // se prepara la llamada y se manda al navegador del sistema 
  // para que le pida autorización al usuario 
  // y le envíe el resultado al servidor interno
  url := fAuthorizeEndpoint +
         '?response_type=code' +
         '&client_id=' + UrlEncode(fClientId) +
         '&scope=' + UrlEncode(fScope) +
         '&state=' + UrlEncode(FState) +
         '&redirect_uri=' + UrlEncode(RedirectUri) +
         '&code_challenge=' + UrlEncode(CodeChallenge) +
         '&code_challenge_method=S256';

  ShellExecute(0, 'open', PWideChar(url), nil, nil, 0);

  // esperamos a lo bestia que el servidor interno procese el resultado (fResponse tendrá valor)
  while fCodeResponse = '' do
    Application.ProcessMessages;

  while fHttpServer.Contexts.Count > 0 do
    Application.ProcessMessages;

  fHttpServer.Active := False;

  if not StartsText('Error', fCodeResponse) then // si no hubo error
  begin
    // tenemos un código de autorización y lo usamos para pedir el token
    Params := TStringList.Create;
    HTTP := TIdHTTP.Create(nil);
    try
      HTTPSSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
      HTTP.IOHandler := HTTPSSL;
      HTTPSSL.DefaultPort := 0;
      HTTPSSL.SSLOptions.Method := sslvTLSv1_2;

      Params.Append('grant_type=authorization_code');
      Params.Append('client_id=' + fClientId);
      if fClientSecret <> '' then
        Params.Append('client_secret=' + fClientSecret);
      Params.Append('code=' + fCodeResponse);
      Params.Append('redirect_uri=' + RedirectUri);
      Params.Append('code_verifier=' + CodeVerifier);

      HTTP.Request.Clear;
      HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
      HTTP.HTTPOptions := HTTP.HTTPOptions + [hoNoProtocolErrorException, hoWantProtocolErrorContent];

      r := HTTP.Post(fAccessTokenEndpoint, Params);
    finally
      HTTP.Free;
      Params.Free;
    end;

//      CheckJsonError(r);

    // si no hubo error en el JSON están todos los valores (tokens, id, caducidad)
    vJson := TJSONObject(TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(StripNonJson(r)),0));
    if Assigned(vJson) then
    try
      if vJson.TryGetValue('user_id', s) then
        FUserId := s;

      if vJson.TryGetValue('access_token', s) then
        FAccessToken := s;

      if vJson.TryGetValue('refresh_token', s) then
        FRefreshToken := s;

      if vJson.TryGetValue('expires_in', s) then
        FExpires := Now + StrToIntDef(s, 0) * OneSecond;
    finally
      vJson.Free;
    end;
  end;
end;

// dónde el servidor interno responde al navegador y guarda la información obtenida
procedure TOAuth2Authorizer.HttpServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  if ARequestInfo.Params.Values['state'] = fState then
  if ARequestInfo.Params.Values['code'] <> '' then
  begin
    if fResponseHtmlOk <> '' then
      AResponseInfo.ContentText := fResponseHtmlOk
    else
      AResponseInfo.ContentText := '' +
                                    '' +
                                    '' +
                                    '' +
                                    Application.Name + '
'
+ 'Autorización recibida, puede cerrar la ventana.
'
+ // '' + '' + ''; fCodeResponse := ARequestInfo.Params.Values['code']; end else begin fCodeResponse := ARequestInfo.Params.Values['error'] + #13 + ARequestInfo.Params.Values['error_description']; if fResponseHtmlError <> '' then AResponseInfo.ContentText := fResponseHtmlError else AResponseInfo.ContentText := '' + '' + '' + '' + Application.Name + '
'
+ 'Código de respuesta erróneo a la petición de autorización.
'
+ ARequestInfo.Params.Values['code'] + '
'
+ '
'
+ fCodeResponse + '' + ''; fCodeResponse := 'Error'#13 + fCodeResponse; end; end; procedure TOAuth2Authorizer.HttpServerQuerySSLPort(APort: Word; var VUseSSL: Boolean); begin VUseSSL := fSslRedirect; end; procedure TOAuth2Authorizer.SetGoogle(const ClientId, ClientSecret: string); begin fAuthorizeEndpoint := 'https://accounts.google.com/o/oauth2/auth?access_type=offline'; fAccessTokenEndpoint := 'https://accounts.google.com/o/oauth2/token'; fClientId := ClientId; fClientSecret := ClientSecret; end; procedure TOAuth2Authorizer.SetMicrosoft(const ClientId, ClientSecret: string); begin fAuthorizeEndpoint := 'https://login.microsoftonline.com/common/oauth2/v2.0/authorize'; fAccessTokenEndpoint := 'https://login.microsoftonline.com/common/oauth2/v2.0/token'; fClientId := ClientId; fClientSecret := ClientSecret; end; procedure TOAuth2Authorizer.SetOutlook(const ClientId, ClientSecret: string); begin fAuthorizeEndpoint := 'https://login.live.com/oauth20_authorize.srf'; fAccessTokenEndpoint := 'https://login.live.com/oauth20_token.srf'; fClientId := ClientId; fClientSecret := ClientSecret; end; end.

Después se usa así:

Código Delphi [-]
  oAuth2Token := TOAuth2Authorizer.Create(nil);
  try
    oAuth2Token.SetGoogle(GMAIL_CLIENT_ID, GMAIL_CLIENT_SECRET); // los datos de tu App al registrarte con Google 
    // Truco, para pruebas busca en inet los de Thunderbrid  
    oAuth2Token.Scope := SCOPE_MS_ALL;

    // se pasan los tokens guardados, cadenas vacías la primera vez
    oAuth2Token.UserId := UserId;
    oAuth2Token.RefreshToken := RefreshToken;
    oAuth2Token.AccessToken := AccessToken;
    oAuth2Token.Expires := TokenExpires;

    oAuth2Token.IsSslRedirect := False;
    oAuth2Token.GetAccessToken;

    // Se recogen los nuevos tokens (Y se guardan para el siguiente envío)
    UserId := oAuth2Token.UserId;
    RefreshToken := oAuth2Token.RefreshToken;
    AccessToken := oAuth2Token.AccessToken;
    TokenExpires := oAuth2Token.Expires;

    // y ahora envias el email con el Accesstoken como Password
  finally
    oAuth2Token.Free;
  end;

No es lo que buscabas, pero para casos extremos en aplicaciones viejas que uso y no controlo que no están adaptadas a OAuth uso una aplicación que es un proxy OAuth:
https://github.com/simonrob/email-oauth2-proxy
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Descargar Indy10 samupe Varios 5 17-06-2021 18:00:30
Autenticación OAuth 1.0 en servidor REST con Delphi XE2 adolphsys Internet 0 11-01-2018 11:48:21
TWebBrowser, OAuth y reCaptcha AgustinOrtu Internet 4 11-08-2016 20:29:49
P2P con Indy10 CarlosD18 Internet 3 30-08-2013 22:17:50
Indy10 lduron Varios 2 19-03-2009 17:56:07


La franja horaria es GMT +2. Ahora son las 16:28:11.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi