проблемы с написанием проги для регестрации на blog.ru

[maloy_ya]

набросал прожку для авторегера на сайте blog.ru, но непонятно мне по каким приченам она не регестрируеться!! при отправке пост запроса снифер получает в ответ 200 ок но регестрация не происходит! вот собственно код программы:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, jpeg, IdCookieManager;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    Button3: TButton;
    IdHTTP1: TIdHTTP;
    regestration: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo4: TMemo;
    IdCookieManager1: TIdCookieManager;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure regestrationClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  inet:string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Lines.LoadFromFile('d:\temp\delphi\Projects\blogru\acc.txt');
end;

//procedure TForm1.Button2Click(Sender: TObject);
//var
  //str :string;
  //s,bb,i,b: integer;
//begin
//c:=memo1.Lines[i];
//for i to n do
  //begin

//label1.Caption:=str;
  //  end;
procedure TForm1.Button2Click(Sender: TObject);
var
a,a1,a2: string;
i,s,etc:integer;
begin
 // For s:=0 to  Memo2.Lines.Count-1 do
  //   ShowMessage(IntToStr(Integer(@i)));
  etc:=0;
      for i:=0 to etc do
        begin
          a:= memo1.Lines[i];
          a1:= Copy(a,1,Pos(':',a)-1);
          a2:= copy (a,Pos(':',a)+1,20);
          memo2.Text:=a1;
          memo3.Text:=a2;
          memo2.Lines.SaveToFile('File1.txt');
          memo3.Lines.SaveToFile('File2.txt');
        end;
end;
//procedure TForm1.IdCookieManager1Create(ASender: TObject;
 // ACookieCollection: TIdCookies);
//begin
  //IdCookieManager1.CookieCollection.Clear;
  //memo4.Text:= IdHTTP1.Get('http://blog.ru/registration/step1');
//end;

procedure TForm1.Button3Click(Sender: TObject);
var FS:TFileStream;
begin
  idHttp.CookieManager := IdCookieManager;
  //IdCookieManager1.CookieCollection.Clear;
  //memo4.Text:=Idhttp1.Get('http://blog.ru/registration/step1/submit');
  //memo4.Lines.SaveToFile('file3.txt');
 FS:=TFileStream.Create('captcha.jpg',FMCreate);
 IdHTTP1.Get('http://blog.ru/inc/captcha/image.php', FS);
 FS.Free;
 Image1.Picture.LoadFromFile('captcha.jpg');
end;

procedure TForm1.regestrationClick(Sender: TObject);
var
  Data:TStringList;
    begin
       Data:=TStringList.Create;
       Data.Add('user_data[nick]='+edit1.Text);
       Data.Add('user_data[email]='+memo2.Text);
       Data.Add('user_data[password]='+memo3.Text);
       Data.Add('user_data[password_confirm]='+memo3.Text);
       Data.Add('user_data[sex]=female');
       Data.Add('user_data[cоde]='+Edit2.Text);
       Data.Add('user_data[agreement]=1');
       inet:=IdHTTP1.Post('http://blog.ru/registration/step1', Data);
       memo4.Text:=inet;
       memo4.Lines.SaveToFile('file3.txt');


    end;
end.

прога крепко недоделана так что попрошу ногами не пинать!!может ли кто нибудь мне объяснил где я туплю??

[kangreon]

На сколько я заметил, IdHTTP не хочет получать куки =(
А точнее получает их но не передает серверу при последующих запросах.
Исправить это можно вот так

var
  c : string;
Begin
  ...
  IdHTTP.Get('http://blog.ru/registration/step1');
  c := IdHTTP.Response.RawHeaders.Values['Set-Cookie'];
  c := Copy(c,1,Pos(';',c));
  IdHTTP.Request.CustomHeaders.Add('Cookie: '+c);
  ...
end;

Ну и вот еще полный код регистрации =)

function TForm1.KD_RegBlogRu(IdHTTP : TIdHTTP; Image: TImage): Boolean;
var
  sl : TStringList;
  jpg : TJPEGImage;
  ms : TMemoryStream;
  c : string;
