
14.08.2009, 13:07
|
|
Новичок
Регистрация: 17.04.2009
Сообщений: 3
С нами:
8982919
Репутация:
0
|
|
Всем привет. Пробую писать свой HTTP клиент на сокетах. Тестить решил на mail.ru, страницу принимает, POST запрос отправляет. Но на попытку авторизации выдает страницу 302. Снифал все со своего браузера (Opera 9.64) заголовки запросов списал с него. POST запросы у программы и браузера идентичные, но через браузер авторизируется, а через прогу получаю страницу 302.
Алгоритм тестирования: отправляю GET запрос на главную страницу mail.ru, получаю куки, вставляю эти куки в POST запрос с логином и паролем, отсылаю его. (куки полученые после GET вставляю вручную через TEdit)
Помогите, кто знает из-за чего не идет авторизация.
Вот код:
Код:
type
THTTPClientForm = class(TForm)
Memo1: TMemo;
Label1: TLabel;
URL: TLabel;
EdURL: TEdit;
Button1: TButton;
Edit3: TEdit;
Label4: TLabel;
Memo2: TMemo;
EditMpopl: TEdit;
EditMrcu: TEdit;
procedure Button1Click(Sender: TObject);
Function GetWEBpage(addr:string; Method:integer):TStringList;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure EdURLKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
HTTPClientForm: THTTPClientForm;
SendBuff:string;
POST:string;
implementation
uses unit2;
{$R *.dfm}
procedure THTTPClientForm.Button1Click(Sender: TObject);
begin
Memo1.Lines.Assign(GetWebPage(edURL.text, StrToInt(Edit3.Text)));
end;
Function THTTPClientForm.GetWEBPage;
var
localaddr : sockaddr_in;
iMode, iSize:integer;
rfds: TFDSET;
Buff: array [0..1024] of char;
stClient:TSocket;
testingserver, servername, portname:string;
timeout:TTimeVal;
begin
Result:=TStringList.Create;
stClient:=socket(AF_INET, SOCK_STREAM, 0);
if stClient=INVALID_SOCKET then
begin
messageBox(0, 'Ошибка инициализации сокета', 'Error', MB_OK);
exit;
end;
ServerName:='mail.ru';
PortName:='80';
localaddr.sin_addr:=LookUpName(servername);
localaddr.sin_family:=AF_INET;
localaddr.sin_port:=htons(StrToIntDef(portname, 80));
if connect(stClient, @localaddr, sizeof(localaddr))<>0 then
begin
messageBox(0, 'Ошибка соединения', 'Error', MB_OK);
exit;
end;
SendBuff:='';
if method=1 then
SendBuff:=
'GET / HTTP/1.1'#13+
'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
'Host: www.mail.ru'#13+
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
'If-Modified-Since: Fri, 14 Aug 2009 11:18:57 GMT'#13+
'Connection: Keep-Alive, TE'#13+
'TE: deflate, gzip, chunked, identity, trailers'#13#13;
if method=2 then
begin
POST:='Login=UserLogin+&Domain=mail.ru&Password=UserPassword';
SendBuff:=
'POST /cgi-bin/auth HTTP/1.1'#13+
'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
'Host: win.mail.ru'#13+
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
'Referer: http://www.mail.ru/'#13+
'Cookie: Mpopl='+EditMpopl.Text+'; mrcu='+EditMrcu.Text+';'#13+
'Cookie2: $Version=1'#13+
'Connection: Keep-Alive, TE'#13+
'TE: deflate, gzip, chunked, identity, trailers'#13+
'Content-Length: '+IntToStr(Length(POST))+#13+
'Content-Type: application/x-www-form-urlencoded'#13#13+POST;
end;
Memo2.Lines.Clear;
Memo2.Lines.Add(SendBuff);
SendStr(stClient,SendBuff);
iMode:=1;
setsockopt(stClient, IPPROTO_TCP, TCP_NODELAY, @iMode, sizeof(integer));
while true do
begin
FD_ZERO(rfds);
FD_SET(stClient, rfds);
timeout.tv_sec:=10;
if (select(0, @rfds, nil, nil, @timeout)<=0) then
exit;
if (FD_ISSET(stClient, rfds)) then
begin
iSize:=recv(stClient, buff, sizeof(buff), 0);
if (iSize<1) then
break;
Result.Add(String(buff));
end;
end;
CloseSocket(stClient);
end;
procedure THTTPClientForm.FormCreate(Sender: TObject);
var SockInit:TWSADATA;
begin
WSAStartUp(makeword(2,0), SockInit)
end;
Последний раз редактировалось WereWolfV; 14.08.2009 в 13:10..
|
|
|

14.08.2009, 13:20
|
|
Постоянный
Регистрация: 12.06.2008
Сообщений: 654
С нами:
9427413
Репутация:
973
|
|
Сообщение от WereWolfV
Всем привет. Пробую писать свой HTTP клиент на сокетах. Тестить решил на mail.ru, страницу принимает, POST запрос отправляет. Но на попытку авторизации выдает страницу 302. Снифал все со своего браузера (Opera 9.64) заголовки запросов списал с него. POST запросы у программы и браузера идентичные, но через браузер авторизируется, а через прогу получаю страницу 302.
Алгоритм тестирования: отправляю GET запрос на главную страницу mail.ru, получаю куки, вставляю эти куки в POST запрос с логином и паролем, отсылаю его. (куки полученые после GET вставляю вручную через TEdit)
Помогите, кто знает из-за чего не идет авторизация.
Вот код:
Код:
type
THTTPClientForm = class(TForm)
Memo1: TMemo;
Label1: TLabel;
URL: TLabel;
EdURL: TEdit;
Button1: TButton;
Edit3: TEdit;
Label4: TLabel;
Memo2: TMemo;
EditMpopl: TEdit;
EditMrcu: TEdit;
procedure Button1Click(Sender: TObject);
Function GetWEBpage(addr:string; Method:integer):TStringList;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure EdURLKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
HTTPClientForm: THTTPClientForm;
SendBuff:string;
POST:string;
implementation
uses unit2;
{$R *.dfm}
procedure THTTPClientForm.Button1Click(Sender: TObject);
begin
Memo1.Lines.Assign(GetWebPage(edURL.text, StrToInt(Edit3.Text)));
end;
Function THTTPClientForm.GetWEBPage;
var
localaddr : sockaddr_in;
iMode, iSize:integer;
rfds: TFDSET;
Buff: array [0..1024] of char;
stClient:TSocket;
testingserver, servername, portname:string;
timeout:TTimeVal;
begin
Result:=TStringList.Create;
stClient:=socket(AF_INET, SOCK_STREAM, 0);
if stClient=INVALID_SOCKET then
begin
messageBox(0, 'Ошибка инициализации сокета', 'Error', MB_OK);
exit;
end;
ServerName:='mail.ru';
PortName:='80';
localaddr.sin_addr:=LookUpName(servername);
localaddr.sin_family:=AF_INET;
localaddr.sin_port:=htons(StrToIntDef(portname, 80));
if connect(stClient, @localaddr, sizeof(localaddr))<>0 then
begin
messageBox(0, 'Ошибка соединения', 'Error', MB_OK);
exit;
end;
SendBuff:='';
if method=1 then
SendBuff:=
'GET / HTTP/1.1'#13+
'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
'Host: www.mail.ru'#13+
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
'If-Modified-Since: Fri, 14 Aug 2009 11:18:57 GMT'#13+
'Connection: Keep-Alive, TE'#13+
'TE: deflate, gzip, chunked, identity, trailers'#13#13;
if method=2 then
begin
POST:='Login=UserLogin+&Domain=mail.ru&Password=UserPassword';
SendBuff:=
'POST /cgi-bin/auth HTTP/1.1'#13+
'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
'Host: win.mail.ru'#13+
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
'Referer: http://www.mail.ru/'#13+
'Cookie: Mpopl='+EditMpopl.Text+'; mrcu='+EditMrcu.Text+';'#13+
'Cookie2: $Version=1'#13+
'Connection: Keep-Alive, TE'#13+
'TE: deflate, gzip, chunked, identity, trailers'#13+
'Content-Length: '+IntToStr(Length(POST))+#13+
'Content-Type: application/x-www-form-urlencoded'#13#13+POST;
end;
Memo2.Lines.Clear;
Memo2.Lines.Add(SendBuff);
SendStr(stClient,SendBuff);
iMode:=1;
setsockopt(stClient, IPPROTO_TCP, TCP_NODELAY, @iMode, sizeof(integer));
while true do
begin
FD_ZERO(rfds);
FD_SET(stClient, rfds);
timeout.tv_sec:=10;
if (select(0, @rfds, nil, nil, @timeout)<=0) then
exit;
if (FD_ISSET(stClient, rfds)) then
begin
iSize:=recv(stClient, buff, sizeof(buff), 0);
if (iSize<1) then
break;
Result.Add(String(buff));
end;
end;
CloseSocket(stClient);
end;
procedure THTTPClientForm.FormCreate(Sender: TObject);
var SockInit:TWSADATA;
begin
WSAStartUp(makeword(2,0), SockInit)
end;
Хз как там в дельфях, но 302 это редирект, маилру после авторизации редиректит... Так что походу все ок
|
|
|

14.08.2009, 13:28
|
|
Новичок
Регистрация: 17.04.2009
Сообщений: 3
С нами:
8982919
Репутация:
0
|
|
забыл написать, редиректит на http://win.mail.ru/cgi-bin/auth а при правильной авторизации должно на что-то подобное http://win.mail.ru/cgi-bin/checkcookie?id=4f06025a64445b73190502199a1d00071c0 c014f6a5d5e465e07070802051e0b03031e4e5c4a54475e5b5 341145c555e551f4243
и после на страницу пользователя.
|
|
|

14.08.2009, 22:12
|
|
Познающий
Регистрация: 05.11.2008
Сообщений: 79
С нами:
9217193
Репутация:
12
|
|
Как найти вложение текста в строке не учитывая регистр..? Делал через Pos но там регистр учитывается. помогите плиз. Работаю в дeлфи
|
|
|

15.08.2009, 11:33
|
|
Участник форума
Регистрация: 20.12.2007
Сообщений: 295
С нами:
9679872
Репутация:
347
|
|
Сообщение от sadfeel
Как найти вложение текста в строке не учитывая регистр..? Делал через Pos но там регистр учитывается. помогите плиз. Работаю в дeлфи
из модуля strutils
function AnsiContainsText(const AText, ASubText: string): Boolean;
|
|
|

14.08.2009, 22:29
|
|
Reservists Of Antichat - Level 6
Регистрация: 12.02.2006
Сообщений: 891
С нами:
10653446
Репутация:
836
|
|
s, s1: string;
begin
s:='ТекстТут';
s1:=LowerCase(s); //тесттут
вот и все...
__________________
*********************************
*Я не волшебник ٩(๏̯͡๏)۶, только учусь...*
*********************************
Программы на заказ
Times to fly...
Последний раз редактировалось W!z@rD; 15.08.2009 в 11:16..
|
|
|

15.08.2009, 11:01
|
|
Познающий
Регистрация: 02.06.2009
Сообщений: 67
С нами:
8916612
Репутация:
54
|
|
Код:
var
substr, s: string;
p: Integer;
begin
substr := 'b';
s := 'ABCD';
p := Pos(LowerCase(substr), LowerCase(s));
end;
|
|
|

15.08.2009, 21:31
|
|
Новичок
Регистрация: 29.08.2008
Сообщений: 9
С нами:
9315718
Репутация:
0
|
|
Народ подскажите плиз как в дельфи работать с активными соединениями, а именно получить список активных соединений, ip и port источника и получателя определенного соединения, закрытие соединения.
Заранее спс.
|
|
|

15.08.2009, 21:47
|
|
Участник форума
Регистрация: 20.12.2007
Сообщений: 295
С нами:
9679872
Репутация:
347
|
|
запускай netstat и анализируй его вывод
или если вручную
http://www.xakep.ru/magazine/xa/098/122/1.asp
|
|
|

15.08.2009, 22:41
|
|
Новичок
Регистрация: 25.07.2009
Сообщений: 17
С нами:
8840262
Репутация:
3
|
|
люди помогите пожалуйста. в программе есть кнопка. после её нажатия открывается окно браузера и сайт. мне нужно поменять этот сайт. так вот проблема в том что Resource Builder не показывает обработчик OnClick ни одной кнопки. просто примерно вот такой текст каждой кнопки.
object btnpay: TButton
Left = 129
Top = 129
Width = 67
Height = 25
Caption = 'Pay'
TabOrder = 5
Visible = False
OnClick = btnpayClick
а где находится обработчик? все обыскал!
Помогите кто знает. я в pascal ни бум бум.
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|