VK Authorization, getting the OAUTH code in Delphi App using TWebBrowser

Applies to Clever Internet Suite 9.2

 

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;