авторизация на трекере - Работа с сетью в Delphi

-=Virus=- · 17.07.2011, 18:51

Помогите авторизоватся на трекере.

PHP код:


			
<!-- Login -->
<div class="loginform"><br><br>
<div class="loginform_inn">


<form method="post" action="takelogin.php"><input class="login" type="text" size=20 name="username" value="Логин..." onBlur="if(this.value=='') this.value='Логин...';" onFocus="if(this.value=='Логин...') this.value='';" /><input class="pass" type="password" size=20 name="password" value="123456" onBlur="if(this.value=='') this.value='123456';" onFocus="if(this.value=='123456') this.value='';" /><br><input type="submit" value="Вход"></form>
<form method="post" action="signup.php"><input type="submit" value="Регистрация"></form>

</div></div>
<!-- /Login -->

Код авторизации

Пробовал так

Цитата:

procedure TForm1.Button1Click(Sender: TObject);
var
LoginInfo: TStringList;
Response: TStringStream;
begin
try
LoginInfo := TStringList.Create;
LoginInfo.Add('username=Denis ');
LoginInfo.Add('password=password');
IdHTTP1.Post('http://goldentorrent.ru/takelogin.php',LoginInfo,Response);
memo1.Lines.add(Response.DataString );
finally
begin
Response.Free;
LoginInfo.Free;
end;
end;
end;

Voody · 17.07.2011, 19:20

Цитата:

Сообщение от -=Virus=-

Пробовал так

И? Какой результат? Какой текст возвращает сервер?

-=Virus=- · 17.07.2011, 20:31

В том то и дело что ни чего не получается

Voody · 17.07.2011, 20:55

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

Код:

<td class="embedded">Имя пользователя или пароль неверны</td>

А в случае, если и пользователя такого нет, такой:

Код:

<td class="embedded">Вы не зарегистрированы в системе.</td>

А что у вас?

Человек_Борща · 17.07.2011, 20:56

снифером смотри, что ещё посылается на сайт кроме логина и пароля. Кукисы тоже к примеру

Alter · 17.07.2011, 21:54

Вот работает у меня:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdCookieManager, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, StdCtrls, StrUtils;

const
  ServerStatusLogIn :array[0..1]of string=('<td class="embedded">', '</td>');


type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function FindTagTextParam(Txt, Tg1, Tg2: string; IncludeTag: Boolean): string;
  function ExtractLogInResult(S :string):string;

implementation

{$R *.dfm}

function FindTagTextParam(Txt, Tg1, Tg2: string; IncludeTag: Boolean): string;
const
 StartPos :Integer = 1; //начало поиска тегов
var a, b, L :Integer;
    S :string;
    Buf :string;
    CorA,CorB :Integer; //коррекция копирования
begin // поиск первого включения тегов
  Result := '';
 if Trim(Txt) = '' then Exit;
 Buf := AnsiUpperCase(Txt);
 a := PosEx(AnsiUpperCase(Tg1), Buf, StartPos);
 a := a + Length(Tg1);
 b := PosEx(AnsiUpperCase(Tg2), Buf, a);
 L := b - a;
  // коэффициенты коррекции строки
 CorA := Length(Tg1);
 CorB := Length(Tg2) + Length(Tg1);
  // добавить ячейку
 if IncludeTag then
 begin // вместе с тегами поиска
  S := Copy(Txt, a - CorA, L + CorB);
  If Pos(Tg1, S) = 1 then
   Result := S;
 end
  else
 begin // занчение между тегами
  Result := Copy(Txt, a, L);
 end;
end;

function ExtractLogInResult(S :string):string;
begin
  Result := '';
  if Trim(S) = '' then
   Exit;
  Result := FindTagTextParam(S, ServerStatusLogIn[0], ServerStatusLogIn[1], False);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
    LogInnLink = 'http://goldentorrent.ru/takelogin.php';
    Lg = 'username=%s';
    Psw = 'password=%s';
var
  FPost :TStringList;
  FTxtStrm :TStringStream;
  FBuf :string;
