[Praimmax]

все залагало ужас кнопки не работают.
в public добавил

Код:

fUID: integer;
fToken: string;

и код этот добавил и все лагает

[Praimmax]

я новичек,сильно не ругайте. Просто доступно объясните что не так и где читать что делать,а не просто ссылку кидать.

[PhoeniX]

Ммм... Причину лагов понять сложно. Попробуй пройтись отладчиком по коду.

[Praimmax]

это как? общий код такой

Код:

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.

[Praimmax]

помогите...

[Praimmax]

Код:

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;

Если использовать только это как мне дальше вытягивать например имя аккаунта его друзей и т.д

[PhoeniX]

Никак. По завершении авторизации браузер переадресуется на страницу, из адреса которой надо вытянуть токен, и использовать его во всех запросах.
Ещё раз - читаем документацию. Конкретно:
Авторизация клиентских приложений
Выполнение запросов к API
Ну и приложение надо создать своё, естественно, с моим ничего не выйдет, т.к. оно давно удалено

[Praimmax]

А что нужно делать с приложением?что там нужно создавать?

[Praimmax]

Есть такой код
Как мне из него вырезать авторизацию

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP,md5, ExtCtrls, mmsystem, ImgList,  CoolTrayIcon, WinInet, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, ShellAPI, Menus;
Const
Secret='C4iUv105ci';
App_id='633984';

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    Edit1: TEdit;
    Label3: TLabel;
    Label5: TLabel;
    ImageList1: TImageList;
    CoolTrayIcon1: TCoolTrayIcon;
    Timer2: TTimer;
    CheckBox1: TCheckBox;
    Edit2: TEdit;
    Label6: TLabel;
    MainMenu1: TMainMenu;
    Help1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);
    procedure TrayIcon1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);


  private
    { Private declarations }
  public
  Procedure SetViewer_id;
    var
    sid:string;
  end;

var
  Form1: TForm1;
  User_id:string;
  zap,tim,n: integer;

implementation

uses Unit2;

{$R *.dfm}

Function GetMD5(s: string):string;
Var
MD_:MD5.TMD5Digest;
begin
MD_:=Md5.MD5String(s);
Result:=Md5.MD5DigestToStr(MD_);
Result:=ANSILOWERCASE(Result);
end;

function IsConnectedToInternet: Boolean;
var
  dwConnectionTypes: DWORD;
begin
  dwConnectionTypes:= INTERNET_CONNECTION_MODEM or INTERNET_CONNECTION_LAN or INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;    

procedure TForm1.Button1Click(Sender: TObject);
begin

if IsConnectedToInternet then
 begin
Form2.show;
Form2.WebBrowser1.Navigate('http://vk.com/login.php?app='+App_ID+'&layout=popup&type=browser');
end;
zap:=0;

tim:=StrToInt(Edit1.Text);
Timer1.Interval:=tim*1000*60;
Timer1.Enabled:=true;

end;

procedure TForm1.Button2Click(Sender: TObject);
Var
data:tstringList;
str,str1,sig,Html,sigstr:string;
secret,UserID,id_g:string;
i1:integer;
begin

secret:='C4iUv105ci';        //секрет приложения
Data:=TStringList.Create;
id_g:=Edit2.Text;
//подключаем полученные ранее куки и заходим на страницу приложения
IdHttp1.Request.CustomHeaders.Clear;
IdHttp1.Request.CustomHeaders.Text:='Cookie: remixchk=5;remixlang=0;remixsid='+sid;
//выдергиваем из переменных идентификатор пользователя
Html:=IdHttp1.Get('http://vk.com/app633984');
UserID:=Copy(Html, pos('"uid":',Html)+6, pos(',"version"',Html) - pos('"uid":',Html)-6);

//создаём запрос
Data.Clear;
data.Add('offset=0');  //-смешение в записях (1 страница.)
data.Add('sid='+Sid);  //-как ни странно, но в документации написано что не используется для создания сигнатуры.. однако
data.Add('api_id=633984'); //ид приложения которое используем
data.Add('method=wall.get'); //метод
data.Add('owner_id=-'+id_g); //группа от куда выдергиваем
data.Add('count=1'); //количество выдергиваемых записей, ... первые 100 (offset=0, т.е. записи 0-100, для следующих 100 записей, оффсет=100, получится записи от 101-201, и тд)
data.Add('filter=all'); //выдергиваем все.
Data.Sort;          //сортируем
sigstr:='';
for i1 := 0 to data.Count - 1 do sigstr:=sigstr+data.Strings[i1]; //подставляем все параметры запроса в строку
sig:=GetMD5(UserID+sigstr+secret); //приписываем ид пользователя и секрет, получаем мд5
Data.Add('sig='+sig);     //добавляем к запросу сигнатуру
str:=UTF8ToANSI(IdHttp1.POST('http://api.vk.com/api.php',data)); //посылаем, получаем ответ, дальше делаем что хотим


 str1:='';
 delete(str,1,pos('count>',str)+5);
 str1:=copy(str,1,pos('</count',str)-1);
 if (StrToInt(str1)>zap) then begin
    zap:=StrToInt(str1);
  if CheckBox1.Checked then PlaySound(PChar('alert.wav'),0,SND_FILENAME);
 // MessageBeep(MB_OK);
//  CoolTrayIcon1.BalloonTitle:=form1.caption;
//  CoolTrayIcon1.BalloonHint:='Есть новый сигнал!..';
 // CoolTrayIcon1.ShowBalloonHint;
 //TrayIcon1.Animate:=true;

 if not Windows.IsWindowVisible(Handle) then Timer2.Enabled:=true;

 CoolTrayIcon1.CycleIcons:=true;
 end;


 str1:='';
 delete(str,1,pos('text>',str)+4);
 str1:=copy(str,1,pos('</text',str)-1);

Memo1.lines.text:=str1;
IdHttp1.Disconnect;
end;



procedure TForm1.SetViewer_id;
Var
Html:string;
I:integer;
begin
form2.Close;
IdHttp1.Request.CustomHeaders.Clear;
IdHttp1.Request.CustomHeaders.Text:='Cookie: remixchk=5;remixlang=0;remixsid='+sid;

Html:=IdHttp1.Get('http://vk.com/');

I:=pos('id: ',Html);
Html:=Copy(Html,i,16);
User_id:=Copy(Html, pos('id: ',Html)+4, pos(',',Html) - pos('id: ',Html)-4);
Label2.Caption:='Авторизация прошла успешно';//User_id+#10+Sid;
end;



procedure TForm1.Timer2Timer(Sender: TObject);
begin

 FlashWindow(Application.Handle, True);
 if Windows.IsWindowVisible(Handle) then
 begin
    Timer2.Enabled:=false;
    FlashWindow(Application.Handle, False);
  end;
end;

procedure TForm1.TrayIcon1Click(Sender: TObject);
  var
     k: integer;


   begin

     Form1.Show;


     CoolTrayIcon1.CycleIcons:=false;
     CoolTrayIcon1.IconIndex:=0;
     application.Restore;
     application.BringToFront;
     CoolTrayIcon1.IconVisible:=false;



end;



procedure TForm1.Button3Click(Sender: TObject);
begin

 //application.Minimize;
 CoolTrayIcon1.CycleIcons:=false;
 CoolTrayIcon1.IconVisible:=true;
 CoolTrayIcon1.IconIndex:=0;
 Form1.Hide;
 Timer1.Interval:=tim*1000*60;
end;




procedure TForm1.Edit1Change(Sender: TObject);
begin
tim:=StrToInt(Edit1.Text);
Timer1.Interval:=tim*1000*60;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//idhttp1.ReadTimeout:=3000;
n:=0;
end;




procedure TForm1.N1Click(Sender: TObject);
begin

showmessage('При запуске нажать кнопку "Логин в контакте", после успешной авторизации можно нажать  кнопку "Обновить".'+#10+'Если авторизация заканчивается ошибкой, запустите Internet Explorer и выполните вход вконтакте через браузер, затем снова нажмите кнопку логин.'+#10+'Программу можно свернуть в трей, она будет мигать иконкой при получении новой записи');

end;

procedure TForm1.N2Click(Sender: TObject);
begin
showmessage('Программа просмотра последнего сообщения в группе ВК, в которой  состоит юзер.'+#10+'SCrat.ORS && harbor, www.delphisources.ru, 1780@mail.ru');

end;

end.