Новичок
Профиль
Группа: Участник
Сообщений: 23
Регистрация: 19.7.2009
Репутация: нет
Всего: нет
|
хочу программно авторзироваться на форуме,но по неизвестной причине html страницка не принимаеться,принимаеться только заголовок и кусок начала страницы каторую я принимаю.почему? | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, XPMan;
const
Host = 'forum.4game.ru';
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Data : string;
implementation
uses
WinSock;
function IdSock(size:integer):string;
var
Sock : TSocket;
Addr : TSockAddr;
HostEnt : PHostEnt;
Res : Integer;
Buf : array [0..350001] of Char;
Source : string;
I:integer;
begin
source:='';
res:=0;
Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if Sock = INVALID_SOCKET then Exit; HostEnt := gethostbyname(PChar(Host));
if HostEnt = nil then Exit;Addr.sin_family := AF_INET;
Addr.sin_port := htons(80);Addr.sin_addr := PInAddr(HostEnt^.h_addr_list^)^;
if connect(Sock, Addr, SizeOf(TSockAddr)) = SOCKET_ERROR then
if WSAGetLastError() <> WSAEWOULDBLOCK then Exit;
Res := send(Sock, Data[1], Length(Data), 0); if Res = SOCKET_ERROR then Exit;
repeat
if size=0 then Res := recv(Sock, Buf, SizeOf(Buf), 0)else
Res := recv(Sock, Buf, size, 0);
if Res = SOCKET_ERROR then Exit;
if Res > 0 then Source := Source + Copy(Buf, 0, Res);
until Res <= size;
CloseSocket(Sock);
result := Source;
end;//IdSock
function cook(a:integer;Co:string):string;//Co - ?????? ??? ???? ????
var
pos1:integer;
str:string;
i:integer;
ckl:integer;
begin
for ckl:=1 to a do begin
result:='';
pos1:=pos('Set-Cookie:',co);
co:=copy(co,pos1+12,length(co)-12);
str:=co;
I:=1;
while str[i] <> ';' do begin
result:=result+str[i];inc(i);
end;
end;
end;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
WSAData : TWSAData;
begin
if WSAStartup($101, WSAData) <> 0 then
Exit;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
WSACleanup;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
forum_4game_ruipb_stronghold:string;
forum_4game_rusession_id:string;//????
forum_4game_rumember_id:string;
forum_4game_rupass_hash:string;
forum_4game_rucoppa: string;
PHPSESSID:string;
stat_uid:string;
sid:string;
pos1,pos2:integer; //15-16 ???
send:string;
ckl,ckl2,st,I:integer;
nick,pages,buf,str,attach_post_key,auth_key,Id:string;
Otvet: TStringList;
begin
Otvet:= TStringList.Create;
Data := 'GET /index.php?act=Login&CODE=00 HTTP/1.1' + #13#10 +
'Host: ' + Host + #13#10 +
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)' + #13#10 +
'Accept: text/html' + #13#10 +
'Connection: close' + #13#10#13#10;
form1.Memo1.text:=Idsock(50000);//Если поставить 0 ,то принимаеться нормально,но мне нужна не вся страничка
memo1.Lines.SaveToFile('1.html');
forum_4game_rusession_id:=cook(1,form1.Memo1.text);//forum_4game_rusession_id=4e9bec834c4da036ac55aeeb638591e7
sid:=copy(forum_4game_rusession_id,26,32) ; // 4e9bec834c4da036ac55aeeb638591e7
//showmessage(sid);
send:='referer=&UserName=i11111&PassWord=42113340&CookieDate=1';
Data := 'POST /index.php?s='+Sid+'&act=Login&CODE=01 HTTP/1.1'+#13#10+
'Host: ' + Host + #13#10 +
'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.8.1.16) Gecko/20080702 Firefox/2.0.0.16'+#13#10+
'Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5'+#13#10+
'Accept-Language: ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3'+#13#10+
'Accept-Encoding: gzip,deflate'+#13#10+
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7'+#13#10+
'Keep-Alive: 300'+#13#10+
'Connection: keep-alive'+#13#10+
'Referer: http://foru.4game.ru/index.php?act=Login&CODE=00'+#13#10+
'Cookie: '+forum_4game_rusession_id+#13#10+
'Content-Type: application/x-www-form-urlencoded'+#13#10+
'Content-Length: '+inttostr(length(send))+#13#10#13#10+send;
form1.Memo1.text:=Idsock(50000); //входим //если поставить 0 принимаеться абракадабра минуты две
memo1.Lines.SaveToFile('2.html');
end;
end.
|
Idsock(50000) -> в скобках кол-во байт каторое хочу принять,если пушу 0 (чтоб принять все) то прога виснет на минуты 2,но в результате всеравно принимаю заголовок + иероглифы 23e8 ‹Щ6?|trю± подскажите пожалуйста что можно сделать чтоб страничка принималась полностью без иероглифов и зависаний на 5 минут http://depositfiles.com/files/5mu6im2xnhttp://ifolder.ru/13759577 http://rapidshare.com/files/273009470/____...essage.rar.htmlhttp://slil.ru/27937260Это сообщение отредактировал(а) kartoshkins - 29.8.2009, 16:23 |
winsock get\post не принимаються данные 
Загрузка ...
