Delphi - Retrieve email using Gmail/G Suite OAuth 2.0 + IMAP4 protocol in background service (service account)¶

// include EAGetMailObjLib_TLB unit to your Delphi Project
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, EAGetMailObjLib_TLB, StdCtrls;

program Project1;
{$APPTYPE CONSOLE}

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, ActiveX, MSXML2_TLB, EAGetMailObjLib_TLB;

const
    MailServerPop3 = 0;
    MailServerImap4 = 1;
    MailServerEWS = 2;
    MailServerDAV = 3;
    MailServerMsGraph = 4;

    // Auth type
    MailServerAuthLogin = 0;
    MailServerAuthCRAM5 = 1;
    MailServerAuthNTLM = 2;
    MailServerAuthXOAUTH2 = 3;

    CRYPT_MACHINE_KEYSET = 32;
    CRYPT_USER_KEYSET = 4096;
    CERT_SYSTEM_STORE_CURRENT_USER = 65536;
    CERT_SYSTEM_STORE_LOCAL_MACHINE = 131072;

    // GetMailInfosParam Flags
    GetMailInfos_All = 1;
    GetMailInfos_NewOnly = 2;
    GetMailInfos_ReadOnly = 4;
    GetMailInfos_SeqRange = 8;
    GetMailInfos_UIDRange = 16;
    GetMailInfos_PR_ENTRYID = 32;
    GetMailInfos_DateRange = 64;
    GetMailInfos_OrderByDateTime = 128;

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

    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);

        except
            writeln('Server response timeout (access token).');
            exit;
        end;
    end;

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

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

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

    accessToken := oauthParser.AccessToken;

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

    result := accessToken;
end;

function 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(nil);

    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(nil);

    // load service account certificate to sign request data
    pfxPath := 'D:\MyData\GSuite\outh-77aec4d192ec.p12';
    cert.LoadFromFile(pfxPath, 'notasecret', CRYPT_USER_KEYSET);

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

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

procedure RetrieveEmail();
var
    gsuiteUser, accessToken: WideString;
    oServer: TMailServer;
    oClient: TMailClient;
    oTools: TTools;
    oMail: IMail;
    infos: IMailInfoCollection;
    oInfo: IMailInfo;
    localInbox, fileName: WideString;
    i: Integer;
begin

    try
        gsuiteUser := 'user@gsuitedomain';

        // request access token with service account
        // gsuiteUser is the full email address of the user in GSuite, for example: user@gsuitedomain
        accessToken := RequestAccessToken(GenerateRequestData(gsuiteUser));
        if accessToken = '' then
            exit;

        // set current thread code page to system default code page.
        SetThreadLocale(GetSystemDefaultLCID());
        oTools := TTools.Create(nil);

        // Create a folder named "inbox" under
        // current directory to store the email files
        localInbox := GetCurrentDir() + '\inbox';
        oTools.CreateFolder(localInbox);

        oServer := TMailServer.Create(nil);
        // Gmail IMAP Server
        oServer.Server := 'imap.gmail.com';
        // Use OAUTH 2.0
        oServer.AuthType := MailServerAuthXOAUTH2;

        oServer.User := gsuiteUser;
        // Use access token as password
        oServer.Password := accesstoken;
        // Use IMAP Protocol
        oServer.Protocol := MailServerImap4;

        // Enable SSL Connection
        oServer.SSLConnection := true;
        // Set IMAP SSL Port
        oServer.Port := 993;

        oClient := TMailClient.Create(nil);
        oClient.LicenseCode := 'TryIt';

        writeln('Connecting ' + oServer.Server + ' ...');
        oClient.Connect1(oServer.DefaultInterface);
        writeln('Connected!');

        // Get new email only, if you want to get all emails, please remove this line
        oClient.GetMailInfosParam.GetMailInfosOptions := GetMailInfos_NewOnly;

        infos := oClient.GetMailInfoList();
        writeln(Format('Total %d email(s)', [infos.Count]));

        for i := 0 to infos.Count - 1 do
        begin
            oInfo := infos.Item[i];

            writeln(Format('Index: %d; Size: %d; UIDL: ' + oInfo.UIDL,
            [oInfo.Index, oInfo.Size]));

            // Generate a random file name by current local datetime,
            // You can use your method to generate the filename if you do not like it
            fileName := localInbox + '\' + oTools.GenFileName(i) + '.eml';

            // Receive email from IMAP server
            oMail := oClient.GetMail(oInfo);

            writeln('From: ' + oMail.From.Address + #13#10 +
                'Subject: ' + oMail.Subject);

            // Save email to local disk
            oMail.SaveAs(fileName, true);

            // Mark email as read to prevent retrieving this email again.
            oClient.MarkAsRead(oInfo, true);

            // If you want to delete current email, please use Delete method instead of MarkAsRead
            // oClient.Delete(oInfo);
        end;

        // Quit and expunge emails marked as deleted from IMAP server
        oClient.Quit;
    except
        on ep:Exception do
            writeln('Error: ' + ep.Message);
        end;

end;

begin

    CoInitialize(nil);

    writeln('+------------------------------------------------------------------+');
    writeln('  Sign in with Google OAuth');
    writeln('   If you got "This app is not verified" information in Web Browser, ');
    writeln('      click "Advanced" -> Go to ... to continue test.');
    writeln('+------------------------------------------------------------------+');
    writeln('');

    writeln('Press ENTER key to sign in...');
    readln;

    RetrieveEmail();

    writeln('Press ENTER key to quit...');
    readln;

end.