Форум АНТИЧАТ

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   С/С++, C#, Delphi, .NET, Asm (https://forum.antichat.xyz/forumdisplay.php?f=24)
-   -   [Delphi] Winsock 1.1 - В чем проблема? (https://forum.antichat.xyz/showthread.php?t=201708)

RedFern.89 04.05.2010 22:16
[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;

wolmer 04.05.2010 22:51
Вот:
Код:
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 в первом посте.

Chrome~ 05.05.2010 16:45
Цитата:
Сообщение от 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><![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

slesh 05.05.2010 16:52
>>>>>> recv(Sock,buf,SizeOf(buf),0); <<<<<<
Ты уверен что сервак будет таким добрым чтобы дать тебе всю страницу целиком, а твой канал такой хороший, чтобы передать её потом без задержки?

Проще говоря - тебе повезло что хоть часть файла сливается, чаще всего еще хуже, типа тока HTTP заголовок ответа.

По этому:
1) если у тебя Connection: Close стоит то просто тупо читай в цикле пока читается чтото
2) если у тебя стоит Connection: Keep-alive то из заголовка ответа выдирай Contend-Length, от туда бери кол-во байт для считывания и считывай их. как считал так закрывай сам коннект.

Для тебя проще будет первый способ юзать

Chrome~ 05.05.2010 17:14
Цитата:
Сообщение от slesh
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;

Chrome~ 06.05.2010 01:28
Виснет, потому что должно присутствовать поле
Код:
Connection: close

RedFern.89 06.05.2010 01:36
делал. страница приходит не до конца.. и кукисы не принимаются...

Chrome~ 06.05.2010 01:40
Хорошо.
Скинь еще раз полный вариант кода, который ты используешь для формирования запроса и для отправки, а также адрес, на который делаешь запрос.
Постараюсь помочь.

[stranger] 06.05.2010 01:59
нафига копируешь в цикле?
есть ведь длина полученных данных, юзай copy

Chrome~ 06.05.2010 02:17
Вот код полностью рабочий код, который я переработал из твоего. Посмотри, что к чему.

Код:
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"
Пароль: password1234

Chrome~, буду очень признателен за помощь!)))

slesh 06.05.2010 09:46
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;

Chrome~ 06.05.2010 16:49
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'е о________________О

Chrome~ 09.05.2010 15:43
Скажи, с каким циклом у тебя проблемы, помогу.


Время: 09:56