Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.02.2013, 02:10   #1
Sergio_O
Пользователь
 
Регистрация: 03.11.2010
Сообщений: 15
По умолчанию TChromium и Unity Player

День добрый!

В социалной сети Вконтакте есть игра "King's Bounty Legions". Работает она на Unity Player. В игре можно получить игровые деньги, переходя по ссылкам от других игроков. А поскольку я не такой задрот, чтобы еще и по ссылкам в новостях ходить, решил написать бота... В качестве компонента выбор пал на TChromium.
Суть такая:
Парсим новости, ищем нужные нам ссылки. Лайкаем (зачем, долго объяснять), удаляем новость, переходим по ссылке. И вот Chromium выпадает в Access Violation... Будут какие мысли?
P.S. При этом обычный TWebBrowser кушает Unity Player и не давиться... Придумал мега-костыль. Chromium лайкает, удаляет и складирует ссылки в файлики с ID ссылок, а вторая прога их подхватывает и открывает. Но это как-то толсто....
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cefvcl, cefgui, ceflib, StdCtrls, ExtCtrls, OleCtrls, SHDocVw;

type
  TKBClicker = class(TForm)
    Chromium: TChromium;
    Timer: TTimer;
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ChromiumLoadEnd(Sender: TObject; const browser: ICefBrowser;
      const frame: ICefFrame; httpStatusCode: Integer; out Result: Boolean);
    procedure TimerTimer(Sender: TObject);
    procedure AnalizeFeed(DOM: ICefDomDocument; Feed:ICefDomNode);
    procedure Button1Click(Sender: TObject);

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

var
  KBClicker: TKBClicker;
  KBMainLinks: TStringList;
  KBLikeLinks: TStringList;
  KBDelLinks: TStringList;

implementation

{$R *.dfm}

procedure TKBClicker.Button1Click(Sender: TObject);
begin
  Chromium.Browser.MainFrame.ExecuteJavaScript(Memo1.Text, '', 0);
end;

procedure TKBClicker.ChromiumLoadEnd(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; httpStatusCode: Integer; out Result: Boolean);
begin
  //Возможно страница не полностью загружена, перезапускаем таймер
  Timer.Enabled:= false;
  Timer.Enabled:= true;
end;

procedure TKBClicker.FormCreate(Sender: TObject);
begin
  Chromium.Browser.MainFrame.LoadUrl('vk.com');
  Timer.Interval:= 2000;
  Timer.Enabled:= true;
  KBMainLinks := TStringList.Create;
  KBLikeLinks := TStringList.Create;
  KBDelLinks := TStringList.Create;
end;

procedure TKBClicker.AnalizeFeed(DOM: ICefDomDocument; Feed: ICefDomNode);
var
  ID: string;
  KBLink: ICefDomNode;
begin
 ID:= Feed.FirstChild.GetElementAttribute('id');
 //Игнорим репосты
 if Pos('feed_repost', ID) <> 0 then
   Exit;
 Delete(ID, 1, 4);
 KBLink:= DOM.GetElementById('post_media_lnk' + ID + '_1');
 //Линк на KB
 if Assigned(KBLink) then
 begin
   KBMainLinks.Add('vk.com' + KBLink.GetElementAttribute('href'));
   //Свои линки игнорим
   if Pos('post=5413488', KBMainLinks[KBMainLinks.Count - 1]) <> 0 then
   begin
     KBMainLinks.Delete(KBMainLinks.Count - 1);
   end
   else
   begin
     KBLikeLinks.Add(DOM.GetElementById('like_link' + ID).Parent.GetElementAttribute('onclick'));
     KBDelLinks.Add(DOM.GetElementById('delete_post' + ID).GetElementAttribute('onclick'));
   end;
 end;
end;

procedure ShowLinks;
var
  i: integer;
begin
  KBClicker.Memo1.Lines.Clear;
  for i:= 0 to KBMainLinks.Count - 1 do
  begin
    KBClicker.Memo1.Lines.Add(KBMainLinks.Strings[i]);
    KBClicker.Memo1.Lines.Add(KBLikeLinks.Strings[i]);
    KBClicker.Memo1.Lines.Add(KBDelLinks.Strings[i]);
  end;

end;

procedure TKBClicker.TimerTimer(Sender: TObject);
var
  DOM: TCefFastDomVisitorProc;
begin
  //Таймер сработал, страница скорее всего загружена полностью
  Timer.Enabled:= false;
  //Надо залогиниться
  if (Chromium.Browser.MainFrame.Url = 'http://vk.com/') then
    Chromium.Browser.MainFrame.ExecuteJavaScript('quick_email.value = ''Email@domen.ru'';quick_pass.value =  ''pass'';quick_login_button.click();', '', 0)
  else
  //А вот и новости
  if (Chromium.Browser.MainFrame.Url = 'http://vk.com/feed') then
  begin
    //Магия с DOM
    Chromium.Browser.MainFrame.VisitDomProc(
    procedure (const DOM: ICefDomDocument)
    var
      DomNode: ICefDomNode;
    begin
      DomNode:= DOM.GetElementById('feed_rows');
      DomNode:= DomNode.FirstChild;
      while Assigned(DomNode) do
      begin
        //Парсим новость
        if DomNode.HasChildren then
          AnalizeFeed(DOM, DomNode);
        DomNode:= DomNode.NextSibling;
      end;
      ShowLinks;
      //Переход по первой ссылке и FAIL!
      if KBMainLinks.Count <> 0 then
      begin
        Chromium.Browser.MainFrame.ExecuteJavaScript(KBLikeLinks.Strings[0], '', 0);
        Chromium.Browser.MainFrame.ExecuteJavaScript(KBDelLinks.Strings[0], '', 0);
        Chromium.Browser.MainFrame.LoadUrl(KBMainLinks.Strings[0]);
      end;
    end
    );
  end;

end;

End.
Изображения
Тип файла: jpg 1234.jpg (75.0 Кб, 163 просмотров)
Sergio_O вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Компонент TChromium, Windows 8, DelphiXE3 mur3ick Компоненты Delphi 30 20.09.2015 15:56
TChromium+вкладки referent Компоненты Delphi 2 07.10.2012 14:58
TChromium post запрос orkus Работа с сетью в Delphi 2 04.08.2012 14:47
TChromium исходники, литература и тд. designer999 Компоненты Delphi 5 02.10.2011 01:36
Unity 3D bumer7721 Помощь студентам 0 10.06.2011 16:16