|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#16
|
|||
|
|||
все залагало ужас кнопки не работают.
в public добавил Код:
fUID: integer; fToken: string; и код этот добавил и все лагает |
#17
|
|||
|
|||
я новичек,сильно не ругайте. Просто доступно объясните что не так и где читать что делать,а не просто ссылку кидать.
|
#18
|
||||
|
||||
Ммм... Причину лагов понять сложно. Попробуй пройтись отладчиком по коду.
Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#19
|
|||
|
|||
это как? общий код такой
Код:
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. |
#20
|
|||
|
|||
помогите...
|
#21
|
|||
|
|||
Код:
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; Если использовать только это как мне дальше вытягивать например имя аккаунта его друзей и т.д |
#22
|
||||
|
||||
Никак. По завершении авторизации браузер переадресуется на страницу, из адреса которой надо вытянуть токен, и использовать его во всех запросах.
Ещё раз - читаем документацию. Конкретно: Авторизация клиентских приложений Выполнение запросов к API Ну и приложение надо создать своё, естественно, с моим ничего не выйдет, т.к. оно давно удалено Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#23
|
|||
|
|||
А что нужно делать с приложением?что там нужно создавать?
|
#24
|
|||
|
|||
Есть такой код
Как мне из него вырезать авторизацию Код:
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. |