begin
 TButton(Sender).Enabled := False;

 Memo1.Lines.Clear;
 Edit3.Clear;

 FPost := TStringList.Create;
 FTxtStrm := TStringStream.Create;
  try
 FPost.Add(Format(Lg, [Edit1.Text]));
 FPost.Add(Format(Psw, [Edit2.Text]));
 IdHTTP1.Post(LogInnLink, FPost, FTxtStrm);
 FBuf := FTxtStrm.DataString;
 Memo1.Lines.Text := FBuf;
 Edit3.Text := ExtractLogInResult(FBuf);
  finally
 TButton(Sender).Enabled := True;
 FreeAndNil(FPost);
 FreeAndNil(FTxtStrm);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 With IdHTTP1 do
 begin
   HandleRedirects := True;
   ProtocolVersion := pv1_1;
   AllowCookies := True;
   CookieManager := IdCookieManager1;
   with Request do
   begin
     Host := 'goldentorrent.ru';
     UserAgent := 'Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.9.168 Version/11.50';
     Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
     AcceptLanguage := 'ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3';
     AcceptEncoding := 'gzip, deflate';
     AcceptEncoding := 'windows-1251,utf-8;q=0.7,*;q=0.7';
     Referer := 'http://goldentorrent.ru/';
     ProxyConnection := 'keep-alive';
     ContentType := 'application/x-www-form-urlencoded';
   end;
 end;
end;

end.

-=Virus=- · 18.07.2011, 00:43

Всё бы хорошо но когда вводишь существующий логин и пароль то не авторизовывается. Кидает на главную страницу и всё.
Вот попробуй логин=Denis пароль=12345
Главное вводишь левые данные всё работает, вводишь существующие данные полный бред получается.

Alter · 18.07.2011, 17:26

Добавил проверку на вход, входит.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdCookieManager, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, StdCtrls, StrUtils;

const
  ServerStatusLogIn :array[0..1]of string=('<td class="embedded">', '</td>');
  LogInSuc  = '<a href="logout.php">';
  LogInSucS = 'Вход успешен';


type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function FindTagTextParam(Txt, Tg1, Tg2: string; IncludeTag: Boolean): string;
  function ExtractLogInResult(S :string):string;
  function IsLogIn(S :string):Boolean;

implementation

{$R *.dfm}

function FindTagTextParam(Txt, Tg1, Tg2: string; IncludeTag: Boolean): string;
const
 StartPos :Integer = 1; //начало поиска тегов
var a, b, L :Integer;
    S :string;
    Buf :string;
    CorA,CorB :Integer; //коррекция копирования
begin // поиск первого включения тегов
  Result := '';
 if Trim(Txt) = '' then Exit;
 Buf := AnsiUpperCase(Txt);
 a := PosEx(AnsiUpperCase(Tg1), Buf, StartPos);
 a := a + Length(Tg1);
 b := PosEx(AnsiUpperCase(Tg2), Buf, a);
 L := b - a;
  // коэффициенты коррекции строки
 CorA := Length(Tg1);
 CorB := Length(Tg2) + Length(Tg1);
  // добавить ячейку
 if IncludeTag then
 begin // вместе с тегами поиска
  S := Copy(Txt, a - CorA, L + CorB);
  If Pos(Tg1, S) = 1 then
   Result := S;
 end
  else
 begin // занчение между тегами
  Result := Copy(Txt, a, L);
 end;
end;

function ExtractLogInResult(S :string):string;
begin
  Result := '';
  if Trim(S) = '' then
   Exit;
  Result := FindTagTextParam(S, ServerStatusLogIn[0], ServerStatusLogIn[1], False);
end;

function IsLogIn(S :string):Boolean;
var
  Buf :string;
