реализовал методы GET & POST. Метод POST работает нормально.. Метод GETзависает и не может получить ответ от сервера. Сниффер показал, что get отправлен, а однако тело ответа пустое, заголовки пустые (ответные). В чем же проблема? привожу код. Code: // ---- Выдергиваем хост ---- 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;
Вот: Code: 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;
Еще 1 вопрос. Почему не доконца прогружает страницы? вот код процедуры запроса. Code: // ---- Отправка 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; а от сервера приходит нечто такое: Code: 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 Коды отправляемых заголовков: Code: (* Основные заголовки *) 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 запросов этого поля: Code: Content-Type: application/x-www-form-urlencoded Также, в твоем случае, нужно строчку Code: Connection: Keep-Alive заменить на Code: Connection: close
>>>>>> recv(Sock,buf,SizeOf(buf),0); <<<<<< Ты уверен что сервак будет таким добрым чтобы дать тебе всю страницу целиком, а твой канал такой хороший, чтобы передать её потом без задержки? Проще говоря - тебе повезло что хоть часть файла сливается, чаще всего еще хуже, типа тока HTTP заголовок ответа. По этому: 1) если у тебя Connection: Close стоит то просто тупо читай в цикле пока читается чтото 2) если у тебя стоит Connection: Keep-alive то из заголовка ответа выдирай Contend-Length, от туда бери кол-во байт для считывания и считывай их. как считал так закрывай сам коннект. Для тебя проще будет первый способ юзать
Кстати, это верно заметили. Твой клиент всегда будет считывать только первые 1501 байт (или меньше). Так как 1501 байт, - размер твоего буфера buf и значение, возвращаемое вызовом SizeOf(buf).
пытаюсь циклом... виснет... Code: // ---- Отправка запроса ---- 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;
Хорошо. Скинь еще раз полный вариант кода, который ты используешь для формирования запроса и для отправки, а также адрес, на который делаешь запрос. Постараюсь помочь.
Вот код полностью рабочий код, который я переработал из твоего. Посмотри, что к чему. Code: 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;
2 Chrome~ ошибочка у тебя есть небольшая ) Code: 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, архив либо битый, либо пасс не подходит. Попробуй сам внести изменения в свой код используя то, что я отписал выше.
отрубил антивирь, и все прекрасно работает)))) хз в ччем дело..если я запрашиваю другими компонентами страницы, то все норм а так посему то грузит и не до конца... странности какието со всем этим... =\