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