Delphi - Send email using Gmail/G Suite OAuth 2.0 in background service (service account)¶

unit Unit1;

interface
// include EASendMailObjLib_TLB unit to your Delphi Project
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, EASendMailObjLib_TLB, StdCtrls;

const
    ConnectNormal = 0;
    ConnectSSLAuto = 1;
    ConnectSTARTTLS = 2;
    ConnectDirectSSL = 3;
    ConnectTryTLS = 4;

    AuthAuto = -1;
    AuthLogin = 0;
    AuthNtlm = 1;
    AuthCramMd5 = 2;
    AuthPlain = 3;
    AuthMsn = 4;
    AuthXoauth2 = 5;

    CRYPT_MACHINE_KEYSET = 32;
    CRYPT_USER_KEYSET = 4096;

function TForm1.RequestAccessToken(requestData: WideString): WideString;
var
    httpRequest: TServerXMLHTTP;
    oauthParser: TOAuthResponseParser;
    fullRequest: OleVariant;
    status: integer;
    responseText: WideString;
    accessToken: WideString;
begin
    result := '';
    httpRequest := TServerXMLHTTP.Create(Application);

    fullRequest := 'grant_type=urn%3Aietf%3Aparams%3Aoauth%3Agrant-type%3Ajwt-bearer&assertion=';
    fullRequest := fullRequest + requestData;

    httpRequest.setOption(2, 13056);
    httpRequest.open('POST', 'https://oauth2.googleapis.com/token', true);
    httpRequest.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
    httpRequest.send(fullRequest);

    while( httpRequest.readyState <> 4 ) do
    begin
        try
            httpRequest.waitForResponse(1);
            Application.ProcessMessages();
        except
            ShowMessage('Server response timeout (access token).');
            exit;
        end;
    end;

    status := httpRequest.status;
    responseText := httpRequest.responseText;

    if (status < 200) or (status >= 300) then
    begin
        ShowMessage('Failed to get access token from server.' + responseText);
        exit;
    end;

    oauthParser := TOAuthResponseParser.Create(Application);
    oauthParser.Load(responseText);

    accessToken := oauthParser.AccessToken;

    if accessToken = '' then
    begin
        ShowMessage('Failed to parse access token from server response.');
        exit;
    end;

    result := accessToken;
end;

function TForm1.GenerateRequestData(gsuiteUser: WideString): WideString;
const
    // service account email address
    serviceAccount: WideString = 'xxxx@xxxx.iam.gserviceaccount.com';
    scope: WideString = 'https://mail.google.com/';
    aud: WideString = 'https://oauth2.googleapis.com/token';
var
    jwt: TSimpleJsonParser;
    cert: TCertificate;
    pfxPath: WideString;
    header: WideString;
    playload: WideString;
    signature: WideString;
    iat, exp: integer;
begin
    result := '';

    SetThreadLocale(GetSystemDefaultLCID());

    jwt := TSimpleJsonParser.Create(application);

    header := jwt.JwtBase64UrlEncode('{"alg":"RS256","typ":"JWT"}');

    // token request timestamp
    iat := jwt.GetCurrentIAT();
    // token expiration time
    exp := iat + 3600;

    playload := '{';
    playload := playload + '"iss":"' + serviceAccount + '",';
    playload := playload + '"scope":"' + scope + '",';
    playload := playload + '"aud":"' + aud + '",';
    playload := playload + '"exp":' + IntToStr(exp) + ',';
    playload := playload + '"iat":' + IntToStr(iat) + ',';
    playload := playload + '"sub":"' + gsuiteUser + '"';
    playload := playload + '}';

    playload := jwt.JwtBase64UrlEncode(playload);

    cert := TCertificate.Create(application);

    // load service account certificate to sign request data
    pfxPath := 'D:\MyData\GSuite\outh-77aec4d192ec.p12';
    if not cert.LoadPFXFromFile(pfxPath, 'notasecret', CRYPT_USER_KEYSET) then
        begin
            ShowMessage('Failed to load certificate!');
            exit;
        end;

    signature := jwt.SignRs256(cert.DefaultInterface, header + '.' + playload);
    if signature = '' then
        begin
            ShowMessage('Failed to sign request data!');
            exit;
        end;

    result := header + '.' + playload + '.' + signature;
end;

procedure TForm1.SendEmail();
var
    oSmtp : TMail;
    gsuiteUser, accessToken: WideString;
begin
    // request access token with service account
    // gsuiteUser is the full email address of the user in GSuite, for example: user@gsuitedomain
    gsuiteUser := 'user@gsuitedomain.com'
    accessToken := RequestAccessToken(GenerateRequestData(gsuiteUser));
    if accessToken = '' then
        exit;

    oSmtp := TMail.Create(Application);
    oSmtp.LicenseCode := 'TryIt';

    // Gmail SMTP server address
    oSmtp.ServerAddr := 'smtp.gmail.com';
    oSmtp.ServerPort := 587;

    // Enable SSL/TLS connection
    oSmtp.ConnectType := ConnectSSLAuto;

    // Gmail OAUTH type
    oSmtp.AuthType := AuthXoauth2;
    oSmtp.UserName := email;
    oSmtp.Password := accessToken;

    // Set sender email address
    oSmtp.FromAddr := email;

    // Add recipient email address
    oSmtp.AddRecipientEx('support@emailarchitect.net', 0);

    // Set email subject
    oSmtp.Subject := 'simple email from Delphi project';

    // Set email body
    oSmtp.BodyText := 'this is a test email sent from Delphi project, do not reply';

    ShowMessage('start to send email ...');

    if oSmtp.SendMail() = 0 then
        ShowMessage('email was sent successfully!')
    else
        ShowMessage('failed to send email with the following error: '
        + oSmtp.GetLastErrDescription());

end;

end.