PDA

Просмотр полной версии : регистрация вконтакте Delphi


Hack_ERR++
21.05.2010, 16:50
Хочу написать реггер с ручным вводом капчи. Помогите найти ошибки

var
Form1: TForm1;
uns:string;
post:tstringlist;
s:string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
stream:Tmemorystream;
begin
post:=tstringlist.create;
post.Add('act=register');
post.Add('first_name='+edit1.text);
post.Add('last_name='+edit2.text);
post.Add('regemail='+edit3.text);
post.Add('regpass='+edit4.text);
post.Add('sex='+edit5.text);
post.Add('timezone=240');
post.Add('by_login=0');
try
uns:=UTF8toANSI(idhttp1.post('http://vkontakte.ru/register.php', post));
s:=copy(uns,25,12);
finally
stream:=tmemorystream.create;
idhttp1.Get('/captcha.php?sid='+s, stream);
stream.SaveToFile('C:\\captcha.jpeg');
stream.Free;
image1.Picture.LoadFromFile('C:\\captcha.jpeg');
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
p:string;
begin
post.Add('captcha_sid='+s);
post.Add('captcha_key='+edit6.text);
idhttp1.post('http://vkontakte.ru/register.php', post);
post.Clear;
post.add('act=login');
post.add('try_to_login=1');
post.Add('vk=');
post.add('email='+edit3.text);
post.add('pass='+edit4.text);
try
uns:=UTF8toANSI(idhttp1.post('http://vkontakte.ru/login.php/', post));
p:=copy(uns,286,56);
finally
if p= '' then
memo1.Lines.add('Регистрация не удалась')
else
memo1.lines.add('Регистрация прошла успешно');
end;
end;
end.


При нажатии первой кнопки должна вылезти капча - тут все ясно, капча загружается успешно. Но вот зарегистрироваться не получается, не могу выдрать хэш из запроса логина (из запроса регистрации хэш выдирается успешно).

ilyhamas
21.05.2010, 16:56
Писал для себя. Есть антикапча

unit example;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdHttp, IdMultipartFormData, StdCtrls,StrUtils, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, sSkinManager, jpeg,
ComCtrls, TabNotBk, dblookup, Tabs, Spin;

