unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls;
type
TForm4 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
fUID: integer;
fToken: string;
end;
var
Form4: TForm4;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm4.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://oauth.vkontakte.ru/authorize?client_id=2750730&scope=audio,offline&display=page&response_type=token');
end;
procedure TForm4.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
sURL: String;
sToken, sUID: String;
iUID: Cardinal;
begin
sURL := URL;
delete(sURL, 1, pos('#',sURL));
sToken := sURL;
while LowerCase(copy(sToken,1,13)) <> 'access_token=' do delete(sToken,1,pos('&',sToken));
if pos('&',sToken)<>0 then sToken := copy(sToken,1,pos('&',sToken));
delete(sToken,1,13);
sUID := sURL;
while LowerCase(copy(sUID,1,8)) <> 'user_id=' do delete(sUID,1,pos('&',sUID));
if pos('&',sUID)<>0 then sUID := copy(sUID,1,pos('&',sUID));
delete(sUID,1,8);
iUID := StrToInt(sUID);
Self.fUID:=iUID;
Self.fToken:=sToken;
Form1.Close;
WebBrowser1.Hide;
Application.ProcessMessages;
end;
end.