mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-16 16:25:57 +01:00
1299a6f596
- Split the Lazarus demos directory into "Lazarus_Windows" and "Lazarus_Linux". - Added OSRExternalPumpBrowser and TinyBrowser2 demos to "Lazarus_Linux". - Set TBufferPanel.GetScreenScale as virtual. - Added DevTools to the SchemeRegistrationBrowser demo. - Modified the SchemeRegistrationBrowser demo to receive XMLHttpRequest requests from JavaScript.
603 lines
20 KiB
ObjectPascal
603 lines
20 KiB
ObjectPascal
// ************************************************************************
|
|
// ***************************** CEF4Delphi *******************************
|
|
// ************************************************************************
|
|
//
|
|
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
|
|
// browser in Delphi applications.
|
|
//
|
|
// The original license of DCEF3 still applies to CEF4Delphi.
|
|
//
|
|
// For more information about CEF4Delphi visit :
|
|
// https://www.briskbard.com/index.php?lang=en&pageid=cef
|
|
//
|
|
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
|
|
//
|
|
// ************************************************************************
|
|
// ************ vvvv Original license and comments below vvvv *************
|
|
// ************************************************************************
|
|
(*
|
|
* Delphi Chromium Embedded 3
|
|
*
|
|
* Usage allowed under the restrictions of the Lesser GNU General Public License
|
|
* or alternatively the restrictions of the Mozilla Public License 1.1
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
* the specific language governing rights and limitations under the License.
|
|
*
|
|
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
|
|
* Web site : http://www.progdigy.com
|
|
* Repository : http://code.google.com/p/delphichromiumembedded/
|
|
* Group : http://groups.google.com/group/delphichromiumembedded
|
|
*
|
|
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
|
* this source code without explicit permission.
|
|
*
|
|
*)
|
|
|
|
unit uOAuth2TesterFrm;
|
|
|
|
{$MODE Delphi}
|
|
|
|
{$I cef.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF DELPHI16_UP}
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, WinApi.ShellApi,
|
|
{$ELSE}
|
|
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics,
|
|
Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
|
|
{$ENDIF}
|
|
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes,
|
|
uCEFWinControl, uCEFSentinel, uCEFChromiumCore, uCEFServerComponent,
|
|
uCEFUrlRequestClientComponent, uCEFRequest, uCEFUrlRequest, uCEFOAuth2Helper;
|
|
|
|
|
|
const
|
|
URLREQUEST_SUCCESS = WM_APP + $101;
|
|
URLREQUEST_ERROR = WM_APP + $102;
|
|
AUTHCODE_ERROR = WM_APP + $103;
|
|
|
|
type
|
|
TOAuthTesterStatus = (tsIdle, tsLogin, tsRefresh, tsRequest);
|
|
|
|
TOAuth2TesterFrm = class(TForm)
|
|
CEFServerComponent1: TCEFServerComponent;
|
|
CEFUrlRequestClientComponent1: TCEFUrlRequestClientComponent;
|
|
LoginGrp: TGroupBox;
|
|
ClientIDEdt: TEdit;
|
|
ClientIDLbl: TLabel;
|
|
ClientSecretLbl: TLabel;
|
|
ClientSecretEdt: TEdit;
|
|
ScopeLbl: TLabel;
|
|
ScopeEdt: TEdit;
|
|
AccessTokenLbl: TLabel;
|
|
AccessTokenEdt: TEdit;
|
|
RefreshTokenLbl: TLabel;
|
|
RefreshTokenEdt: TEdit;
|
|
LoginBtn: TButton;
|
|
RefreshBtn: TButton;
|
|
LogGrp: TGroupBox;
|
|
LogMem: TMemo;
|
|
ApiPnl: TPanel;
|
|
ApiGrp: TGroupBox;
|
|
EndpointLbl: TLabel;
|
|
EndpointEdt: TEdit;
|
|
RequestBtn: TButton;
|
|
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
|
|
procedure LoginBtnClick(Sender: TObject);
|
|
procedure RefreshBtnClick(Sender: TObject);
|
|
procedure RequestBtnClick(Sender: TObject);
|
|
|
|
procedure CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
|
|
procedure CEFUrlRequestClientComponent1DownloadData(Sender: TObject; const request: ICefUrlRequest; data: Pointer; dataLength: NativeUInt);
|
|
procedure CEFUrlRequestClientComponent1DownloadProgress( Sender: TObject; const request: ICefUrlRequest; current, total: Int64);
|
|
procedure CEFUrlRequestClientComponent1RequestComplete(Sender: TObject; const request: ICefUrlRequest);
|
|
|
|
procedure CEFServerComponent1HttpRequest(Sender: TObject; const server: ICefServer; connection_id: Integer; const client_address: ustring; const request: ICefRequest);
|
|
procedure CEFServerComponent1ServerDestroyed(Sender: TObject; const server: ICefServer);
|
|
|
|
protected
|
|
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
|
|
FClosing : boolean; // Set to True in the CloseQuery event.
|
|
|
|
FMemStream : TMemoryStream;
|
|
FBusy : boolean;
|
|
FOAuthHelper : TCEFOAuth2Helper;
|
|
FStatus : TOAuthTesterStatus;
|
|
|
|
procedure CreateLoginRequest;
|
|
procedure CreateTokenRefreshRequest;
|
|
procedure CreateAPIRequest;
|
|
procedure AppendAuthorizationHeader(const aRequest : ICefRequest);
|
|
|
|
procedure URLRequestSuccessMsg(var aMessage : TMessage); message URLREQUEST_SUCCESS;
|
|
procedure URLRequestErrorMsg(var aMessage : TMessage); message URLREQUEST_ERROR;
|
|
procedure AuthCodeErrorMsg(var aMessage : TMessage); message AUTHCODE_ERROR;
|
|
end;
|
|
|
|
var
|
|
OAuth2TesterFrm: TOAuth2TesterFrm;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
// This demo shows how to authenticate users using OAuth 2.0 and how
|
|
// to make requests to REST APIs that requiere authenticated users.
|
|
|
|
// Before you begin, please read the code comments in the URLRequest and SimpleServer
|
|
// demos because this demo uses the TCEFUrlRequestClientComponent and TCEFServerComponent
|
|
// components too.
|
|
|
|
// This demo was tested with the Google API only. If you need to access other REST APIs you
|
|
// may need to override some TCEFOAuth2Helper functions to send the right URL parameters.
|
|
|
|
// This is an alternative to the "REST Client Library" found in the
|
|
// latest Delphi but this time using CEF classes and functions like
|
|
// TCEFUrlRequestClientComponent, TCEFServerComponent, etc.
|
|
|
|
// As you can see in the REFERENCES, you need to follow a few steps
|
|
// to implement OAuth 2.0 in windows applications.
|
|
|
|
// STEP 1 :
|
|
// ========
|
|
// Obtain OAuth 2.0 client credentials from the API server.
|
|
|
|
// In this case, open the Google API Console at https://console.developers.google.com/
|
|
// and go to the "Credentials" page at https://console.developers.google.com/apis/credentials
|
|
// Then click "Create credentials -> OAuth client ID" and select "other" to create
|
|
// credentials for "native" applications.
|
|
|
|
// When it finishes you will see a "Client ID" and a "Client Secret" that you will need
|
|
// to run this demo.
|
|
|
|
// STEP 2 :
|
|
// ========
|
|
// Run this demo and fill the "Client ID" and "Client Secret" edit boxes with the credentials
|
|
// you got from Google.
|
|
|
|
// STEP 3 :
|
|
// ========
|
|
// Click on the "User login" button to launch the system browser and login to google with
|
|
// another user account. The URL in that login page was created by TCEFOAuth2Helper and it
|
|
// includes the credentials and other safety parameters.
|
|
|
|
// Once the user authenticated and he/she has granted permissions the browser will be
|
|
// redirected to a local URL served by TCEFServerComponent but Google has added some
|
|
// parameters to the redirected URL that will be used in later steps.
|
|
|
|
// STEP 4 :
|
|
// ========
|
|
// This demo uses TCEFOAuth2Helper to parse the parameters in the redirected URL which includes an
|
|
// "authentication code" and then it uses TCEFUrlRequestClientComponent to send a POST request
|
|
// to exchange that "authentication code" for an "access token".
|
|
|
|
// STEP 5 :
|
|
// ========
|
|
// TCEFUrlRequestClientComponent receives the "access token" and a "refresh token" that we'll use to
|
|
// request whatever we need to the REST API.
|
|
|
|
// STEP 6 :
|
|
// ========
|
|
// Click on the "Request" button to request some user information to the REST API using a
|
|
// GET request with TCEFUrlRequestClientComponent. This request includes the "access token" in the
|
|
// "Authorization" HTTP header.
|
|
|
|
// STEP 7 :
|
|
// ========
|
|
// The "access token" is only valid for some time and we'll need to click the "Request new token"
|
|
// button to receive a new token when it expires. This function uses TCEFOAuth2Helper and
|
|
// TCEFUrlRequestClientComponent to generate the parameters in a POST request needed to
|
|
// refresh the token.
|
|
|
|
// Read the TCEFOAuth2Helper.TokenExpiry property to know the amount of seconds that the
|
|
// "access token" will be valid.
|
|
|
|
// Destruction steps
|
|
// =================
|
|
// 1- Set CanClose to FALSE in the TForm.OnCloseQuery event, set FClosing to TRUE and call TCEFServerComponent.shutdown.
|
|
// 2- If there are pending URLRequests and the TCEFUrlRequestClientComponent.OnDownloadProgress
|
|
// event is executed then call request.Cancel, which triggers the TCEFUrlRequestClientComponent.OnRequestComplete event.
|
|
// 3- In the TCEFUrlRequestClientComponent.OnRequestComplete event set FCanClose := True and send WM_CLOSE to the form.
|
|
// 4- If the TCEFServerComponent was initialized it will trigger TCEFServerComponent.OnServerDestroyed that sets
|
|
// FCanClose := True and sends WM_CLOSE to the form.
|
|
|
|
|
|
// REFERENCES :
|
|
// ============
|
|
// https://tools.ietf.org/html/rfc6749
|
|
// https://tools.ietf.org/html/rfc6750
|
|
// https://tools.ietf.org/html/rfc8252
|
|
// https://tools.ietf.org/html/rfc6819
|
|
// https://tools.ietf.org/html/rfc7636
|
|
// https://tools.ietf.org/html/draft-ietf-oauth-native-apps-12
|
|
// https://tools.ietf.org/html/draft-ietf-oauth-security-topics-13
|
|
// https://developers.google.com/identity/protocols/OAuth2
|
|
// https://developers.google.com/identity/protocols/OAuth2InstalledApp
|
|
// https://developers.google.com/identity/protocols/googlescopes
|
|
// https://developers.google.com/identity/protocols/OpenIDConnect
|
|
// https://aaronparecki.com/oauth-2-simplified/
|
|
// https://example-app.com/pkce
|
|
|
|
uses
|
|
uCEFApplication, uCEFMiscFunctions, uCEFPostData, uCEFPostDataElement, uCEFStringMultimap;
|
|
|
|
procedure TOAuth2TesterFrm.CEFServerComponent1HttpRequest(Sender: TObject;
|
|
const server: ICefServer; connection_id: Integer;
|
|
const client_address: ustring; const request: ICefRequest);
|
|
var
|
|
TempData : string;
|
|
begin
|
|
TempData := '<html><head><title>User authentication successfull</title></head>' +
|
|
'<body><p>User authentication successfull.</p><p>You can close this window now.</p></body></html>';
|
|
|
|
CEFServerComponent1.SendHttp200response(connection_id, 'text/html', @TempData[1], length(TempData) * SizeOf(char));
|
|
|
|
if (request <> nil) then
|
|
begin
|
|
if FOAuthHelper.ParseCodeRequestResponse(request.url) then
|
|
CEFUrlRequestClientComponent1.AddURLRequest
|
|
else
|
|
PostMessage(Handle, AUTHCODE_ERROR, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CEFServerComponent1ServerDestroyed(Sender: TObject; const server: ICefServer);
|
|
begin
|
|
if FClosing then
|
|
begin
|
|
FCanClose := True;
|
|
PostMessage(Handle, WM_CLOSE, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1DownloadData(
|
|
Sender: TObject; const request: ICefUrlRequest; data: Pointer;
|
|
dataLength: NativeUInt);
|
|
begin
|
|
try
|
|
if FClosing then
|
|
request.Cancel
|
|
else
|
|
if (data <> nil) and (dataLength > 0) then
|
|
FMemStream.WriteBuffer(data^, dataLength);
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('TOAuth2BrowserFrm.CEFUrlRequestClientComponent1DownloadData', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1DownloadProgress(
|
|
Sender: TObject; const request: ICefUrlRequest; current, total: Int64);
|
|
begin
|
|
if FClosing then request.Cancel;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1RequestComplete(
|
|
Sender: TObject; const request: ICefUrlRequest);
|
|
begin
|
|
FBusy := False;
|
|
|
|
if FClosing then
|
|
begin
|
|
FCanClose := True;
|
|
PostMessage(Handle, WM_CLOSE, 0, 0);
|
|
end
|
|
else
|
|
if (request <> nil) then
|
|
begin
|
|
if (request.response <> nil) and
|
|
(request.RequestStatus = UR_SUCCESS) and
|
|
(pos('application/json', request.response.MimeType) > 0) then
|
|
PostMessage(Handle, URLREQUEST_SUCCESS, 0, 0)
|
|
else
|
|
PostMessage(Handle, URLREQUEST_ERROR, 0, request.RequestError);
|
|
end
|
|
else
|
|
PostMessage(Handle, URLREQUEST_ERROR, 0, 0);
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
|
|
begin
|
|
case FStatus of
|
|
tsLogin : CreateLoginRequest;
|
|
tsRefresh : CreateTokenRefreshRequest;
|
|
tsRequest : CreateAPIRequest;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CreateLoginRequest;
|
|
var
|
|
TempRequest : ICefRequest;
|
|
TempPostData : ICefPostData;
|
|
TempElement : ICefPostDataElement;
|
|
TempElementData : AnsiString;
|
|
begin
|
|
try
|
|
FBusy := True;
|
|
TempRequest := TCefRequestRef.New;
|
|
TempRequest.URL := FOAuthHelper.TokenEndpoint;
|
|
TempRequest.Method := 'POST';
|
|
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
|
|
TempElementData := AnsiString(FOAuthHelper.TokeExchangeParams);
|
|
|
|
TempElement := TCefPostDataElementRef.New;
|
|
TempElement.SetToBytes(length(TempElementData), @TempElementData[1]);
|
|
|
|
TempPostData := TCefPostDataRef.New;
|
|
TempPostData.AddElement(TempElement);
|
|
|
|
TempRequest.PostData := TempPostData;
|
|
|
|
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
|
|
finally
|
|
TempElement := nil;
|
|
TempPostData := nil;
|
|
TempRequest := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CreateTokenRefreshRequest;
|
|
var
|
|
TempRequest : ICefRequest;
|
|
TempPostData : ICefPostData;
|
|
TempElement : ICefPostDataElement;
|
|
TempElementData : AnsiString;
|
|
begin
|
|
try
|
|
FBusy := True;
|
|
TempRequest := TCefRequestRef.New;
|
|
TempRequest.URL := FOAuthHelper.TokenEndpoint;
|
|
TempRequest.Method := 'POST';
|
|
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
|
|
TempElementData := AnsiString(FOAuthHelper.RefreshParams);
|
|
|
|
TempElement := TCefPostDataElementRef.New;
|
|
TempElement.SetToBytes(length(TempElementData), @TempElementData[1]);
|
|
|
|
TempPostData := TCefPostDataRef.New;
|
|
TempPostData.AddElement(TempElement);
|
|
|
|
TempRequest.PostData := TempPostData;
|
|
|
|
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
|
|
finally
|
|
TempElement := nil;
|
|
TempPostData := nil;
|
|
TempRequest := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.CreateAPIRequest;
|
|
var
|
|
TempRequest : ICefRequest;
|
|
begin
|
|
try
|
|
FBusy := True;
|
|
TempRequest := TCefRequestRef.New;
|
|
TempRequest.URL := EndpointEdt.Text;
|
|
TempRequest.Method := 'GET';
|
|
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
|
|
|
|
AppendAuthorizationHeader(TempRequest);
|
|
|
|
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
|
|
finally
|
|
TempRequest := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.AppendAuthorizationHeader(const aRequest : ICefRequest);
|
|
var
|
|
TempOldMap, TempNewMap : ICefStringMultimap;
|
|
i : NativeUInt;
|
|
begin
|
|
try
|
|
TempNewMap := TCefStringMultimapOwn.Create;
|
|
TempOldMap := TCefStringMultimapOwn.Create;
|
|
|
|
aRequest.GetHeaderMap(TempOldMap);
|
|
|
|
i := 0;
|
|
while (i < TempOldMap.Size) do
|
|
begin
|
|
TempNewMap.Append(TempOldMap.Key[i], TempOldMap.Value[i]);
|
|
inc(i);
|
|
end;
|
|
|
|
TempNewMap.Append('Authorization', FOAuthHelper.TokenType + ' ' + FOAuthHelper.AccessToken);
|
|
|
|
aRequest.SetHeaderMap(TempNewMap);
|
|
finally
|
|
TempNewMap := nil;
|
|
TempOldMap := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
CanClose := FCanClose and not(FBusy) and not(CEFServerComponent1.Initialized);
|
|
|
|
if not(FClosing) then
|
|
begin
|
|
FClosing := True;
|
|
Visible := False;
|
|
|
|
if CEFServerComponent1.Initialized then CEFServerComponent1.Shutdown;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.FormCreate(Sender: TObject);
|
|
begin
|
|
FMemStream := TMemoryStream.Create;
|
|
FCanClose := False;
|
|
FClosing := False;
|
|
FBusy := False;
|
|
FStatus := tsIdle;
|
|
|
|
FOAuthHelper := TCEFOAuth2Helper.Create;
|
|
FOAuthHelper.ChallengeMethod := cmSHA256;
|
|
|
|
CEFServerComponent1.CreateServer(FOAuthHelper.RedirectHost, FOAuthHelper.RedirectPort, 10);
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.FormDestroy(Sender: TObject);
|
|
begin
|
|
if (FMemStream <> nil) then FreeAndNil(FMemStream);
|
|
if (FOAuthHelper <> nil) then FreeAndNil(FOAuthHelper);
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.LoginBtnClick(Sender: TObject);
|
|
var
|
|
TempAuthURI : string;
|
|
begin
|
|
if (FStatus <> tsIdle) or
|
|
(length(ClientIDEdt.Text) = 0) or
|
|
(length(ClientSecretEdt.Text) = 0) or
|
|
(length(ScopeEdt.Text) = 0) then
|
|
exit;
|
|
|
|
FStatus := tsLogin;
|
|
screen.cursor := crAppStart;
|
|
|
|
FOAuthHelper.ClientID := ClientIDEdt.Text;
|
|
FOAuthHelper.ClientSecret := ClientSecretEdt.Text;
|
|
FOAuthHelper.Scope := ScopeEdt.Text;
|
|
TempAuthURI := FOAuthHelper.AuthCodeURI;
|
|
|
|
LogMem.Lines.Add('-----------------------------------------------------------------');
|
|
LogMem.Lines.Add('Opening authorization request in the system browser : ' + TempAuthURI);
|
|
|
|
OpenURL(TempAuthURI);
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.RefreshBtnClick(Sender: TObject);
|
|
begin
|
|
if (FStatus <> tsIdle) or
|
|
(length(ClientIDEdt.Text) = 0) or
|
|
(length(ClientSecretEdt.Text) = 0) or
|
|
(length(ScopeEdt.Text) = 0) or
|
|
(length(RefreshTokenEdt.Text) = 0) then
|
|
exit;
|
|
|
|
FStatus := tsRefresh;
|
|
screen.cursor := crAppStart;
|
|
|
|
LogMem.Lines.Add('-----------------------------------------------------------------');
|
|
LogMem.Lines.Add('Requesting a new token.');
|
|
|
|
CEFUrlRequestClientComponent1.AddURLRequest;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.RequestBtnClick(Sender: TObject);
|
|
begin
|
|
if (FStatus <> tsIdle) or
|
|
(length(ClientIDEdt.Text) = 0) or
|
|
(length(ClientSecretEdt.Text) = 0) or
|
|
(length(ScopeEdt.Text) = 0) or
|
|
(length(EndpointEdt.Text) = 0) then
|
|
exit;
|
|
|
|
FStatus := tsRequest;
|
|
screen.cursor := crAppStart;
|
|
|
|
LogMem.Lines.Add('-----------------------------------------------------------------');
|
|
LogMem.Lines.Add('Requesting information to the API endpoint.');
|
|
|
|
CEFUrlRequestClientComponent1.AddURLRequest;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.URLRequestSuccessMsg(var aMessage : TMessage);
|
|
var
|
|
TempRawResponse : AnsiString;
|
|
TempResponse : ustring;
|
|
begin
|
|
if (FMemStream = nil) or (FMemStream.Size = 0) then exit;
|
|
|
|
try
|
|
FMemStream.position := 0;
|
|
SetLength(TempRawResponse, FMemStream.Size);
|
|
|
|
if (FMemStream.Read(TempRawResponse[1], FMemStream.Size) > 0) then
|
|
begin
|
|
TempResponse := UTF8Decode(TempRawResponse);
|
|
|
|
case FStatus of
|
|
tsLogin :
|
|
begin
|
|
LogMem.Lines.Add('Token exchange response : ' + TempResponse);
|
|
|
|
if FOAuthHelper.ParseTokenExchangeResponse(TempResponse) then
|
|
begin
|
|
AccessTokenEdt.Text := FOAuthHelper.AccessToken;
|
|
RefreshTokenEdt.Text := FOAuthHelper.RefreshToken;
|
|
end
|
|
else
|
|
begin
|
|
AccessTokenEdt.Text := '';
|
|
RefreshTokenEdt.Text := '';
|
|
|
|
showmessage('Login error : ' + FOAuthHelper.Error + #13 + #10 + FOAuthHelper.ErrorDescription);
|
|
end;
|
|
end;
|
|
|
|
tsRefresh :
|
|
begin
|
|
LogMem.Lines.Add('Token refresh response : ' + TempResponse);
|
|
|
|
if FOAuthHelper.ParseRefreshTokenResponse(TempResponse) then
|
|
AccessTokenEdt.Text := FOAuthHelper.AccessToken
|
|
else
|
|
showmessage('Token refresh error : ' + FOAuthHelper.Error + #13 + #10 + FOAuthHelper.ErrorDescription);
|
|
end;
|
|
|
|
tsRequest :
|
|
LogMem.Lines.Add('API request response : ' + TempResponse);
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
FMemStream.Clear;
|
|
FStatus := tsIdle;
|
|
screen.cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.URLRequestErrorMsg(var aMessage : TMessage);
|
|
begin
|
|
case FStatus of
|
|
tsLogin : showmessage('Login error code : ' + inttostr(aMessage.lParam));
|
|
tsRefresh : showmessage('Token refresh error code : ' + inttostr(aMessage.lParam));
|
|
tsRequest : showmessage('API request error code : ' + inttostr(aMessage.lParam));
|
|
end;
|
|
|
|
FMemStream.Clear;
|
|
FStatus := tsIdle;
|
|
screen.cursor := crDefault;
|
|
end;
|
|
|
|
procedure TOAuth2TesterFrm.AuthCodeErrorMsg(var aMessage : TMessage);
|
|
var
|
|
TempMessage : string;
|
|
begin
|
|
TempMessage := 'Authentication error' + #13 + #10;
|
|
|
|
if not(FOAuthHelper.ValidState) then
|
|
TempMessage := TempMessage + #13 + #10 + 'Received request with invalid state';
|
|
|
|
if (length(FOAuthHelper.Error) > 0) then
|
|
TempMessage := TempMessage + #13 + #10 + FOAuthHelper.Error + #13 + #10 + FOAuthHelper.ErrorDescription;
|
|
|
|
showmessage(TempMessage);
|
|
end;
|
|
|
|
end.
|