function recognize(filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;
type
TForm1 = class(TForm)
Button1: TButton;
filenameedit: TEdit;
GroupBox1: TGroupBox;
Result: TGroupBox;
Image1: TImage;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
name: TEdit;
lname: TEdit;
mail: TEdit;
pass: TEdit;
IdHTTP1: TIdHTTP;
captchasid: TEdit;
apikeyedit: TEdit;
Button2: TButton;
Label6: TLabel;
Memo1: TMemo;
sSkinManager1: TsSkinManager;
Label1: TLabel;
code: TEdit;
Button3: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
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
if FileExists(filename)=false then begin result:='ERROR: file not found'; exit; end;
ftype:='image/pjpeg';
if strpos(Pchar(filename),'jpeg')<>nil then ftype:='image/pjpeg';
multi:=Tidmultipartformdatastream.Create;
multi.AddFormField('method','post');
multi.AddFormField('key',apikey);
multi.AddFile('file',filename,ftype);
if is_phrase=true then multi.AddFormField('phrase','1');
if is_regsense=true then multi.AddFormField('regsense','1');
if is_numeric=true then multi.AddFormField('numeric','1');
if min_len>0 then multi.AddFormField('min_len',inttostr(min_len));
if max_len>0 then multi.AddFormField('max_len',inttostr(max_len));

http:=TIdHTTP.Create(nil);
tmpstr:=http.Post('http://antigate.com/in.php',multi);
http.Free;
captcha_id:='';
if strpos(Pchar(tmpstr),'ERROR_')<>nil then begin result:=tmpstr; exit; end;
if strpos(Pchar(tmpstr),'OK|')<>nil then captcha_id:=AnsiReplaceStr(tmpstr,'OK|','');
if captcha_id='' then result:='ERROR: bad captcha id';
for i:=0 to 20 do
begin
Application.ProcessMessages;
sleep(5000);
http:=TIdHttp.Create(nil);
tmpstr:=http.Get('http://antigate.com/res.php?key='+apikey+'&action=get&id='+captcha_id);
http.Free;
if strpos(Pchar(tmpstr),'ERROR_')<>nil then begin result:=tmpstr; exit; end;
if strpos(Pchar(tmpstr),'OK|')<>nil then
begin
result:=AnsiReplaceStr(tmpstr,'OK|','');
exit;
end;
Application.ProcessMessages;
end;
result:='ERROR_TIMEOUT';

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
statusbar1.Panels[0].Text:='.::Распознование::.';
code.Text:='Получение ответа...';
Button1.Enabled:=false;
code.Text:=recognize(filenameedit.Text,apikeyedit. Text,false,false,false,0,0);
Button1.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
get1: String;
get: String;
data1: TStringList;
tf: TextFile;
begin
statusbar1.Panels[0].Text:='.::Регистрация аккуанта::.';
data1 := TStringList.Create;
data1.add('act=register');
data1.add('first_name='+name.text);
data1.add('last_name='+lname.text);
data1.add('regemail='+mail.text);
data1.add('regpass='+pass.text);
data1.add('sex=1');
data1.add('timezone=240');
data1.add('by_login=0');
data1.add('captcha_sid='+captchasid.text);
data1.add('captcha_key='+code.Text);
get1:=idhttp1.Post('http://vkontakte.ru/register.php', data1);
get:=copy(get1, 1,7);
if get ='{"do_lo' then
begin
memo1.Lines.add(mail.text+':'+pass.text);
assignfile(tf,'good.txt');
Append(tf);
writeln(tf, mail.text+':'+pass.text);
CloseFile(tf);
end
else
memo1.Lines.add('Ошибка! Попробуйте снова.');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
http: tidhttp;
data: TStringList;
otvet1: String;
otvet: String;
f: TMemoryStream;
begin
statusbar1.Panels[0].Text:='.::Капча получена::.';
f := TMemoryStream.create;
http := tidhttp.Create(nil);
data := TStringList.Create;
data.add('act=register');
data.add('first_name='+name.text);
data.add('last_name='+lname.text);
data.add('regemail='+mail.text);
data.add('regpass='+pass.text);
data.add('sex=2');
data.add('timezone=240');
data.add('by_login=0');
sleep(200);
otvet1 := http.Post('http://vkontakte.ru/register.php', data);
sleep(200);
otvet := copy(otvet1, 25, 12);
captchasid.Text := otvet;
sleep(200);
http.Get('http://vkontakte.ru/captcha.php?sid='+otvet, f);
f.SaveToFile('captcha.jpg');
image1.Picture.LoadFromFile('captcha.jpg');
f.Free;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
button1.Enabled:=false;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
button1.Enabled:=true;
end;

end.

Hack_ERR++
21.05.2010, 17:18
Не помогло. Еще есть у кого-нибудь варианты?

ilyhamas
21.05.2010, 19:15
Не помогло. Еще есть у кого-нибудь варианты?
Не знаю как у остальных, но у меня всё отлично регестрирует...

Berman
23.05.2010, 14:54
Писал для себя. Есть антикапча

unit example;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdHttp, IdMultipartFormData, StdCtrls,StrUtils, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, sSkinManager, jpeg,
ComCtrls, TabNotBk, dblookup, Tabs, Spin;

function recognize(filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;
type
TForm1 = class(TForm)
Button1: TButton;
filenameedit: TEdit;
GroupBox1: TGroupBox;
Result: TGroupBox;
Image1: TImage;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
name: TEdit;
lname: TEdit;
mail: TEdit;
pass: TEdit;
IdHTTP1: TIdHTTP;
captchasid: TEdit;
apikeyedit: TEdit;
Button2: TButton;
Label6: TLabel;
Memo1: TMemo;
sSkinManager1: TsSkinManager;
Label1: TLabel;
code: TEdit;
Button3: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
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
if FileExists(filename)=false then begin result:='ERROR: file not found'; exit; end;
ftype:='image/pjpeg';
if strpos(Pchar(filename),'jpeg')<>nil then ftype:='image/pjpeg';
multi:=Tidmultipartformdatastream.Create;
multi.AddFormField('method','post');
multi.AddFormField('key',apikey);
multi.AddFile('file',filename,ftype);
if is_phrase=true then multi.AddFormField('phrase','1');
if is_regsense=true then multi.AddFormField('regsense','1');
if is_numeric=true then multi.AddFormField('numeric','1');
if min_len>0 then multi.AddFormField('min_len',inttostr(min_len));
if max_len>0 then multi.AddFormField('max_len',inttostr(max_len));

http:=TIdHTTP.Create(nil);
tmpstr:=http.Post('http://antigate.com/in.php',multi);
http.Free;
captcha_id:='';
if strpos(Pchar(tmpstr),'ERROR_')<>nil then begin result:=tmpstr; exit; end;
if strpos(Pchar(tmpstr),'OK|')<>nil then captcha_id:=AnsiReplaceStr(tmpstr,'OK|','');
if captcha_id='' then result:='ERROR: bad captcha id';
for i:=0 to 20 do
begin
Application.ProcessMessages;
sleep(5000);
http:=TIdHttp.Create(nil);
tmpstr:=http.Get('http://antigate.com/res.php?key='+apikey+'&action=get&id='+captcha_id);
http.Free;
if strpos(Pchar(tmpstr),'ERROR_')<>nil then begin result:=tmpstr; exit; end;
if strpos(Pchar(tmpstr),'OK|')<>nil then
begin
result:=AnsiReplaceStr(tmpstr,'OK|','');
exit;
end;
Application.ProcessMessages;
end;
result:='ERROR_TIMEOUT';

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
statusbar1.Panels[0].Text:='.::Распознование::.';
code.Text:='Получение ответа...';
Button1.Enabled:=false;
code.Text:=recognize(filenameedit.Text,apikeyedit. Text,false,false,false,0,0);
Button1.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
get1: String;
get: String;
data1: TStringList;
tf: TextFile;
begin
statusbar1.Panels[0].Text:='.::Регистрация аккуанта::.';
data1 := TStringList.Create;
data1.add('act=register');
data1.add('first_name='+name.text);
data1.add('last_name='+lname.text);
data1.add('regemail='+mail.text);
data1.add('regpass='+pass.text);
data1.add('sex=1');
data1.add('timezone=240');
data1.add('by_login=0');
data1.add('captcha_sid='+captchasid.text);
data1.add('captcha_key='+code.Text);
get1:=idhttp1.Post('http://vkontakte.ru/register.php', data1);
get:=copy(get1, 1,7);
if get ='{"do_lo' then
begin
memo1.Lines.add(mail.text+':'+pass.text);
assignfile(tf,'good.txt');
Append(tf);
writeln(tf, mail.text+':'+pass.text);
CloseFile(tf);
end
else
memo1.Lines.add('Ошибка! Попробуйте снова.');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
http: tidhttp;
data: TStringList;
otvet1: String;
otvet: String;
f: TMemoryStream;
begin
statusbar1.Panels[0].Text:='.::Капча получена::.';
f := TMemoryStream.create;
http := tidhttp.Create(nil);
data := TStringList.Create;
data.add('act=register');
data.add('first_name='+name.text);
data.add('last_name='+lname.text);
data.add('regemail='+mail.text);
data.add('regpass='+pass.text);
data.add('sex=2');
data.add('timezone=240');
data.add('by_login=0');
sleep(200);
otvet1 := http.Post('http://vkontakte.ru/register.php', data);
sleep(200);
otvet := copy(otvet1, 25, 12);
captchasid.Text := otvet;
sleep(200);
http.Get('http://vkontakte.ru/captcha.php?sid='+otvet, f);
f.SaveToFile('captcha.jpg');
image1.Picture.LoadFromFile('captcha.jpg');
f.Free;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
button1.Enabled:=false;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
button1.Enabled:=true;
end;

end.

Ещё один [sensored], который присваивает себе мои сорсы.
http://pastie.org/924311
У тебя даже переменные так же называются.
Быдлокодер хренов.

Berman
23.05.2010, 15:00
Повторю, что весь мой софт бесплатный и доступен по адресу pub.vk1000.ru

VKRegger палится как бэкдор потому что в нём много работы с инетом.

Вирусов там нет + Исходник открытый http://pastie.org/924311

M_script_
24.05.2010, 07:37
палится как бэкдор потому что в нём много работы с инетом.
:confused:

Berman
24.05.2010, 08:55
:confused:
не в бекдоре :D, а в программе

.::f-duck::.
24.05.2010, 10:08
Программисты хреновы :\