Показать сообщение отдельно

  #1  
Старый 22.10.2009, 15:18
Пуховой
Banned
Регистрация: 25.11.2007
Сообщений: 62
С нами: 9715564

Репутация: 89
По умолчанию

Сама функция (определение и распознавание капчи, детект валида / невалида, детект невалид. прокси). В параметрах передаем аккаунт вида mailass, и 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..
 
Ответить с цитированием