1. Set up the TclOAuth component and add a handler for the TclOAuth.OnLaunchBrowser event.
procedure TForm1.btnAuthorizeClick(Sender: TObject);
var
s: string;
begin
clOAuth1.AuthorizationEndPoint := apEnterCodeForm;
clOAuth1.AuthUrl := 'http://oauth.vk.com/authorize';
clOAuth1.TokenUrl := 'https://oauth.vk.com/access_token';
clOAuth1.RedirectUrl := 'https://oauth.vk.com/blank.html';
clOAuth1.ClientID := '123456';
clOAuth1.ClientSecret := '9T...';
clOAuth1.Scope := 'photos';
s := clOAuth1.GetAuthorization();
ShowMessage(s);
end;
procedure TForm1.clOAuth1LaunchBrowser(Sender: TObject; const AUrl: string;
var Handled: Boolean);
begin
WebBrowser1.Navigate(AUrl);
Handled := True;
end;
2. Add a handler for the TclOAuth.OnShowEnterCodeForm event. This handler should extract the authorization code from the opened TWebBrowser document.
procedure TForm1.clOAuth1ShowEnterCodeForm(Sender: TObject;
var AuthorizationCode: string; var Handled: Boolean);
var
doc: IHTMLDocument2;
path: string;
ind: Integer;
begin
repeat
WaitForWebBrowser(60000);
doc := (WebBrowser1.Document as IHTMLDocument2);
path := string(doc.url);
until (Pos('https://oauth.vk.com/blank.html', path) = 1);
path := string(doc.location.href);
ind := Pos('code=', path);
if (ind > 0) then
begin
path := Copy(path, ind + Length('code='), MaxInt);
AuthorizationCode := path;
end;
Handled := True;
end;
3. Implement the WaitForWebBrowser helper function that waits for the TWebBrowser opened the document. The WebBrowser1DocumentComplete method handles the TWebBrowser.OnDocumentComplete event.
procedure TForm1.WaitForWebBrowser(ATimeOut: Integer);
var
res, eventCount: DWORD;
Msg: TMsg;
events: array[0..0] of THandle;
begin
events[0] := FBrowserReady;
eventCount := 1;
repeat
res := MsgWaitForMultipleObjects(eventCount, events, FALSE, DWORD(ATimeOut), QS_ALLEVENTS);
if (WAIT_FAILED = res) then
begin
raise Exception.CreateFmt('Error occurred: %d', [GetLastError()]);
end;
if (WAIT_TIMEOUT = res) then
begin
raise Exception.Create('Timeout occurred');
end;
if ((WAIT_OBJECT_0 + eventCount) = res) then
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
until (WAIT_OBJECT_0 = res);
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
begin
SetEvent(FBrowserReady);
end;
Article ID: 111, Created: November 22, 2018 at 8:25 PM, Modified: March 16, 2020 at 8:14 PM