[PhoeniX]

Приветствую, старички Давно не виделись Как тут у вас, полная сессия?

А я вот по какому вопросу. Пытаюсь через IdHTTP сделать регистрацию в ICQ. Не спрашивайте "зачем", потом сам поделюсь исходником.

Довёл очередь запросов, заголовки и POST-запрос до побайтового совпадения с тем, что отображается в файрбаге. Но почему-то получаю каждый раз Invalid Date. У кого какие мысли по этому поводу возникают?

На форме связанные IdHTTP + IdSSLIOHandlerSocketOpenSSL + IdCookieManager + IdCompressionIntercept + IdCompressorZLib

Получение капчи:

Код:

procedure TfMain.Button1Click(Sender: TObject);
var
  ms: TMemoryStream;
  code, img: string;
begin
  code := IdHTTP1.Get('http://www.icq.com/join');
  
  img := code;
  code := LowerCase(code);
  while true do begin
    delete(code, 1, pos('<input', code)+6);
    if pos('name="karmasynckey"',code) < pos('<input',code) then break;
  end;
  delete(code, 1, pos('value="', code)+6);
  code := copy(code, 1, pos('"',code)-1);
  code := UpperCase(code);
  Self.sync_key := code;

  code := img;

  while true do begin
    delete(img, 1, pos('<img', img)+4);
    if pos('src="https://www.icq.com/utils/captcha',img) < pos('<img',img) then break;
  end;
  delete(img, 1, pos('src="', img)+5);
  img := copy(img, 1, pos('"',img)-1);

  while true do begin
    delete(code, 1, pos('<input', code)+6);
    if pos('name="gnm"',code) < pos('<input',code) then break;
  end;
  delete(code, 1, pos('value="', code)+6);
  code := copy(code, 1, pos('"',code)-1);
  code := UpperCase(code);

  Self.cap_code := code;

  ms := TMemoryStream.Create;
  IdHTTP1.Get(img,ms);
  ms.Seek(0,0);
  Image1.Picture.Graphic := TJPEGImage.Create;
  Image1.Picture.Graphic.LoadFromStream(ms);
  ms.Free;
end;

Запрос на регистрацию:

Код:

function TfMain.URLEncode(s: string): string;
var
  i: integer;
begin
  s:=UTF8Encode(s);
  Result:='';
  for i:=1 to length(s) do
    if s[i] in ['0'..'9','a'..'z','A'..'Z','.'] then
      Result := Result + s[i]
    else begin
      Result := Result + '%' + IntToHex(ord(s[i]),2);
    end;
end;

procedure TfMain.Button3Click(Sender: TObject);
var
  ms: TMemoryStream;
  prms: String; prmsl: TStringList;
begin
  prms :=        'karmaSyncKey='+URLEncode(Self.sync_key);
  prms := prms + '&first_name='+URLEncode(Edit2.Text);
  prms := prms + '&last_name='+URLEncode(Edit3.Text);
  prms := prms + '&email='+URLEncode(Edit4.Text);
  prms := prms + '&password='+URLEncode(Edit1.Text);
  prms := prms + '&retype_password='+URLEncode(Edit1.Text);
  prms := prms + '&birthday_day='+URLEncode(IntToStr(StrToInt(copy(MaskEdit1.Text,1,2))));
  prms := prms + '&birthday_month='+URLEncode(IntToStr(StrToInt(copy(MaskEdit1.Text,4,2))));
  prms := prms + '&birthday_year='+URLEncode(IntToStr(StrToInt(copy(MaskEdit1.Text,7,4))));
  prms := prms + '&gender='+URLEncode(IntToStr(Integer(RadioButton2.Checked)+1));
  prms := prms + '&captcha='+URLEncode(Edit5.Text);
  prms := prms + '&gnm='+URLEncode(Self.cap_code);

  prmsl := TStringList.Create;
  prmsl.Text := prms;
  ms := TMemoryStream.Create();
  try
    IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
    IdHTTP1.Request.Referrer := 'http://www.icq.com/join';
    // User-agent задан в параметрах IdHTTP
    IdHTTP1.Post('http://www.icq.com/join',prmsl,ms);
  except
  end;
  prmsl.Free;
  ms.SaveToFile('C:\reg.html');

  ms.free;
  ShowMessage('ok');
end;

Мда, ни подсветки паскалевского синтаксиса, ни спойлеров до сих пор не сделали...

[Pyro]

Привет,
может флеш-cookies использует? когда сидел без флеша, и в браузере при регистрации icq всегда получал что-то вроде session timed-out

[PhoeniX]

Включил FlashBlock, ничего подозрительного не заметил, да и в Indy Cookies при просмотре заголовков совпадают с браузерными...

[Pyro]

js тоже ничего лишнего не отправляет?

[PhoeniX]

При отключенном JS рега работает аналогичным образом (никак)... Видимо, таки JS. Поищу, где может быть. Хотя, способ странный.

[M.A.D.M.A.N.]

Ты сниффером смотрел что передается? У меня просто подобная ситуация была, сервак тупо ошибку возвращал, оказывается в параметре букву надо было большой указать.

[PhoeniX]

firebug-ом просмотрел все заголовки, довёл всё до побайтового сходства.

[PhoeniX]

В общем, Indy'йский косяк.
Сначала он для TStringList давал кривой Content-Length (решил при помощи потоков). Теперь отдаёт не все куки, которые получил. Все параметры проверил по нескольку раз - он ДОЛЖЕН отдавать всё, но... не отдаёт