
22.10.2009, 15:18
|
|
Banned
Регистрация: 25.11.2007
Сообщений: 62
С нами:
9715564
Репутация:
89
|
|
Сама функция (определение и распознавание капчи, детект валида / невалида, детект невалид. прокси). В параметрах передаем аккаунт вида mail  ass, и tidhttp компонент. "antikey" - ваш ас-ключ.
Код:
function login_vk (account : string; http : tidhttp) : string;
var
s, imageurl, captcha : widestring;
post : tstringlist;
fs : Tmemorystream;
begin
post := tstringlist.Create;
post.Add ('op=a_login_attempt');
s := httpget (http, 'http://vkontakte.ru/');
s := httppost (http, 'http://vkontakte.ru/login.php', post);
post.Clear;
if (countpos ('vklogin', s) = 0) and (countpos ('captcha_sid', s) = 0) then
begin
Result := 'falseproxy'; post.Free; exit;
end;
if countpos ('captcha_sid', s) <> 0 then
begin
fs := TmemoryStream.Create;
imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
post.Add ('op=a_login_attempt');
post.Add ('captcha_sid=' + imageurl);
try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
captcha := recognize ('jpg', antikey, fs);
while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
post.Add ('captcha_key=' + captcha);
s := httppost (http, 'http://vkontakte.ru/login.php', post);
fs.Free; post.Clear;
end;
if countpos ('captcha_sid', s) <> 0 then
begin
fs := TmemoryStream.Create;
imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
post.Add ('op=a_login_attempt');
post.Add ('captcha_sid=' + imageurl);
try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
captcha := recognize ('jpg', antikey, fs);
while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
post.Add ('captcha_key=' + captcha);
s := httppost (http, 'http://vkontakte.ru/login.php', post);
fs.Free; post.Clear;
end;
post.Add ('email=' + Extractproxy (account, '[^:]*[^:]', 0));
post.Add ('pass=' + Extractproxy (account, '[^:]*[^:]', 1));
post.Add ('expire=');
post.Add ('vk=');
s := httppost (http, 'http://login.vk.com/?act=login', post);
post.Clear;
if (countpos ('vklogin', s) > 0) and (http.ResponseCode = 302) then
begin
Result := 'false'; post.Free; exit;
end;
if ((countpos ('vklogin', s) > 0) and (http.ResponseCode = 200)) or (s = '') then
begin
Result := 'falseproxy'; post.Free; exit;
end;
post.Add ('op=slogin');
post.Add ('redirect=1');
post.Add ('expire=0');
post.Add ('to=');
post.Add ('s=' + deletestr (extract (s, '''s''\svalue=''[^'']*[^'']'), '''s'' value='''));
s := httppost (http, 'http://vkontakte.ru/login.php', post);
Result := 'true';
end;
Ну и пример использования:
Код:
procedure login;
var
http : tidhttp;
coo : tidcookiemanager;
s, account : widestring;
begin
http := tidhttp.create; http.handleredirects := true; http.readtimeout := 20000;
coo := tidcookiemanager.create; http.allowcookies := true; http.cookiemanager := coo;
account := 'vasya4333@mail.ru:mega-password';
showmessage (login_vk (http, account));
end;
***
А вот функции, треб. для работы этой функции (используются в каждом приложении) :
Код:
function httpGet (http : tidhttp; adr : widestring) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.Get (adr, str); except end;
Result := str.DataString;
str.Free;
end;
function httpPost (http : tidhttp; adr : widestring; post : tstringlist) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.post (adr, post, str); except end;
Result := str.DataString;
str.Free;
end;
function httpPostMulti (http : tidhttp; adr : widestring; post : Tidmultipartformdatastream) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.post (adr, post, str); except end;
Result := str.DataString;
str.Free;
end;
function ExtractProxy (const AInputString : string ; buf : string; pos : integer) : string;
var
r : TRegExpr;
begin
Result := '';
r := TRegExpr.Create;
try
r.Expression := buf;
r.Exec (AInputString);
Result := r.Match [0];
if pos = 1 then
begin
r.ExecNext;
Result := r.Match [0];
end;
finally r.Free;
end;
end;
function Extract (const AInputString : string ; buf : string) : string;
var
r : TRegExpr;
begin
Result := '';
r := TRegExpr.Create;
try
r.Expression := buf;
if r.Exec (AInputString) then
REPEAT
Result := r.Match [0];
UNTIL not r.ExecNext;
finally r.Free;
end;
end;
function deletestr (str, target : widestring) : widestring;
var
p : integer;
begin
while pos (target, str) > 0 do
begin
p := pos (target, str);
delete (str, p, length (target));
end;
Result := str;
end;
function countpos (const subtext: string; Text: string): Integer;
begin
if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then Result := 0 else Result := (Length(Text) - Length(StringReplace(Text, subtext, '', [rfReplaceAll]))) div Length(subtext);
end;
function recognize (itype: string; key: string; image : tmemorystream) : string;
var
ftype, s, id: string;
i: integer;
http: tidhttp;
multi: tidmultipartformdatastream;
begin
if strpos (pchar (itype), 'jpg') <> nil then ftype := 'image/pjpeg';
if strpos (pchar (itype), 'gif') <> nil then ftype := 'image/gif';
if strpos (pchar (itype), 'png') <> nil then ftype := 'image/png';
multi := Tidmultipartformdatastream.Create;
multi.AddFormField ('method', 'post');
multi.AddFormField ('key', key);
multi.AddObject ('file', ftype, 'UTF8',image, 'captcha.' + itype);
http := tidhttp.Create;
s := http.Post ('http://antigate.com/in.php', multi);
http.Free; multi.Free;
id := '';
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then id := AnsiReplaceStr (s, 'OK|', '');
if id = '' then result := 'ERROR: bad captcha id';
for i := 1 to 20 do
begin
sleep (5000);
http := tidhttp.Create;
s := http.Get ('http://antigate.com/res.php?key=' + key + '&action=get&id=' + id);
http.Free;
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then
begin
result := AnsiReplaceStr (s, 'OK|', '');
exit;
end;
end;
result := 'ERROR_TIMEOUT';
end;
Последний раз редактировалось Пуховой; 22.10.2009 в 15:24..
|
|
|
|
|
Здесь присутствуют: 4 (пользователей: 0 , гостей: 4)
|
|
|
|