Просмотр полной версии : [Delphi] Winsock 1.1 - В чем проблема?
RedFern.89
04.05.2010, 22:16
реализовал методы GET & POST. Метод POST работает нормально.. Метод GETзависает и не может получить ответ от сервера. Сниффер показал, что get отправлен, а однако тело ответа пустое, заголовки пустые (ответные). В чем же проблема? привожу код.
// ---- Выдергиваем хост ----
function GetHost(const AURL: string): string;
var
sResult : string;
begin
sResult := AURL;
If Pos('www', sResult) <> 0 Then Delete(sResult, Pos('w', sResult), 4);
sResult := Copy(sResult, Pos('://', sResult) +3, Length(sResult));
Delete(sResult, Pos('/', sResult), Length(sResult));
Result := sResult;
end;
{ ************************************************** *************************** }
// ---- Отправка запроса ----
function SendRequest(URL,PACKET:string):string;
var
req{,data} : string;
buf : array[0..1500] of char;
wData : WSADATA;
addr : sockaddr_in;
sock : integer;
error : integer;
phe : PHostEnt;
begin
Result := '';
WSAStartup($0101, wData);
phe := gethostbyname(PChar(string(GetHost(url))));
if phe = nil then begin
WSACleanup;
exit;
end;
sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if sock = INVALID_SOCKET then begin
WSACleanup;
exit;
end;
addr.sin_family := AF_INET;
addr.sin_port := htons(80);
addr.sin_addr := PInAddr(phe.h_addr_list^)^;
error := connect(sock, addr, sizeof(addr));
if error = SOCKET_ERROR then begin
closesocket(sock);
WSACleanup;
exit;
end;
req := PACKET;
if Send(Sock,pointer(req)^,length(req),0)=SOCKET_ERRO R then exit;
fillchar(buf,sizeof(buf),0);
recv(Sock,buf,SizeOf(buf),0);//sizeof(buf
closesocket(Sock);
result:=buf;
end;
{ ************************************************** *************************** }
// ---- Отправка POST-запроса ----
function Post(const AURL: string; const ASource: TStringList): string;
var
req : string;
_Post : string;
tmp : string;
begin
_post := ASource.Text;
_post := StringReplace(_post, #13#10, '&', [rfReplaceAll]);
tmp := AURL;
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +1, Length(tmp));
req:='POST ' + tmp + ' HTTP/1.1' + #13#10 +
'Host: '+ GetHost(AURL) + #13#10+
'User-Agent: Opera/9.24 (Windows NT 5.1; U; en)' + #13#10 +
'Accept: */*;q=0.1' + #13#10 +
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8' + #13#10 +
'Connection: Keep-Alive' + #13#10 +
'Referer: http://vkontakte.ru/index.php' + #13#10 +
'Content-Length: '+ IntToStr(Length(_POST)) + #13#10 +
'Content-Type: application/x-www-form-urlencoded'#13#10#13#10 + _POST;
result := SendRequest(aurl, req);
end;
// ---- Отправка GET-запроса ----
function Get(const AURL: string): string;
var
req : string;
tmp : string;
begin
tmp := AURL;
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +1, Length(tmp));
req:='GET ' + tmp + ' HTTP/1.1' + #13#10 +
'Host: '+ GetHost(AURL) + #13#10+
'User-Agent: Opera/9.24 (Windows NT 5.1; U; en)' + #13#10 +
'Accept: */*;q=0.1' + #13#10 +
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8' + #13#10 +
'Connection: Keep-Alive' + #13#10 +
//'Referer: http://vkontakte.ru/index.php' + #13#10 +
'Content-Type: application/x-www-form-urlencoded'#13#10;
result := SendRequest(aurl, req);
end;
Вот:
function Get(const AURL: string): string;
var
req : string;
tmp : string;
begin
tmp := AURL;
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +1, Length(tmp));
req:='GET ' + tmp + ' HTTP/1.1' + #13#10 +
'Host: '+ GetHost(AURL) + #13#10+
'User-Agent: Opera/9.24 (Windows NT 5.1; U; en)' + #13#10 +
'Connection: Keep-Alive' + #13#10 +
//'Referer: http://vkontakte.ru/index.php' + #13#10 +
'Content-Type: application/x-www-form-urlencoded' + #13#10 + #13#10;
result := SendRequest(aurl, req);
end;
А именно:
'Content-Type: application/x-www-form-urlencoded' + #13#10 + #13#10;
RedFern.89
05.05.2010, 15:54
Еще 1 вопрос. Почему не доконца прогружает страницы? вот код процедуры запроса.
// ---- Отправка GET-запроса ----
function TidVKClient.Get(const AURL: string): string;
var
Request : string;
tmp : string;
Cookies : string;
begin
tmp := AURL; // Присваиваем
Cookies := FCookieList.Text;
Cookies := StringReplace(Cookies, #13#10, ' ', [rfReplaceAll]);
// Парсим URL
If Pos('www', tmp) <> 0 Then
begin
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +5, Length(tmp));
end else
begin
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +1, Length(tmp));
end;
ShowMessage(tmp);
// Формируем запрос
If Length(FCookieList.Text) = 0 Then // Если нет куков, то невключаем в заголовок "Cookie:"
begin
Request := 'GET ' + tmp + ' HTTP/1.1' + #13#10 +
Headers +
'Host: ' + GetHost(AURL) + #13#10#13#10;
end
else // Аесли есть, то включаем в заголовк "Cookie: ..."
begin
Request := 'GET ' + tmp + ' HTTP/1.1' + #13#10 +
Headers +
'Host: ' + GetHost(AURL) + #13#10 +
'Cookie: ' + Cookies + #13#10#13#10;
end;
// Отсылаем запрос
result := SendRequest(aurl, Request);
// Ищем куки в ответе
GetCookie(result);
end;
а от сервера приходит нечто такое:
HTTP/1.1 200 OK
Server: nginx/0.7.59
Date: Wed, 05 May 2010 11:52:54 GMT
Content-Type: text/html; charset=windows-1251
Transfer-Encoding: chunked
Connection: keep-alive
X-Powered-By: PHP/5.2.6-1+lenny4
Pragma: no-cache
Cache-control: no-store
Vary: Accept-Encoding
8e06
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" id="vkontakte">
<head>
<meta http-equiv="content-type" content="text/html; charset=windows-1251" />
<title>В Контакте | Личные сообщения</title>
<link rel="stylesheet" href="/css/rustyle.css?64" type="text/css" />
<script src="/js/common.js?118"></script>
<script type="text/javascript" src="/js/mail.js?23"></script>
<link rel="stylesheet" href="/css/mail2.css?8" type="text/css" />
<link rel="stylesheet" href="/css/dialog2.css" type="text/css" />
<link rel="stylesheet" href="/css/pages.css" type="text/css" />
<script type="text/javascript" src="/js/lang0_0-1000.js?753"></script>
<link rel="stylesheet" href="/css/ui_controls.css?13" type="text/css" />
<script type="text/javascript" src="/js/lib/ui_controls.js?36"></script>
<link rel="shortcut icon" href="/images/favicon.ico" />
<!--[if lte IE 6]><style type="text/css" media="screen">/* <![CDATA[ */ @import url(/css/ie.css?10); /* ]]> */</style><![endif]-->
<!--[if IE 7]><style type="text/css" media="screen">/* <![CDATA[ */ @import url(/css/ie7.css?10); /* ]]> */</style><![end
Коды отправляемых заголовков:
(* Основные заголовки *)
const
Headers =
'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3' + #13#10 +
'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10 +
'Accept-Language: ru,en-us;q=0.7,en;q=0.3' + #13#10 +
'Connection: Keep-Alive' + #13#10 +
'Referer: http://vkontakte.ru/index.php' + #13#10 +
'Content-Type: application/x-www-form-urlencoded' + #13#10;
код процедуры SendRequest в первом посте.
Еще 1 вопрос. Почему не доконца прогружает страницы? вот код процедуры запроса.
// ---- Отправка GET-запроса ----
function TidVKClient.Get(const AURL: string): string;
var
Request : string;
tmp : string;
Cookies : string;
begin
tmp := AURL; // Присваиваем
Cookies := FCookieList.Text;
Cookies := StringReplace(Cookies, #13#10, ' ', [rfReplaceAll]);
// Парсим URL
If Pos('www', tmp) <> 0 Then
begin
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +5, Length(tmp));
end else
begin
tmp := Copy(tmp, Length('http://' + GetHost(tmp)) +1, Length(tmp));
end;
ShowMessage(tmp);
// Формируем запрос
If Length(FCookieList.Text) = 0 Then // Если нет куков, то невключаем в заголовок "Cookie:"
begin
Request := 'GET ' + tmp + ' HTTP/1.1' + #13#10 +
Headers +
'Host: ' + GetHost(AURL) + #13#10#13#10;
end
else // Аесли есть, то включаем в заголовк "Cookie: ..."
begin
Request := 'GET ' + tmp + ' HTTP/1.1' + #13#10 +
Headers +
'Host: ' + GetHost(AURL) + #13#10 +
'Cookie: ' + Cookies + #13#10#13#10;
end;
// Отсылаем запрос
result := SendRequest(aurl, Request);
// Ищем куки в ответе
GetCookie(result);
end;
а от сервера приходит нечто такое:
HTTP/1.1 200 OK
Server: nginx/0.7.59
Date: Wed, 05 May 2010 11:52:54 GMT
Content-Type: text/html; charset=windows-1251
Transfer-Encoding: chunked
Connection: keep-alive
X-Powered-By: PHP/5.2.6-1+lenny4
Pragma: no-cache
Cache-control: no-store
Vary: Accept-Encoding
8e06
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" id="vkontakte">
<head>
<meta http-equiv="content-type" content="text/html; charset=windows-1251" />
<title>В Контакте | Личные сообщения</title>
<link rel="stylesheet" href="/css/rustyle.css?64" type="text/css" />
<script src="/js/common.js?118"></script>
<script type="text/javascript" src="/js/mail.js?23"></script>
<link rel="stylesheet" href="/css/mail2.css?8" type="text/css" />
<link rel="stylesheet" href="/css/dialog2.css" type="text/css" />
<link rel="stylesheet" href="/css/pages.css" type="text/css" />
<script type="text/javascript" src="/js/lang0_0-1000.js?753"></script>
<link rel="stylesheet" href="/css/ui_controls.css?13" type="text/css" />
<script type="text/javascript" src="/js/lib/ui_controls.js?36"></script>
<link rel="shortcut icon" href="/images/favicon.ico" />
<!--[if lte IE 6]><style type="text/css" media="screen">/* <![CDATA[ */ @import url(/css/ie.css?10); /* ]]> */</style><![endif]-->
<!--[if IE 7]><style type="text/css" media="screen">/* <![CDATA[ */ @import url(/css/ie7.css?10); /* ]]> */</style><![end
Коды отправляемых заголовков:
(* Основные заголовки *)
const
Headers =
'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3' + #13#10 +
'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10 +
'Accept-Language: ru,en-us;q=0.7,en;q=0.3' + #13#10 +
'Connection: Keep-Alive' + #13#10 +
'Referer: http://vkontakte.ru/index.php' + #13#10 +
'Content-Type: application/x-www-form-urlencoded' + #13#10;
код процедуры SendRequest в первом посте.
Ну во первых не нужно использовать для GET запросов этого поля:
Content-Type: application/x-www-form-urlencoded
Также, в твоем случае, нужно строчку
Connection: Keep-Alive
заменить на
Connection: close
>>>>>> recv(Sock,buf,SizeOf(buf),0); <<<<<<
Ты уверен что сервак будет таким добрым чтобы дать тебе всю страницу целиком, а твой канал такой хороший, чтобы передать её потом без задержки?
Проще говоря - тебе повезло что хоть часть файла сливается, чаще всего еще хуже, типа тока HTTP заголовок ответа.
По этому:
1) если у тебя Connection: Close стоит то просто тупо читай в цикле пока читается чтото
2) если у тебя стоит Connection: Keep-alive то из заголовка ответа выдирай Contend-Length, от туда бери кол-во байт для считывания и считывай их. как считал так закрывай сам коннект.
Для тебя проще будет первый способ юзать
recv(Sock,buf,SizeOf(buf),0);
Кстати, это верно заметили. Твой клиент всегда будет считывать только первые 1501 байт (или меньше). Так как 1501 байт, - размер твоего буфера buf и значение, возвращаемое вызовом SizeOf(buf).
RedFern.89
06.05.2010, 01:19
пытаюсь циклом... виснет...
// ---- Отправка запроса ----
function TidVKClient.SendRequest(URL,PACKET:string):string;
var
buf : array[0..1500] of char;
wData : WSADATA;
addr : sockaddr_in;
sock : integer;
error : integer;
phe : PHostEnt;
len,i,d : Integer;
begin
Result := '';
WSAStartup($0101, wData);
phe := gethostbyname(PChar(string(GetHost(url))));
sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
addr.sin_family := AF_INET;
addr.sin_port := htons(80);
addr.sin_addr := PInAddr(phe.h_addr_list^)^;
error := connect(sock, addr, sizeof(addr));
len := 0;
send(sock, PACKET[1], Length(PACKET),0);
repeat
FillChar(buf,SizeOf(buf),0);
d:=recv(sock,buf,SizeOf(buf),0);
len:=len+d;
for i:=1 to d do result := result + buf[i];
until d<=0;
closesocket(Sock);
WSACleanup;
end;
Виснет, потому что должно присутствовать поле
Connection: close
RedFern.89
06.05.2010, 01:36
делал. страница приходит не до конца.. и кукисы не принимаются...
Хорошо.
Скинь еще раз полный вариант кода, который ты используешь для формирования запроса и для отправки, а также адрес, на который делаешь запрос.
Постараюсь помочь.
[stranger]
06.05.2010, 01:59
нафига копируешь в цикле?
есть ведь длина полученных данных, юзай copy
Вот код полностью рабочий код, который я переработал из твоего. Посмотри, что к чему.
function LookupName(str: string): TInAddr;
var
_hostEnt:PHostEnt;
_inAddr:TInAddr;
begin
if (str[1] in ['a'..'z']) or
(str[2] in ['a'..'z']) then
begin
_hostEnt := getHostByName(pchar(str));
FillChar(_inAddr, sizeOf(_inAddr), 0);
if _hostEnt<>nil then
begin
with _hostEnt^, _inAddr do
begin
s_un_b.s_b1 := h_addr^[0];
s_un_b.s_b2 := h_addr^[1];
s_un_b.s_b3 := h_addr^[2];
s_un_b.s_b4 := h_addr^[3];
end;
end;
end
else
_inAddr.s_addr := inet_addr(pchar(str));
Result:= _inAddr;
end;
function SendRequest(URL,PACKET:string):string;
var
buf : array[1..1500] of char;
wData : WSADATA;
addr : sockaddr_in;
sock : integer;
error : integer;
phe : PHostEnt;
len,i,d : Integer;
begin
Result := '';
WSAStartup($0101, wData);
phe := gethostbyname(PChar(url));
sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
addr.sin_family := AF_INET;
addr.sin_port := htons(80);
addr.sin_addr := LookupName(URL);
error := connect(sock, addr, sizeof(addr));
len := 0;
send(sock, PACKET[1], Length(PACKET),0);
repeat
FillChar(buf,SizeOf(buf),0);
d:=recv(sock,buf,SizeOf(buf),0);
len:=len+d;
for i:=1 to d do result := result + buf[i];
until d<=0;
closesocket(Sock);
WSACleanup;
end;
function Get(const AURL: string): string;
var
req : string;
tmp, tmp2 : string;
begin
tmp := AURL;
if pos('http://', tmp) = 1 then
Delete(tmp, 1, 7);
if pos('/', tmp) <> 0 then tmp2 := copy(tmp, pos('/', tmp), 255)
else tmp2 := '/';
req:='GET ' + tmp2 + ' HTTP/1.0' + #13#10 +
'Host: ' + tmp + #13#10+
'User-Agent: Opera/9.24 (Windows NT 5.1; U; en)' + #13#10 +
'Connection: close' + #13#10#13#10;
result := SendRequest(tmp, req);
end;
RedFern.89
06.05.2010, 02:55
вот Сылка "vkComp.pas" (http://slil.ru/29088986)
Пароль: password1234
Chrome~, буду очень признателен за помощь!)))
2 Chrome~ ошибочка у тебя есть небольшая )
repeat
FillChar(buf,SizeOf(buf),0); // зачем очищать буфер? Если всё равно ты знаешь размер полученных данных которыми забился буфер
d:=recv(sock,buf,SizeOf(buf),0); // тут у тебя D будет содержать размер данных или -1 при ошибке
len:=len+d; // а если была ошибка и d =-1 то ты от уже считанных данных откусишь 1 байт.
for i:=1 to d do result := result + buf[i]; // зачем?? если можно сразу копировать через copy
until d<=0;
slesh, да не спорю, ты прав )
Но это не я писал этот код, его писал RedFern.89. Просто именно в этой части кода я не делал никаких изменений. Делал только в тех частях, которые влияют на то, что нам отсылает сервер. То есть немного изменил формирование самого GET запроса.
А на счет данной части кода: написано действительно неэффективно, без какой либо оптимизации.
RedFern.89, архив либо битый, либо пасс не подходит.
Попробуй сам внести изменения в свой код используя то, что я отписал выше.
RedFern.89
07.05.2010, 09:36
я с циклом не могу разобраца никак
RedFern.89
08.05.2010, 01:27
так кто поможет с циклом?
RedFern.89
08.05.2010, 02:09
отрубил антивирь, и все прекрасно работает)))) хз в ччем дело..если я запрашиваю другими компонентами страницы, то все норм а так посему то грузит и не до конца... странности какието со всем этим... =\
RedFern.89
08.05.2010, 03:28
и причем запрос get работатет только при запущенном http analyzer'е о________________О
Скажи, с каким циклом у тебя проблемы, помогу.
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot