Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
 |
|
[Delphi] Winsock 1.1 - В чем проблема? |

04.05.2010, 22:16
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
[Delphi] Winsock 1.1 - В чем проблема?
реализовал методы 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_ERROR 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;
|
|
|

04.05.2010, 22:51
|
|
Постоянный
Регистрация: 12.05.2009
Сообщений: 395
Провел на форуме: 4761503
Репутация:
229
|
|
Вот:
Код:
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;
|
|
|

05.05.2010, 15:54
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
Еще 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><
05.05.2010, 16:45
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
175
|
|
Сообщение от RedFern.89
Еще 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><
05.05.2010, 16:52
|
|
Reservists Of Antichat - Level 6
Регистрация: 05.03.2007
Сообщений: 1,985
Провел на форуме: 3288241
Репутация:
3349
|
|
>>>>>> recv(Sock,buf,SizeOf(buf),0); <<<<<<
Ты уверен что сервак будет таким добрым чтобы дать тебе всю страницу целиком, а твой канал такой хороший, чтобы передать её потом без задержки?
Проще говоря - тебе повезло что хоть часть файла сливается, чаще всего еще хуже, типа тока HTTP заголовок ответа.
По этому:
1) если у тебя Connection: Close стоит то просто тупо читай в цикле пока читается чтото
2) если у тебя стоит Connection: Keep-alive то из заголовка ответа выдирай Contend-Length, от туда бери кол-во байт для считывания и считывай их. как считал так закрывай сам коннект.
Для тебя проще будет первый способ юзать
|
|
|

05.05.2010, 17:14
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
175
|
|
Сообщение от slesh
recv(Sock,buf,SizeOf(buf),0);
Кстати, это верно заметили. Твой клиент всегда будет считывать только первые 1501 байт (или меньше). Так как 1501 байт, - размер твоего буфера buf и значение, возвращаемое вызовом SizeOf(buf).
|
|
|

06.05.2010, 01:19
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
пытаюсь циклом... виснет...
Код:
// ---- Отправка запроса ----
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;
|
|
|

06.05.2010, 01:28
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
175
|
|
Виснет, потому что должно присутствовать поле
|
|
|

06.05.2010, 01:36
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
делал. страница приходит не до конца.. и кукисы не принимаются...
|
|
|

06.05.2010, 01:40
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
175
|
|
Хорошо.
Скинь еще раз полный вариант кода, который ты используешь для формирования запроса и для отправки, а также адрес, на который делаешь запрос.
Постараюсь помочь.
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|