Delphi - Resource Owner Password Credentials With IMAP（OAuth2.0

（2022/06/30 新增IMAP、POP、SMTP的Client Credentials Flow！直接使用就對了！點我前往參考連接）

前面的文章我們總共試了3種流程，但是沒有一個是符合我們需求的（哭笑不得 😂）所以只好回歸老本行使用Basic Authentication了嗎？不行！因為微軟不給用啊，那就只好使出殺手鐗！使用Basic Authentication的雙胞胎兄弟之OAuth系列的ROPC（Resource Owner Password Credentials）（名字我亂取的實際上跟Basic Authentication一點關係都沒有XD），另外使用微軟的ROPC有一些限制如果不知道的可以回去看我之前寫的文章（點我前往ROPC測試授權）這裡我就不再多解釋了，直接開農程式碼！Let's GO！

元件準備

由於「TsgcHTTP_OAuth2_Client」這個元件只有提供Authorization Code Flow和Client Credentials Flow兩種流程所以跟Device Authorization Flow一樣要自己實作ROPC的完整流程，直接添加一個TButton準備起來

這裡我也寫了一個專屬ROPC Flow的Class

unit ROPCFlow;

interface

uses System.Classes, System.SysUtils, System.JSON, System.Threading, System.Net.URLClient, Winapi.ShellAPI, IdHTTP;

type
  TOnErrorAccessToken = reference to procedure(Error, ErrorDescription: string);
  TOnAfterAccessToken = reference to procedure(Access_Token, Token_Type: string; Expires_In: Integer; Scope: string);

  TROPC_Flow = class
  const
    ROPCURL = 'https://login.microsoftonline.com/%s/oauth2/v2.0/token'; // ROPC Access Token URL
    CLIENTIDSTRING = 'client_id=%s'; // ROPC Access Token post data -> client id
    CLIENTSECRETSTRING = 'client_secret=%s'; // ROPC Access Token post data -> client secret
    SCOPESTRING = 'scope=%s'; // ROPC Access Token -> scope
    USERNAMESTRING = 'username=%s'; // Device Code Token post data -> username
    PAWWORDSTRING = 'password=%s'; // Device Code Token post data -> password
    GRANTTYPESTRING = 'grant_type=password'; // Device Code Token post data -> grant type
  strict private
    FTenantID: string;
    FScope: string;
    FClientID: string;
    FClientSecret: string;
    FPassword: string;
    FUsername: string;

    FVerification_URI: string;
    FExpire_In: Integer;
    FInterval: Integer;
    IdHTTP_ROPC: TIdHTTP;
    FOnAfterAccessToken: TOnAfterAccessToken;
    FOnErrorAccessToken: TOnErrorAccessToken;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Start;
    property TenantID: string read FTenantID write FTenantID;
    property ClientID: string read FClientID write FClientID;
    property ClientSecret: string read FClientSecret write FClientSecret;
    property Scope: string read FScope write FScope;
    property Username: string read FUsername write FUsername;
    property Password: string read FPassword write FPassword;
    property OnAfterAccessToken: TOnAfterAccessToken read FOnAfterAccessToken write FOnAfterAccessToken;
    property OnErrorAccessToken: TOnErrorAccessToken read FOnErrorAccessToken write FOnErrorAccessToken;
  end;

implementation

{ TROPC_Flow }
constructor TROPC_Flow.Create;
begin
  FClientID := '';
  FClientSecret := '';
  FTenantID := '';
  FScope := '';
  FUsername := '';
  FPassword := '';
  IdHTTP_ROPC := TIdHTTP.Create(nil);
  IdHTTP_ROPC.Request.ContentEncoding := 'UTF-8';
  IdHTTP_ROPC.Request.ContentType := 'application/x-www-form-urlencoded';
end;

destructor TROPC_Flow.Destroy;
begin
  if Assigned(IdHTTP_ROPC) then FreeAndNil(IdHTTP_ROPC);
  inherited;
end;

procedure TROPC_Flow.Start;
var
  postData: TStrings;
  FResponseString: string;
  FResponseJSON: TJSONObject;
  FErrResponseJSON: TJSONObject;
begin
  if (FClientID <> '') and
     (FClientSecret <> '') and
     (FTenantID <> '') and
     (FScope <> '') and
     (FUsername <> '') and
     (FPassword <> '') then begin
    try
      try
        // Post Data
        postData := TStringList.Create;
        postData.Add(Format(CLIENTIDSTRING, [FClientID]));
        postData.Add(Format(CLIENTSECRETSTRING, [FClientSecret]));
        postData.Add(Format(SCOPESTRING, [FScope]));
        postData.Add(Format(USERNAMESTRING, [FUsername]));
        postData.Add(Format(PAWWORDSTRING, [FPassword]));
        postData.Add(GRANTTYPESTRING);
        // Call Device Auth API
        FResponseString := IdHTTP_ROPC.Post(Format(ROPCURL, [FTenantID]), postData);
        // Response JSON
        FResponseJSON := TJSONObject.ParseJSONValue(FResponseString) as TJSONObject;
        // Callback Auth Code
        if Assigned(FOnAfterAccessToken) then FOnAfterAccessToken(FResponseJSON.GetValue('access_token').AsType<string>,
                                                                  FResponseJSON.GetValue('token_type').AsType<string>,
                                                                  FResponseJSON.GetValue('expires_in').AsType<Integer>,
                                                                  FResponseJSON.GetValue('scope').AsType<string>);
      except
        on E: EIdHTTPProtocolException do begin
          // Http Error
          FErrResponseJSON := TJSONObject.ParseJSONValue(E.ErrorMessage) as TJSONObject;
          if Assigned(OnErrorAccessToken) then OnErrorAccessToken(FResponseJSON.GetValue('error').AsType<string>, FResponseJSON.GetValue('error_description').AsType<string>);
          if Assigned(FErrResponseJSON) then FreeAndNil(FErrResponseJSON);
        end;
      end;
    finally
      if Assigned(postData) then FreeAndNil(postData);
      if Assigned(FResponseJSON) then FreeAndNil(FResponseJSON);
    end;
  end else begin
    raise Exception.Create('Not set Client ID or Client Secret or Tenant ID or Scope or Username or Password');
  end;
