Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted as Delphi by Shady ( 16 years ago )
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  StdCtrls, IdCookieManager, IdAntiFreezeBase, IdAntiFreeze, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Button2: TButton;
    IdCookieManager1: TIdCookieManager;
    Memo4: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    IdAntiFreeze1: TIdAntiFreeze;
    Memo1: TMemo;
    Timer1: TTimer;
    Edit4: TEdit;
    Edit5: TEdit;
    Button3: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button4: TButton;
    Memo2: TMemo;
    Edit6: TEdit;
    Label6: TLabel;
    Edit7: TEdit;
    Memo3: TMemo;
    Memo5: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
   procedure OnMyError(E: TExeption);
  public
    { Public declarations }
    stop:integer;
  end;

var
  Form1: TForm1;
implementation
var
hash, wallhash:string;
min, sec: integer;
function decode_vk_hash(hash:string):string;
var
preresult:string;
i:integer;
begin;
preresult:=Copy(hash,length(hash)-4)+Copy(hash,5,length(hash)-12);
result := '';
for i := 0 to Length(preresult)-1 do
result := result + preresult[Length(preresult)-i];
end;

function receive_wallhash(wallhash:string):string;
var firstdata:string;
begin
firstdata:=Copy(wallhash,Pos('{postWall',wallhash)+9,Pos(')}}"',wallhash)-Pos('{postWall',wallhash)-8);
result:=Copy(firstdata,Pos(',',firstdata)+3,Pos(')',firstdata)-Pos(',',firstdata)-4);
end;

function clean_pars(pars:string; memory:tstringlist):string;
var
i:integer;
begin
for i := 0 to memory.Count - 1 do
while pos(memory.strings[i],pars)<>0 do
delete(pars,pos(memory.Strings[i],pars)-23,length(memory.Strings[i])+23);
result:=pars;
end;


{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
PostData:TStringList;
shash, getdata:string;
begin
PostData:=TstringList.Create;
PostData.Add('op=a_login_attempt');
Idhttp1.Post('http://vkontakte.ru/login.php',PostData);
PostData.Clear;
PostData.Add('email='+edit1.Text);
PostData.Add('pass='+edit2.Text);
PostData.Add('expire=');
PostData.Add('vk=');
shash:=Idhttp1.Post('http://login.vk.com/?act=login',PostData);
PostData.Clear;
PostData.Add('s='+Copy(shash,Pos('value',shash)+7,56));
PostData.Add('op=slogin');
PostData.Add('redirect=1');
PostData.Add('expire=0');
PostData.Add('to=');
getdata:=IdHttp1.Post('http://vkontakte.ru/login.php',PostData);
PostData.Clear;
if Pos('logout', getdata)<>0 then
Label1.Caption:='авторизация удалась'
else
Label1.Caption:='авторизация не удалась';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
PostData1:Tstringlist;
i,k:integer;
label bye;
begin;
Application.ProcessMessages;
Timer1.Enabled:=True;
memo4.Lines.Clear;
k:=0;
PostData1:=TStringList.Create;
repeat
Application.ProcessMessages;
i:=0;
PostData1.Add('act=do_edit');
PostData1.Add('id='+Memo1.Lines.Strings[k]);
PostData1.Add('view=2');
PostData1.Add('edit=1');
PostData1.Add('Text='+Edit3.Text);
Memo4.Lines.Add('работаем с '+Memo1.Lines.Strings[k]);
  repeat
  if stop>0 then begin
   Memo4.Lines.Add('завершено');
   Timer1.Enabled:=False;
   exit;
  end;
  Idhttp1.Post('http://vkontakte.ru/pages.php',PostData1);
  memo4.Lines.Add(Inttostr(i));
  i:=i+1;
  until i=134;
PostData1.Clear;
k:=k+1;
until k=Memo1.Lines.Count;
bye:
Memo4.Lines.Add('завершено');
Timer1.Enabled:=False;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
stop:=1;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
pars, pars1, pars2, pagespars, idnumber1, idnumber2:string;
k:integer;
path, memory:tstringlist;
label meta, meta1, meta2, meta3;
begin
memory:=Tstringlist.Create;
path:=Tstringlist.Create;
path.Add(Edit6.Text);
memory.Add(Edit6.Text);
meta1:
memo2.Lines.Add('try'+path.Strings[path.Count-1]);
pars:=idhttp1.Get('http://vkontakte.ru/page'+path.Strings[path.Count-1]);
delete(pars,pos('/pages.php?o=-1&p=Merchant API',pars),20);
memo2.Lines.Add('1');
while pos('/pages.php?o=',pars)<>0 do  //заменяем ссылки вида pages.php на ссылки вида /page
begin
idnumber1:=copy(pars,pos('/pages.php?o=',pars));
delete(idnumber1,pos('">',idnumber1),length(idnumber1));
memo2.Lines.Add('tryto'+idnumber2);  // извлекаем ссылку вида pages.php
pagespars:=idhttp1.Get('http://vkontakte.ru'+idnumber1);
memo2.Lines.Add('2');
idnumber2:=copy(pagespars,pos('?act=history',pagespars)-50,62);
delete(idnumber2,1,pos('_',idnumber2));
delete(idnumber2,pos('?act=history',idnumber2),length(idnumber2));
insert('/page'+idnumber2,pars,pos(idnumber1,pars));
delete(pars,pos(idnumber1,pars),length(idnumber1));    // заменяем ссылку на ссылку вида /page
end;
pars:=clean_pars(pars, memory);                                                  // конец цикла
memo3.Text:=pars;
memo2.Lines.Add('3');
if pos('/page',pars)<>0 then goto meta;
if path.Count=1 then goto meta2;
path.Delete(path.Count-1);
goto meta1;
meta:
pars1:=copy(pars, pos('/page',pars));
pars2:=copy(pars1, pos('/page', pars1)+5, pos('">', pars1)-pos('/page', pars1)-5);
memo5.lines:=memory;
memory.Add(pars2);
path.Add(pars2);
memo2.Lines.Add('4');
goto meta1;
meta2:
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  min:=0;
  sec:=0;
  stop:=0;
  Timer1.Enabled:=False;
  OnError:=OnMyError;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
sec:=sec+1;
if sec>=60 then begin
  sec:=0;
  min:=min+1
end;
Edit4.Text:=IntToStr(min);
Edit5.Text:=IntToStr(sec);

end;

procedure Form1.OnMyError(E: TExeption);
begin
{}
end;


end.

 

Revise this Paste

Parent: 24248
Your Name: Code Language: