Показать сообщение отдельно
  #19  
Старый 08.01.2013, 16:18
Praimmax Praimmax вне форума
Прохожий
 
Регистрация: 06.01.2013
Сообщения: 26
Репутация: 10
По умолчанию

это как? общий код такой
Код:
procedure TForm3.sButton1Click(Sender: TObject);
begin
Form4.ShowModal;
end;


Код:
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.
Ответить с цитированием