|
Дайте пожалуйсто авторизацыю - Вопросы и ответы, обсуждения - Ваши вопросы по Pascal/Delphi только в данном разделе |
15.07.2011, 11:34
|
#1
|
|
|
|
Разведчик
|
Регистрация: 15.07.2011
Сообщений: 1
Популярность: 10
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
|
Дайте пожалуйсто авторизацыю
дайте пожалуйсто инструкцыю или хотябы код буду благодарен очень
для тех кто играет в тюрягу дам способ воровать нычки
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdHTTPEx, StdCtrls, StrUtils, IdMessage, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, jpeg,
ExtCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
i: Integer;
http: TIdHTTPEx;
begin
http := TIdHTTPEx.Create;
// Москировка под оперу :)
http.Request.UserAgent :=
'Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.7.62 Version/11.01';
// Отлавливаем редирект. ВАЖНО!!! Иначе не установятся куки
try
// Отправляем Логин и Пароль
s := http.GetEx('http://vkontakte.ru/login.php?m=1&email=' + Edit1.Text +
'&pass=' + Edit2.Text);
except
// Если редирект - Редиректим
if http.ResponseCode = 302 then
s := http.GetEx('http://vkontakte.ru' + http.Response.Location);
end;
// Авторизация пройдена
// Для проверки загрузим последние Личные Сообщения
s := http.GetEx('http://vkontakte.ru/mail.php');
i := 1;
while PosEx('new messageBody', s, i) <> 0 do
begin
i := PosEx('new messageBody', s, i) + 17;
ListBox1.Items.Add(Copy(s, i, PosEx('"', s, i) - i));
end;
http.Free;
end;
end.
найдите ошыбку
|
|
|
15.07.2011, 12:12
|
#2
|
|
|
|
Рыцарь-защитник
|
Регистрация: 14.06.2010
Сообщений: 584
Популярность: 6626
Сказал(а) спасибо: 86
Поблагодарили 847 раз(а) в 266 сообщениях
|
Re: Дайте пожалуйсто авторизацыю
попробуй редирект не руками делать, а поставить галку HandleRedirect в св-вах idHTTP
Последний раз редактировалось Mebius; 15.07.2011 в 12:16.
|
|
|
15.07.2011, 16:03
|
#3
|
|
|
|
Разведчик
|
Регистрация: 23.01.2011
Сообщений: 0
Популярность: 10
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
|
Re: Дайте пожалуйсто авторизацыю
Вот тебе код для получения инфы:
Код:
function parse(str, str2, ob: string): string;
var
res, s1, s2: string;
begin
s1 := Copy(ob, pos(str, ob) + length(str), length(ob));
s2 := Copy(s1, 1, pos(str2, s1) - 1);
result := s2;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
p,i:Tstrings;
rating,diamond,money,sugar,toilet_paper,basePopularity,already_spin,energy,name:string;
begin
idhttp1.Request.UserAgent:= 'Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.13)';
idhttp1.Request.ContentType:='application/x-www-form-urlencoded';
p:=Tstringlist.Create;
i:=Tstringlist.Create;
try
i.Add('method=getInfo');
i.Add('key=******');
i.Add('user=********');
i.Text:=IdHTTP1.Post('http://109.234.155.196/prison/universal.php?getInfo', i);
memo3.Lines.Add(i.Text);
rating := parse('<rating>', '</rating>', Memo3.Text); //авторитет
energy := parse('<energy>', '</energy>', Memo3.Text); //энергия
money := parse('<money>', '</money>', Memo3.Text); //сигареты
sugar := parse('<sugar>', '</sugar>', Memo3.Text); // сахар
diamond := parse('<diamond>', '</diamond>', Memo3.Text); // рубли
toilet_paper := parse('<toilet_paper>', '</toilet_paper>', Memo3.Text); //туалетка
basePopularity := parse('<basePopularity>', '</basePopularity>', Memo3.Text); //ели честно не помню
already_spin := parse('<basePopularity>', '</basePopularity>', Memo3.Text); //бицуха
name := parse('<name>', '</name>', Memo3.Text);//кликуха
GroupBox3.Caption:=UTF8Decode(synacode.DecodeURL(name));
Label3.Caption:=rating;
Label8.Caption:=energy;
Label15.Caption:=basePopularity;
Label9.Caption:=money;
Label10.Caption:=diamond;
Label11.Caption:=toilet_paper;
Label13.Caption:=sugar;
Label17.Caption:=already_spin;
memo1.Lines.Add('Статистика обновлена');
finally
p.Free;
memo3.Clear;
end;
end;
|
|
|
15.07.2011, 19:08
|
#4
|
|
|
|
Разведчик
|
Регистрация: 23.01.2011
Сообщений: 0
Популярность: 10
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
|
Re: Дайте пожалуйсто авторизацыю
Код:
function parse(str, str2, ob: string): string;
var
res, s1, s2: string;
begin
s1 := Copy(ob, pos(str, ob) + length(str), length(ob));
s2 := Copy(s1, 1, pos(str2, s1) - 1);
result := s2;
end;
var
s, bufText, bufText2 : string;
i: Integer;
begin
IdHTTP1.Create;
// Москировка под оперу :)
IdHTTP1.Request.UserAgent :=
'Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.7.62 Version/11.01';
// Отлавливаем редирект. ВАЖНО!!! Иначе не установятся куки
try
// Отправляем Логин и Пароль
s := IdHTTP1.Get('http://vkontakte.ru/login.php?m=1&email=' + Edit1.Text +
'&pass=' + Edit2.Text);
except
// Если редирект - Редиректим
if IdHTTP1.ResponseCode = 302 then
s := IdHTTP1.Get('http://vkontakte.ru' + IdHTTP1.Response.Location);
end;
// Авторизация пройдена
// Для проверки загрузим последние auth_key и id тюряги
memo1.Lines.Text:= IdHttp1.Get('http://vkontakte.ru/app1979194');
bufText := parse('"auth_key":"', '",', Memo1.Text);
bufText2 := parse('"id":', ',"', Memo1.Text);
Memo1.Clear;
Edit3.Text:=bufText2+ ':' +bufText;
IdHTTP1.Free;
Timer1.Enabled:=false;
end;
Вот норм код
|
|
|
Ваши права в разделе
|
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения
HTML код Выкл.
|
|
|
Заявление об ответственности / Список мошенников
Часовой пояс GMT +4, время: 21:00.
|
|