begin // удачно вошли, или нет
  Result := False;
  if Trim(S) = '' then
   Exit;
  Buf := AnsiLowerCase(S);
  Result := (Pos(LogInSuc, Buf) > 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
    LogInnLink = 'http://goldentorrent.ru/takelogin.php';
    Lg = 'username=%s';
    Psw = 'password=%s';
var
  FPost :TStringList;
  FTxtStrm :TStringStream;
  FBuf :string;
begin
 TButton(Sender).Enabled := False;

 Memo1.Lines.Clear;
 Edit3.Clear;

 FPost := TStringList.Create;
 FTxtStrm := TStringStream.Create;
  try
 FPost.Add(Format(Lg, [Edit1.Text]));
 FPost.Add(Format(Psw, [Edit2.Text]));
 IdHTTP1.Post(LogInnLink, FPost, FTxtStrm);
 FBuf := FTxtStrm.DataString;
 Memo1.Lines.Text := FBuf;
  case IsLogIn(FBuf) of
 True: Edit3.Text := LogInSucS;
 False: Edit3.Text := ExtractLogInResult(FBuf);
  end;
  finally
 TButton(Sender).Enabled := True;
 FreeAndNil(FPost);
 FreeAndNil(FTxtStrm);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 With IdHTTP1 do
 begin
   HandleRedirects := True;
   ProtocolVersion := pv1_1;
   AllowCookies := True;
   CookieManager := IdCookieManager1;
   with Request do
   begin
     Host := 'goldentorrent.ru';
     UserAgent := 'Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.9.168 Version/11.50';
     Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
     AcceptLanguage := 'ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3';
     AcceptEncoding := 'gzip, deflate';
     AcceptEncoding := 'windows-1251,utf-8;q=0.7,*;q=0.7';
     Referer := 'http://goldentorrent.ru/';
     ProxyConnection := 'keep-alive';
     ContentType := 'application/x-www-form-urlencoded';
   end;
 end;
end;

end.

Дальше полученный HTML текст страницы самому парсить нужно.

-=Virus=- · 18.07.2011, 22:46

Alter, у тебя какая вервия Delphi?

Alter · 20.07.2011, 21:39

2010 версия

17.07.2011, 20:55	#4
Voody Форумчанин Регистрация: 22.06.2009 Сообщений: 310	По коду не очень понятно, как вы определяете, что ничего не получается. Видимо вы смотрите текст ответа. Например в случае неверного пароля там должен быть такой текст: Код: `<td class="embedded">Имя пользователя или пароль неверны</td>` А в случае, если и пользователя такого нет, такой: Код: `<td class="embedded">Вы не зарегистрированы в системе.</td>` А что у вас?

18.07.2011, 00:43	#7
-=Virus=- Форумчанин Регистрация: 03.07.2009 Сообщений: 246	Всё бы хорошо но когда вводишь существующий логин и пароль то не авторизовывается. Кидает на главную страницу и всё. Вот попробуй логин=Denis пароль=12345 Главное вводишь левые данные всё работает, вводишь существующие данные полный бред получается. Последний раз редактировалось -=Virus=-; 18.07.2011 в 00:51.

20.07.2011, 21:39	#10
Alter Старожил Регистрация: 06.08.2007 Сообщений: 2,183	2010 версия DelphiWorld 6, АVL 2.0.1.3

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Авторизация	Fiber	Visual C++	1	14.03.2011 16:30
Обычная авторизация или авторизация на уровне браузера?	calugin	Безопасность, Шифрование	0	13.01.2011 00:34
Авторизация	doniyor	JavaScript, Ajax	1	07.11.2009 21:13
Авторизация?	Gromsky	PHP	5	07.08.2009 19:27
Авторизация	AIst	PHP	5	03.12.2008 20:57

17.07.2011, 20:31	#3
-=Virus=- Форумчанин Регистрация: 03.07.2009 Сообщений: 246	В том то и дело что ни чего не получается

17.07.2011, 20:56	#5
Человек_Борща Старожил Регистрация: 30.12.2009 Сообщений: 11,434	снифером смотри, что ещё посылается на сайт кроме логина и пароля. Кукисы тоже к примеру

18.07.2011, 22:46	#9
-=Virus=- Форумчанин Регистрация: 03.07.2009 Сообщений: 246	Alter, у тебя какая вервия Delphi?