end;
end.

在FormCreate裡面建立起ROPC的物件並且給予所需要的屬性和事件

//ROPC Flow
FROPC_Flow := TROPC_Flow.Create;
FROPC_Flow.TenantID := '你的租用戶識別碼';
FROPC_Flow.ClientID := '你的用戶識別碼';
FROPC_Flow.ClientSecret := '你的用戶識別碼密碼';
FROPC_Flow.Scope := 'https://outlook.office.com/IMAP.AccessAsUser.All';
FROPC_Flow.Username := '你的Mircosoft租用戶電子郵件帳戶名稱';
FROPC_Flow.Password := '你的Mircosoft租用戶電子郵件帳戶密碼';
FROPC_Flow.OnAfterAccessToken := procedure(Access_Token, Token_Type: string; Expires_In: Integer; Scope: string)
begin
  DoLog('AccessToken: ' + Access_Token + CRLF +
        'Token_Type: ' + Token_Type + CRLF +
        'Expires_In: ' + IntToStr(Expires_In) + CRLF +
        'Scope: ' + Scope);
  TIdSASLXOAuth(xOAuthSASL.SASL).Token := Access_Token;
  TIdSASLXOAuth(xOAuthSASL.SASL).ExpireTime := IntToStr(Expires_In);
  TIdSASLXOAuth(xOAuthSASL.SASL).User := '你要授權登入的租用戶電子郵件名稱@xxx.onmicrosoft.com'; // outlook email account
end;
FROPC_Flow.OnErrorAccessToken := procedure(Error, ErrorDescription: string)
begin
  DoLog('Error: ' + Error + CRLF +
        'Error_Description: ' + ErrorDescription);
end;

屬性

TenantID：租用戶識別碼
ClientID：用戶識別碼，直接帶入Azure AD的應用程式識別碼
ClientSecret：用戶識別碼密碼，直接帶入Azure AD的用戶識別碼密碼
Scope：請求的權限
Username：Mircosoft租用戶電子郵件帳戶名稱
Password：你的Mircosoft租用戶電子郵件帳戶密碼
💡這裡之所以用租用戶電子郵件是因為微軟的ROPC只支援租用戶端點的帳號，無法使用邀請或是個人帳號【詳細請點我參考】

事件

OnAfterAccessToken：取得Access Token的Callback

procedure(Access_Token, Token_Type: string; Expires_In: Integer; Scope: string)
begin
  DoLog('AccessToken: ' + Access_Token + CRLF +
        'Token_Type: ' + Token_Type + CRLF +
        'Expires_In: ' + IntToStr(Expires_In) + CRLF +
        'Scope: ' + Scope);
  TIdSASLXOAuth(xOAuthSASL.SASL).Token := Access_Token;
  TIdSASLXOAuth(xOAuthSASL.SASL).ExpireTime := IntToStr(Expires_In);
  TIdSASLXOAuth(xOAuthSASL.SASL).User := '你要授權登入的公用電子郵件名稱@xxx.onmicrosoft.com';
end;

OnErrorAccessToken：取得Access Token的錯誤Callback

procedure(Error, ErrorDescription: string)
begin
  DoLog('Error: ' + Error + CRLF +
        'Error_Description: ' + ErrorDescription);DoLog('Start ROPC Flow');
  FROPC_Flow.Start;
end;

最後在TButton事件裡面加入啟動流程

procedure TForm1.btn_Device_Auth_FlowClick(Sender: TObject);
begin
  DoLog('Start Device Authorization Flow');
  FDevice_Authorization_Flow.Start;
end;

執行ROPC Flow

由於ROPC的流程很簡單但因為我們的是一個服務因此就可以省略使用者輸入帳號密碼的那段流程

成功！順利連線也成功取得Mail的數量了！ROPC就這麼簡單XD！

總結

ROPC本身就是需要建立在Resource Owner和用戶端處於極高的信任狀態才適合使用的一個OAuth Flow，而我們需求是一個IMAP的服務用自己的電子郵件自動收信，而且我自己就是這個電子郵件信箱的Resource Owner所以這種情況來看其實使用ROPC也是OK拉！畢竟因為電子郵件本來就是自己的XD

程式碼下載：【Delphi-OAuth2IMAP】

Let's Coding - 開發實錄

Delphi - Resource Owner Password Credentials With IMAP（OAuth2.0 - 系列4）

元件準備

屬性

事件

執行ROPC Flow

總結

張貼者： MomoChenIsMe

0 Comments

張貼留言

聯絡表單