begin
  sl := TStringList.Create;
  jpg := TJPEGImage.Create;
  ms := TMemoryStream.Create;
  IdHTTP.Get('http://blog.ru/registration/step1');
  c := IdHTTP.Response.RawHeaders.Values['Set-Cookie'];
  c := Copy(c,1,Pos(';',c));
  IdHTTP.Request.CustomHeaders.Add('Cookie: '+c);
  IdHTTP.Get('http://blog.ru/inc/captcha/image.php',ms);
  ms.Seek(0,0);
  jpg.LoadFromStream(ms);
  ms.Free;
  Image.Picture.Assign(jpg);
  Image.Width := jpg.Width;
  Image.Height := jpg.Height;
  jpg.Free;
  sl.Add('user_data[nick]=' + Edit1.Text);
  sl.Add('user_data[email]=' + edit2.Text);
  sl.Add('user_data[password]=' + Edit3.Text);
  sl.Add('user_data[password_confirm]=' + Edit3.Text);
  sl.Add('user_data[sex]=male');
  sl.Add('user_data[c o d e]=' + InputBox('Êàï÷à', 'Ââåäèòå òåêñò ñ êàï÷è', ''));// Здесь в code убрать пробелы =)
  sl.Add('ih-service-name=&ih-username=&ih-password=&service-name=&username=&password=');
  sl.Add('user_data[agreement]=1');
  IdHTTP.HandleRedirects := True;
  IdHTTP.Post('http://blog.ru/registration/step1/submit',sl);
end;

Пример использования

  KD_RegBlogRu(IdHTTP1,Image1);

На форме должны быть 3 компонента TEdit и один компонент TImage

[maloy_ya]

спасибо большое за помощь!!!но помоги еще немного плиз!!! что то я функию когда всовываю в форму он даже на едиты материться что не понимает их!!!не могу сняит чихлы!!блин

[Пепел Феникса]

эти компоненты нужно на форму кинуть для начала.

[maloy_ya]

ребята я засунул все в процедуру и вот что у меня получилось:
procedure TForm1.regestrationClick(Sender: TObject);
var
sl : TStringList;
jpg : TJPEGImage;
ms : TMemoryStream;
c : string;
begin
sl := TStringList.Create;
jpg := TJPEGImage.Create;
ms := TMemoryStream.Create;
IdHTTP1.Get('http://blog.ru/registration/step1');
c := IdHTTP1.Response.RawHeaders.Values['Set-Cookie name'];
c := Copy(c,1,Pos(';',c));
IdHTTP1.Request.CustomHeaders.Add(' Cookie: '+c);
IdHTTP1.Get('http://blog.ru/inc/captcha/image.php',ms);
ms.Seek(0,0);
jpg.LoadFromStream(ms);
ms.Free;
Image1.Picture.Assign(jpg);
Image1.Width := jpg.Width;
Image1.Height := jpg.Height;
jpg.Free;
sl.Add('user_data[nick]=' + Edit1.Text);
sl.Add('user_data[email]=' + edit2.Text);
sl.Add('user_data[password]=' + Edit3.Text);
sl.Add('user_data[password_confirm]=' + Edit3.Text);
sl.Add('user_data[sex]=male');
sl.Add('user_data[code]=' + InputBox('Eai?a', 'Aaaaeoa oaeno n eai?e', ''));// Здесь в code убрать пробелы =)
sl.Add('ih-service-name=&ih-username=&ih-password=&service-name=&username=&password=');
sl.Add('user_data[agreement]=1');
IdHTTP1.HandleRedirects := True;
IdHTTP1.Post('http://blog.ru/registration/step1/submit',sl);
end;
снифер пишет на 2 гет и пост запросы 200 ок!!а регистрация не происходит!!и на сколько я смотрю куки он по прежнему не отправляет!!что делать??

[kangreon]

А зачем в строчке
c := IdHTTP1.Response.RawHeaders.Values['Set-Cookie name'];
name ?

При загрузки страницы в первый раз, сервер возвращает строчку

HTTP/1.1 200 OK
Server: nginx/0.8.15
Date: Sun, 11 Jul 2010 19:41:55 GMT
Content-Type: text/html; charset=utf-8
Transfer-Encoding: chunked
Connection: keep-alive
Keep-Alive: timeout=20
Set-Cookie: CSID=19eklparpikmpgrth6pk4e0v37; path=/; domain=.blog.ru
Expires: Thu, 19 Nov 1981 08:52:00 GMT
Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
Pragma: no-cache

eae

[maloy_ya]

Сообщение от kangreon

А зачем в строчке
c := IdHTTP1.Response.RawHeaders.Values['Set-Cookie name'];
name ?

При загрузки страницы в первый раз, сервер возвращает строчку

HTTP/1.1 200 OK
Server: nginx/0.8.15
Date: Sun, 11 Jul 2010 19:41:55 GMT
Content-Type: text/html; charset=utf-8
Transfer-Encoding: chunked
Connection: keep-alive
Keep-Alive: timeout=20
Set-Cookie: CSID=19eklparpikmpgrth6pk4e0v37; path=/; domain=.blog.ru
Expires: Thu, 19 Nov 1981 08:52:00 GMT
Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
Pragma: no-cache

eae

это был минутный тупик!!!сразу же исправил но прога по прежнему не пашет!!!

[kangreon]

А какая у вас версия Indy установлена?

PS Исходник + exe в архиве

[maloy_ya]

Сообщение от kangreon

А какая у вас версия Indy установлена?

PS Исходник + exe в архиве

