Delphi - Send email using Microsoft OAuth 2.0 (Modern Authentication) from Hotmail/Outlook 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;

program Project1;
{$APPTYPE CONSOLE}

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

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;
    CERT_SYSTEM_STORE_CURRENT_USER = 65536;
    CERT_SYSTEM_STORE_LOCAL_MACHINE = 131072;

    // 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 = 'eccbabb2-3377-4265-85c1-ea2fb515f075';
    clientSecret = 'QaR_RR:-5WqTY[nni9pdBr9xVybqrAu4';
    scope = 'https://outlook.office.com/SMTP.Send%20offline_access%20email%20openid';
    authUri = 'https://login.microsoftonline.com/common/oauth2/v2.0/authorize';
    tokenUri = 'https://login.microsoftonline.com/common/oauth2/v2.0/token';

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

procedure SendMailWithXOAUTH2(email: string; accesstoken: string);
var
    oSmtp : TMail;
begin
    oSmtp := TMail.Create(nil);
    oSmtp.LicenseCode := 'TryIt';

    // Hotmail/Outlook/Live SMTP server address
    oSmtp.ServerAddr := 'smtp.office365.com';
    // Using 587 port, you can also use 465 or 25 port
    oSmtp.ServerPort := 587;

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

    // XOAUTH 2.0 authentication
    oSmtp.AuthType := AuthXoauth2;
    // set user authentication
    oSmtp.UserName := email;
    // use access token as password
    oSmtp.Password := accesstoken;

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

    // Add recipient email address
    // Please change recipient address to yours for test
    oSmtp.AddRecipientEx('support@emailarchitect.net', 0);

    // Set email subject
    oSmtp.Subject := 'test email from Delphi project using Hotmail Oauth';

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

    writeln('start to send email using OAUTH 2.0 ...');

    if oSmtp.SendMail() = 0 then
        writeln('The email has been submitted to server successfully!')
    else
        writeln(oSmtp.GetLastErrDescription());

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 + '&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 DoOauthAndSendEmail();
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;
    authorizationRequest := authorizationRequest + '&prompt=login';

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

    SendMailWithXOAUTH2(user, accessToken);
end;

begin

    CoInitialize(nil);

    writeln('+------------------------------------------------------------------+');
    writeln('  Sign in with MS 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;

    DoOauthAndSendEmail();

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

end.