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.