огромное спасибо за помощь! не перевелись всетаки добрые люди в нашем рунете!!!

ps я вроде так вашу функцию и вставлял!!! может это правда из-за версии!!у меня щас 9.00.10. эт галимоватая??переустанавливать??

[maloy_ya]

благодаря kangreon спасибо ему огромное прога начала регать аккаунты!!я туда всунул модуль работы с антикапча, но столкнулся с проблемой дальнейшей обработки аккауунта! При попытке спарсить нужные компоненты из страницы залогиненного аккаунта он в ответ выдает мне исходную страничку кода! Подскажите как его заставить невыходя из акка продолжать работу! вот как я пытаюсь это сделать:

procedure TForm1.Button2Click(Sender: TObject);
var
a,a1,a2: string;
i,etc:integer;
begin
memo1.Lines.LoadFromFile('acc.txt') ;
memo4.Lines.LoadFromFile('blogs.txt ');
if Memo1.Lines.Count<>0 then // проверка ненулевого количества строк
for i:=0 to Memo1.Lines.Count-1 do // задается цикл, равный кол-ву строк
etc:=memo1.Lines.Count-1;
memo2.Clear;
memo3.Clear;
for i:=0 to etc do
begin
a:= memo1.Lines[i];
a1:= Copy(a,1,Pos(':',a)-1);
a2:= copy (a,Pos(':',a)+1,20);
memo2.Lines.Add(a1);
memo3.Lines.Add(a2);
KD_RegBlogRu(IdHTTP1,image1,i);
end;

end;
function TForm1.KD_RegBlogRu(IdHTTP : TIdHTTP; Image: TImage; i:integer): Boolean;
var
sl : TStringList;
jpg : TJPEGImage;
ms : TMemoryStream;
c, res : string;
// FS:TFileStream;
begin
sl := TStringList.Create;
jpg := TJPEGImage.Create;
ms := TMemoryStream.Create;
IdHTTP.Get('http://blog.ru/registration/step1');
c := IdHTTP.Response.RawHeaders.Values['Set-Cookie'];
c := Copy(c,1,Pos(';',c));
IdHTTP.Request.CustomHeaders.Add('C ookie: '+c);
IdHTTP.Get('http://blog.ru/inc/captcha/image.php',ms);
ms.Seek(0,0);
jpg.LoadFromStream(ms);
ms.Free;
Image.Picture.Assign(jpg);
Image.Width := jpg.Width;
Image.Height := jpg.Height;
jpg.SaveToFile('captcha.jpg');
jpg.Free;
sl.Add('user_data[nick]=' + memo4.Lines[i]);
sl.Add('user_data[email]=' + memo2.lines[i]);
sl.Add('user_data[password]=' + memo3.Lines[i]);
sl.Add('user_data[password_confirm]=' + memo3.lines[i]);
sl.Add('user_data[sex]=female');
sl.Add('user_data[code]='+ recognize(filenameedit.Text,apikeye dit.Text,false,false,false,0,0)); //InputBox('Eai?a', 'Aaaaeoa oaeno n eai?e', ''));
sl.Add('ih-service-name=&ih-username=&ih-password=&service-name=&username=&password=');
sl.Add('user_data[agreement]=1');
IdHTTP.HandleRedirects := True;
res:=IdHTTP.Post('http://blog.ru/registration/step1/submit',sl);
postblog(IdHTTP1);
memo1.Text:=res;
memo1.Lines.SaveToFile('File2.txt') ;
if pos('logout', res)<>0 then
label2.Caption:='неcoздано'+memo2.L ines[i]
else
label2.Caption:='создано'+memo2.Lin es[i];
end;

function recognize(filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;
var
ftype,tmpstr,captcha_id: String;
i: integer;
http: TIdHTTP;
multi: Tidmultipartformdatastream;
begin
//сдесь запрос на антикапчу. Форум не позволил настолько много всунуть в сообщение!!
end;
function TForm1.Pars(T_, ForS, _T: string): string;
var
a, b: integer;
begin
Result := '';
if (T_ = '') or (ForS = '') or (_T = '') then
Exit;
a := Pos(T_, ForS);
if a = 0 then
Exit
else
a := a + Length(T_);
ForS := Copy(ForS, a, Length(ForS) - a + 1);
b := Pos(_T, ForS);
if b > 0 then
Result := Copy(ForS, 1, b - 1);
end;
function TForm1.postblog(IdHTTP : TIdHTTP): Boolean;
var
id, key, zapros : string;
begin
memo5.Lines.LoadFromFile('for event.txt');
zapros:=IdHTTP.Get('http://blog.ru/post_insert_form');
memo6.lines.Add(zapros);
id:=Pars('id="id_blog" value="',zapros,'"');
memo_id.Text:=id;
memo_id.Lines.SaveToFile('id.txt');

end;

скажите что не так??