Delphi - Retrieve email using Google/Gmail OAuth 2.0 authentication + IMAP protocol¶

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

// client configuration
// You should create your client id and client secret,
// do not use the following client id in production environment, it is used for test purpose only.
clientID = '570831866161-ha6qpdnke22f7mhf0d50ui22f427drjt.apps.googleusercontent.com';
clientSecret = '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';
scope = 'openid%20profile%20email%20https://mail.google.com';
authUri = 'https://accounts.google.com/o/oauth2/v2/auth';
tokenUri = 'https://www.googleapis.com/oauth2/v4/token';

function GetConsoleWindow: HWND; stdcall;
    external kernel32 name 'GetConsoleWindow';

procedure RetrieveEmailWithXOAUTH2(email: string; accesstoken: string);
var
    oServer: TMailServer;
    oClient: TMailClient;
    oTools: TTools;
    oMail: IMail;
    infos: IMailInfoCollection;
    oInfo: IMailInfo;
    localInbox, fileName: WideString;
    i: Integer;
begin
    try
        // 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 := email;
        // 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;

// path?parameter1=value1&parameter2=value2#anchor;
function ParseParameter(URL: string; ParameterName: string):string;
var
    query, parameter, code: string;
    i, mypos, parameterNameLength: integer;
    list: TStrings;
begin
    result := '';
    parameterNameLength := Length(ParameterName);
    query := URL;
    mypos := pos('?', query);

    if(mypos > 0) then
        query := Copy(query, mypos + 1, length(query) - mypos);

    list := TStringList.Create;
    ExtractStrings(['&'], [], PChar(query), list);
    for i:= 0 to list.Count - 1 do
    begin
        parameter := list[i];
        if (length(parameter) > parameterNameLength) and
            (LowerCase(Copy(parameter, 1, parameterNameLength)) = ParameterName) then
        begin
            code := Copy(parameter, parameterNameLength + 1, length(parameter) - parameterNameLength);
            mypos := pos('#', code);
            if(mypos > 0) then
                code := Copy(code, 1, mypos - 1);

            result := code;
            exit;
        end
    end;

end;

function RequestAccessToken(code: string; redirectUri: string): string;
var
    httpRequest: TServerXMLHTTP60;
    tokenRequestBody: OleVariant;
    status: integer;
begin
    writeln('Exchanging code for tokens...');
    result := '';

    try
        httpRequest := TServerXMLHTTP60.Create(nil);
        if (httpRequest = nil) then
        begin
            writeln('Failed to create XML HTTP Object, please make sure you install MSXML 3.0 on your machine.');
            exit;
        end;

        tokenRequestBody := 'code=';
        tokenRequestBody := tokenRequestBody + code;
        tokenRequestBody := tokenRequestBody + '&redirect_uri=';
        tokenRequestBody := tokenRequestBody + redirectUri;
        tokenRequestBody := tokenRequestBody + '&client_id=';
        tokenRequestBody := tokenRequestBody + clientID;
        tokenRequestBody := tokenRequestBody + '&client_secret=';
        tokenRequestBody := tokenRequestBody + clientSecret;
        tokenRequestBody := tokenRequestBody + '&grant_type=authorization_code';

        httpRequest.setOption(2, 13056);
        httpRequest.open('POST', tokenUri, true);
        httpRequest.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
        httpRequest.send(tokenRequestBody);

        while( httpRequest.readyState <> 4 ) do
            httpRequest.waitForResponse(1);

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

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

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

end;

procedure DoOauthAndRetrieveEmail();
var
    httpListener: THttpListener;
    browserUi: TBrowserUi;
    parser: TOAuthResponseParser;
    szUri, requestUri: string;
    authorizationRequest: string;
    error, code: string;
    responseText: string;
    user, accessToken: string;
begin

    httpListener := THttpListener.Create(nil);

    // Creates a redirect URI using an available port on the loopback address.
    if (not httpListener.Create1('127.0.0.1', 0)) then
    begin
        writeln('Failed to listen on ' + httpListener.GetLastError());
        exit;
    end;

    szUri := Format('http://127.0.0.1:%d', [httpListener.ListenPort]);
    writeln('listen on ' + szUri + ' ...');

    // Creates the OAuth 2.0 authorization request.
    authorizationRequest := authUri;
    authorizationRequest := authorizationRequest + '?response_type=code&scope=';
    authorizationRequest := authorizationRequest + scope;
    authorizationRequest := authorizationRequest + '&redirect_uri=';
    authorizationRequest := authorizationRequest + szUri;
    authorizationRequest := authorizationRequest + '&client_id=';
    authorizationRequest := authorizationRequest + clientID;

    writeln('open ' + authorizationRequest + ' ...');

    // Opens request in the browser.
    browserUi := TBrowserUi.Create(nil);
    browserUi.OpenUrl(authorizationRequest);

    // Waits for the OAuth authorization response.
    if not (httpListener.GetRequestUrl(-1)) then
    begin
        writeln('Failed to get authorization response ' + httpListener.GetLastError());
        exit;
    end;

    // Brings the Console to Focus.
    SetForegroundWindow(GetConsoleWindow());

    // Send response and stop http listener.
    httpListener.SendResponse('200',
        'text/html; charset=utf-8',
        '<html><head></head><body>Please return to the app and close current window.</body></html>');
    httpListener.Close();

    requestUri := httpListener.RequestUrl;
    writeln('RequestUri: ' + requestUri);

    // Checks for errors.
    error := ParseParameter(requestUri, 'error=');
    if (error <> '') then
    begin
        writeln('OAuth authorization error: ' + error);
        exit;
    end;

    // Check authorization code
    code := ParseParameter(requestUri, 'code=');
    if (code = '') then
    begin
        writeln('Malformed authorization response: ' + requestUri);
        exit;
    end;

    writeln;
    writeln('Authorization code: ' + code);

    responseText := RequestAccessToken(code, szUri);
    writeln(responseText);

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

    user := parser.EmailInIdToken;
    accessToken := parser.AccessToken;

    if (accessToken = '') then
    begin
        writeln('Failed to request access token, return!');
        exit;
    end;

    writeln('User: ' + user);
    writeln('AccessToken:' + accessToken);

    RetrieveEmailWithXOAUTH2(user, accessToken);
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;

    DoOauthAndRetrieveEmail();

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

end.