Смена пароля ВК на Delphi

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Artist, 10 Jul 2010.

  1. Artist

    Artist Member

    Joined:
    10 Jul 2010
    Messages:
    89
    Likes Received:
    5
    Reputations:
    0
    Пишу программу которая меняет пароли в ВК
    Вот что получилось:
    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    var
    a,b: TStringList;
    s,c,e: string;
    begin
    b:=TStringList.Create;
    a:=TStringList.Create;
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/login.php',a);
    //Memo1.Text:=b.Text;
    Label6.Caption:='OK';
    if pos('captcha_sid',b.Text)<>0 then
    begin
    Label7.Caption:='OK';
    ShowMessage('Î_î Êàï÷à:)');
    end
    else
    b.Clear;
    a.Clear;
    a.Add('act=login');
    a.Add('email='+Edit1.Text);
    a.Add('pass='+Edit2.Text);
    b.Text:=IdHTTP1.Post('http://login.vk.com/',a);
    s:=copy(b.Text,285,56);
    //Memo2.Text:=b.Text;
    Label8.Caption:='OK';
    a.Clear;
    b.Clear;
    a.Add('s='+s);
    a.Add('op=slogin');
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/login.php',a);
    //Memo3.Text:=b.Text;
    Label9.Caption:='OK';
    a.Clear;
    b.Clear;
    IdHTTP1.Request.CustomHeaders.Add('Cookie: remixsid='+s);
    //b.Text:=IdHTTP1.Get('http://vkontakte.ru/profile.php');
    b.Text:=IdHTTP1.Get('http://vkontakte.ru/settings.php');
    //Memo4.Text:=b.Text;
    Label10.Caption:='OK';
    a.Clear;
    b.Clear;
    a.Add('act=change_pass');
    a.Add('subm=1');
    a.Add('old_password='+Edit2.Text);
    a.Add('new_password='+Edit3.Text);
    a.Add('confirm_password='+Edit3.Text);
    //IdHTTP1.Request.CustomHeaders.Add('Cookie: remixsid='+s);
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/settings.php',a);
    Memo5.Text:=b.Text;
    И тут в Memo5 должен быть примерно такой текст.
    Code:
    <html>
    <head>
    <meta http-equiv='content-type' content='text/html; charset=windows-1251' />
    </head>
    <body onload="document.getElementById('l').submit();">
    <form id='l' method='post' action='http://login.vk.com/?act=login&redirect=1'>
    <input type='hidden' name='email' id='email' value='xxxxxxxxx@mail.ru'>
    <input type='hidden' name='pass' id='pass' value='xxxxxxxxx'>
    <input type='hidden' name='to' id='to' value='c2V0dGluZ3MucGhwP209Mw--'>
    </form>
    </body>
    </html>
    Но мемо5 пустой.
    Буду признателен любой помощи.
    +Доп. вопрос: Почему у меня при пост запросе в мемо кириллица превращается в знаки вопросов?
    Win7,Delphi7
     
  2. 1n0y

    1n0y Active Member

    Joined:
    9 May 2009
    Messages:
    272
    Likes Received:
    276
    Reputations:
    2
    проверил, код рабочий. может у тебя тупо акк не валидный? :)

    +Доп. ответ: наверное вк тебе возвращает ответ в кодировке utf8. юзай что-то типа b.Text:=utf8toansi(IdHTTP1.Post('http://vkontakte.ru/settings.php',a));
     
  3. Artist

    Artist Member

    Joined:
    10 Jul 2010
    Messages:
    89
    Likes Received:
    5
    Reputations:
    0
    Еще один вопрос.
    Как вытянуть с текста id
    Code:
    </td><td style="vertical-align: top;">
     <div class="info">
      <dl class="clearFix">
       <dt>Имя:</dt><dd><a href='/id55119119'>Регина Бобронникова</a></dd><dt>Выпуск:</dt><dd>ЮИ СФУ</dd><dt>&nbsp;</dt><dd><span class='bbb'>Онлайн</span></dd>
      </dl>
      <div class="friendRowBtns" id="cats55119119"></div>
      <div class="friendRowBtns" id="res55119119"></div>
     </div>
    </td><td style="vertical-align: top;">
      <ul id="nav" style="margin: 0px; overflow: hidden; width: 130px;">
      <li><a onclick="cancelEvent(event); return writeToFriend(55119119)" href="mail.php?act=write&to=55119119">Отправить сообщение</a></li><li><a onclick='return removeFriend(55119119)' href="#">Убрать из друзей</a></li>
     </ul>
    </td></tr></tbody></table>
    </div><div class="result clearFix" id="fr_res41182462">
    
    <table cellspacing="0" cellpadding="0" border="0"><tbody><tr><td width="108">
     <div class="image">
      <a href="/id41182462"><img src="http://vkontakte.ru/images/question_b.gif" alt=""/></a>
     </div>
    </td><td style="vertical-align: top;">
     <div class="info">
      <dl class="clearFix">
       <dt>Имя:</dt><dd><a href='/id41182462'>Елизавета Макарова</a></dd><dt>Выпуск:</dt><dd>МГУ '10</dd>
      </dl>
      <div class="friendRowBtns" id="cats41182462"></div>
      <div class="friendRowBtns" id="res41182462"></div>
     </div>
    </td><td style="vertical-align: top;">
    Нужен id41182462 и id55119119
    Вот что накодил.
    Code:
    a,o: string;
    b,c,d,k,i: integer;
    begin
    for i:=1 to memo1.Lines.Count-1
    do
    repeat
    b:=pos('</dt><dd><a href=',Memo1.Lines[i])+21;
    o:=copy(Memo1.lines[i],b,10);
    c:=pos('>',o)-1;
    Delete(o,c,5);
    Memo2.Lines.Add(o) ;
    until  pos('</dt><dd><a href=',Memo1.Lines[i])=0;
    Но здесь он тупо пишет один айди в бесконечный цыкл.
    А надо сначало первый потом второй ну и так дальше.
    +Доп.Вопрос: Как сделать так чтобы при нажатие на кнопку программа остановилась, а при нажатие второй раз начала с того места где закончила.
     
  4. wolmer

    wolmer Member

    Joined:
    12 May 2009
    Messages:
    438
    Likes Received:
    97
    Reputations:
    9
    Вот мой код:
    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    var
     i, i2, len: integer;
     s: string;
    begin
     s:=memo1.text; //для delete
     len:=length('<dt>Имя:</dt><dd><a href=');
    
     while 1=1 do
      begin
        i:=pos('<dt>Имя:</dt><dd><a href=', s);
    
        if i<>0 then
         begin
           i:=i+len+4; //для добавления id
    
           while s[i]<>'''' do //если текущий символ не равен " ' " то...
            begin
              edit1.text:=edit1.text+s[i];
              inc(i);
            end;
    
           edit1.text:=edit1.text+';';
           delete(s, i-len-4, len);
         end
        else
         begin
           break; //если не нашли больше инфу о профилях, то break
         end;
      end;
    
     memo1.text:=s;
    end;
    В edit1.text будет это:
    55119119;41182462;

    то есть?
     
    #4 wolmer, 11 Jul 2010
    Last edited: 11 Jul 2010
  5. tracy

    tracy Elder - Старейшина

    Joined:
    24 Mar 2009
    Messages:
    244
    Likes Received:
    119
    Reputations:
    40
    Спарсить можно id
     
  6. 1n0y

    1n0y Active Member

    Joined:
    9 May 2009
    Messages:
    272
    Likes Received:
    276
    Reputations:
    2
    глобальная
    var
    pause:boolean;


    while pause=true then
    sleep(200);


    и делаешь обработчик для какойнибудь кнопки
    begin
    if pause=false then pause:=true
    else pause:=false;
    end;

    ну, процедуру с паузой надо запускать в отдельном потоке, или добавь туда процесс.мэссаджз, иначе форма повиснет и кнопку с паузой поюзать не получится :)
     
  7. mailbrush

    mailbrush Well-Known Member

    Joined:
    24 Jun 2008
    Messages:
    1,997
    Likes Received:
    996
    Reputations:
    155
    1n0y, объясни мне пожалуйста конструкцию:
    Code:
    while ... [B]then[/B]
     
    1 person likes this.
  8. Refqs

    Refqs Banned

    Joined:
    20 Feb 2010
    Messages:
    139
    Likes Received:
    56
    Reputations:
    27
    :D

    Пока тогда..

    Пока ушёл тогда нашёл :D
     
  9. 1n0y

    1n0y Active Member

    Joined:
    9 May 2009
    Messages:
    272
    Likes Received:
    276
    Reputations:
    2
    ну запарелся, бывает :)
    вам лижбы попредиратся :mad:
     
  10. Artist

    Artist Member

    Joined:
    10 Jul 2010
    Messages:
    89
    Likes Received:
    5
    Reputations:
    0
    Отправка в ЛС друзьям.
    Code:
    var
    a,b: TStringList;
    s,y,p,hash: string;
    o,c,m,n,g,h: integer;
    begin
    b:=TStringList.Create;
    a:=TStringList.Create;
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/login.php',a);
    if pos('captcha_sid',b.Text)<>0 then
    begin
    ShowMessage('戕ֈ');
    end
    else
    b.Clear;
    a.Clear;
    a.Add('act=login');
    a.Add('email='+Edit1.Text);
    a.Add('pass='+Edit2.Text);
    b.Text:=IdHTTP1.Post('http://login.vk.com/',a);
    s:=copy(b.Text,285,56);
    a.Clear;
    b.Clear;
    a.Add('s='+s);
    a.Add('op=slogin');
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/login.php',a);
    a.Clear;
    b.Clear;
    IdHTTP1.Request.CustomHeaders.Add('Cookie: remixsid='+s);
    b.Text:=IdHTTP1.Get('http://vkontakte.ru/friends.php') ;
    [COLOR=Red]y:=b.Text;
    repeat
    o:=pos('</dt><dd><a href=',y)+19;
    p:=(copy(y,o,50));
    c:=pos('>',p)-1;
    Delete(p,c,50);
    m:=pos('id',p);
    Delete(p,m,2);
    Memo5.Lines.Add(p) ;
    y:=copy(y,o,length(y)-o);
    until  (pos('</dt><dd><a href=',y)=0);[/COLOR]
    a.Clear;
    b.Clear;
    a.Add('act=a_write_box');
    a.Add('to=12501211');
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/mail.php',a);
    Memo3.Text:=b.Text;
    n:=pos('chas: decodehash(',b.Text)+18;
    g:=pos('), to_id:',b.Text)-1;
    h:=g-n;
    hash:=copy(b.Text,n,h);
    Memo2.Text:=hash;
    a.Clear;
    b.Clear;
    a.Add('act=sent');
    a.Add('ajax=1');
    a.Add('chas='+hash);
    a.Add('to=12501211');
    a.Add('title='+Edit3.Text);
    a.Add('message='+Memo6.Text);
    a.Add('from_box=1');
    a.Add('oid=');
    a.Add('vid=');
    a.Add('fid=');
    a.Add('aid=');
    b.Text:=IdHTTP1.Post('http://vkontakte.ru/mail.php',a);
    Memo1.Text:=b.Text;
    Отправляю на этого друга 12501211 сообщение.
    Снифаю программу все как в браузере только последний запрос не возвращает нечего и сообщение не отправляется.Отправляю на прямую на айди, код парсинга можно выкинуть(Красным цветом).В чем проблема?
    +Доп. вопрос: Почему у меня при пост запросе в мемо кириллица превращается в знаки вопросов?(Актуально)utf8toansi не помогло.
     
  11. 1n0y

    1n0y Active Member

    Joined:
    9 May 2009
    Messages:
    272
    Likes Received:
    276
    Reputations:
    2
    хеш надо декодировать. вбей в поиск по ачату "decodehash" и найдёшь рабочие сорцы.
     
  12. Artist

    Artist Member

    Joined:
    10 Jul 2010
    Messages:
    89
    Likes Received:
    5
    Reputations:
    0
    Все работает...
    Взял для декодирования хеша код RedFern.89

    Code:
    function DecChas(chas: string): string;
    var
     Decchas : string;
     str : string;
     I : Integer;
     Len : integer;
    begin
    
     str := Copy(chas, 6, 12);
     Len := Length(str);
    
     For I := 0 To Length(str) -1 do
     begin
      Decchas := Decchas + str[len];
      Inc(len, -1);
     end;
    
     str := Copy(chas, 21, Length(chas) -5);
     str := str + Copy(chas, 5, 1);
    
     Len := Length(str);
    
     For I := 0 To Length(str) -1 do
     begin
       Decchas := Decchas + str[len];
       Inc(len, -1);
     end;
    
     Result := Decchas;
    end;

    Хэш чтоб писать на стену.
    Закодирован 53864600b8f4ff6425154f60021c73f0b19cbbc
    Раскодирован f37c12006f4515246ff4f8b0064cbbc9

    Хэш для отправки в ЛС.
    Закодирован 3c03d75f65bd9c6dfe5b93d96
    Раскодирован fd6c9db56f57d69d39
    Теперь вопрос, все хэшы одной длины?и все по такому принципу кодирутся?
     
    #12 Artist, 12 Jul 2010
    Last edited: 12 Jul 2010