День добрый!
В социалной сети Вконтакте есть игра "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.