unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, HttpSend;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

  THTTPSend_ = class helper for THTTPSend
  public
    function HeaderNameByIndex(index: integer): string;
    function HeaderByName(const HeaderName: string): string;
    // function HTTPMethod(const Method, URL: string): Boolean;
  end;

var
  Form1: TForm1;
  UserKey: string;

implementation

uses md5, zstream{,synautil};

function GetIp: string;
var
  HTTP: THTTPSend;
  s, c: string;
  i, n: integer;
  ss: TStringList;
begin
  Result := '';
  HTTP := THTTPSend.Create;
  ss := TStringList.Create;
  try
    if HTTP.HTTPMethod('GET', 'http://rl.ammyy.com') then
    begin
      ss.LoadFromStream(HTTP.Document);
      if ss.Count >= 1 then
      begin
        s := ss[0];
        c := '';
        n := 0;
        for i := 1 to Length(s) do
        begin
          if s[i] = ',' then
            break;
          if n = 1 then
            c := c + s[i];
          if s[i] = '=' then
            n := n + 1;
        end;
      end;
    end;
  finally
    HTTP.Free;
    Result := c;
    ss.Free;
  end;
end;

function GetUserKey: string;
var
  userAgent: string;
  ip: string;
  scrVar: string;
  str: string;
begin
  ip := GetIP;
  userAgent :=
    'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/51.0.2704.103 Safari/537.36';
  scrVar := IntToStr(Screen.DesktopWidth * Screen.DesktopHeight * 24);
  str := format('%s : %s : %s', [ip, userAgent, 'win32' + scrVar]);
  Result := MD5Print(MD5String(str));
end;

function THTTPSend_.HeaderNameByIndex(index: integer): string;
begin
  if (index > (Headers.Count - 1)) or (index < 0) then
    Exit;
  Result := copy(Headers[index], 0, pos(':', Headers[index]) - 1);
end;

function THTTPSend_.HeaderByName(const HeaderName: string): string;
var
  i: integer;
begin
  for i := 0 to Headers.Count - 1 do
  begin
    if LowerCase(HeaderNameByIndex(i)) = lowercase(HeaderName) then
    begin
      Result := copy(Headers[i], pos(':', LowerCase(Headers[i])) +
        2, Length(Headers[i]) - length(HeaderName));
      break;
    end;
  end;
end;

{
function THTTPSend_.HTTPMethod(const Method, URL: string): Boolean;
var Heads: TStringList;
    Cooks: TStringList;
    Redirect: string;
    Doc:TMemoryStream;
begin
  try
    Heads:=TStringList.Create;
    Cooks:=TStringList.Create;
    Doc:=TMemoryStream.Create;
    Doc.LoadFromStream(Document);
    Cooks.Assign(Cookies);
    Heads.Assign(Headers);
    Result:=inherited HTTPMethod(Method,URL);
    if (ResultCode=301)or(ResultCode=302) then
      begin
        Redirect:=HeaderByName('location');
        Headers.Assign(Heads);
        Document.Clear;
        Document.LoadFromStream(Doc);
        Cookies.Assign(Cooks);
        Result:=inherited HTTPMethod(Method,Redirect);
       end;
  finally
    FreeAndNil(Heads);
    FreeAndNil(Cooks);
    FreeAndNil(Doc)
  end;
end;}

{$R *.lfm}

{ TForm1 }
//var user_key = hex_md5('62.117.82.116'+':'+navigator.userAgent+':'+navigator.platform+((typeof(screen)!='undefined') ? ':'+screen.width+'*'+screen.height+'*'+(screen.colorDepth ?  screen.colorDepth : screen.pixelDepth):''));
procedure TForm1.Button1Click(Sender: TObject);
var
  hSend: THTTPSend;
  ss, content: TStringStream;
  pData: string;
  Gzf: TGZFileStream;
begin
  pdata := Format(
    'referer=http://www.yaplakal.com/&user_key=%s&UserName=%s&PassWord=%s&submit=Вход&CookieDate=1&Secure=1',
    [GetUserKey, '', '']);
  hSend := THttpSend.Create;
  ss := TStringStream.Create(pData);
  hSend.Document.LoadFromStream(ss);
  try
    hSend.UserAgent :=
      'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/51.0.2704.103 Safari/537.36';
    hSend.TargetHost := 'yaplakal.com';
    hSend.MimeType := 'application/x-www-form-urlencoded';
    hSend.KeepAlive := True;
    hSend.Headers.Add('Accept-Encoding: gzip,deflate');//заголовок
    hSend.Headers.Add('Upgrade-Insecure-Requests: 1');
    hSend.Headers.Add('Cache-Control: max-age=0');
    hSend.Headers.Add(
      'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8');
    hSend.Headers.Add('Referer: http://www.yaplakal.com/');
    hSend.Headers.Add('Accept-Language: ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4');
    hSend.Protocol := '1.1';//по умолчанию выставляется 1.0
    if hsend.HTTPMethod('post', 'http://www.yaplakal.com/act/Login/CODE/01/') then
    begin

      {if hsend.ResultCode=302 then begin}
      Memo1.Lines.Add('Отправка запроса. Ответ сервера');
      Memo1.Lines.Add('-----Cokies-----');
      Memo1.Lines.add(hSend.Cookies.Text);
      Memo1.Lines.Add('-----Headers-----');
      Memo1.Lines.add(hSend.Headers.Text);
      Memo1.Lines.Add('-----Data-----');
      hSend.Headers.NameValueSeparator := ':';
      // Memo1.Lines.Add(hSend.Headers.Values['Content-Encoding']);
      if (CompareText(trim(hSend.Headers.Values['Content-Encoding']), 'gzip') = 0) then
      begin
        //GetLocation()
        hSend.Document.SaveToFile('tmp.gz');
        gzf := TGZFileStream.Create('tmp.gz', gzopenread);
        // hSend.Document.SaveToStream(gzf);
        content := TStringStream.Create('');
        try
          content.CopyFrom(gzf, 0);
          Memo1.Lines.Text := content.DataString;
        finally
          gzf.Free;
          content.Free;
        end;
      end
      else
      begin
        content := TStringStream.Create('');
        try
          hSend.Document.Position := 0;
          hSend.Document.SaveToStream(content);

          Memo1.Lines.Add(content.DataString);
        finally
          // gzf.Free;
          content.Free;
        end;
      end;

      // end;
      {end else showmessage('Не получилось!');}

    end;
  finally
    ss.Free;
    hSend.Free;
  end;

  //  memo1.Lines.Add(GetUserKey);
end;

end.