如何使广告条自动运行，仅供学习参考

各位程序员，大家辛苦了！！！

今天我一同事要我为他赚钱的东东做一个作弊程序，出于好玩，就即兴做了一个，现在贴出来让大家参考参考。我本对这类东西不感兴趣，赚钱是假，学习是真。但是看到点数快速的增加，不免也感到非常开心，不敢独享，所以一方面让大家一起学习探讨，一方面让大家赚点小钱，一方面我也可以发展几个下线。。。呵呵

程序制作说明

广告条左角的小人在走动时，表示在计费，如果小人停止了，请用光标点击小人，让它走动。
注意！！当广告条打开时，计算机屏幕右下角启动条上会显示一个CASHSURFERS"$"图标，当它是绿色时，表示在计费。- 正在赚点 （任务栏上的图标为绿色） 每隔一段时间，CASHSURFERS"$"图标就会变红. - 停止
赚点（任务栏上的"$"图标为红色） 广告条在任务栏上的"$"图标变红或小人坐下时请在广告条上移动鼠标 ，此时小人会拍拍手站起来走，如果不行请点击广告后在广告条上移动鼠标。 小人如果跑到广告条里去就要点 击他，让他回到广告条左侧，否则不会继续放广告。 技巧：当小人开始走进广告条里面时，在小人前方点击鼠 标他马上会回去，时间不会超过10 秒。CashFiesta每月付款，50美元起付，未满则累积至下月。

根据以上说明，我们可以通过移动鼠标和点击鼠标来完成广告条的自动运行。

并且考虑到无人模式和有人模式，分别做不同的处理工作。无人的情况下可以由程序自动完成，有人的情况下，仅当广告条不活动时做声音提示。

废话不说了，源代码如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,MMSystem;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo2: TMemo;
    CheckBox1: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function HexB(B:Byte):string;
    function IsRun:boolean;
    procedure Step1;
    procedure Step2;
    procedure CloseIE;
  public
    { Public declarations }
  end;

  function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;stdcall;

var
  Form1: TForm1;
  IsStep2:boolean;

const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';

  pManX:integer=45;//小人中心的位置
  pManY:integer=721;//小人中心的位置

  pManColor:integer=9355247;//小人身上的颜色
  pManDownX:integer=44;//小人坐下时头顶的坐标
  pManDownY:integer=710;//小人坐下时头顶的坐标
  pManDownColor:string='FFCC00';//小人头顶的颜色

implementation

{$R *.dfm}
function TForm1.HexB(B:Byte):string;//16进制转换成字符串
begin
  HexB:=Digits[B shr 4]+Digits[B and $F];
end;

function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;//回调函数
var
  lpszWindowText:array[0..255] of char;
  WndText:string;
begin
  GetWindowText(AhWnd,lpszWindowText,256);
  WndText:=StrPas(lpszWindowText);
  if Pos('Microsoft Internet Explorer',WndText)>0 then//如果是ie窗口则关闭
  begin
    PostMessage(AhWnd,WM_CLOSE,0,0);
    PostMessage(AhWnd,WM_QUIT,0,0);
  end;
  Result:=True;
end;

procedure TForm1.CloseIE;
begin
  EnumWindows(@EnumWindowsProc,LongInt(self));
end;

procedure TForm1.Step1;
var
  i:integer;
begin
  SetCursorPos(pManDownX,pManDownY);//小人坐下时，把鼠标移至小人头顶，然后移动鼠标激活广告条
  for i:=1 to 10 do
  begin
    mouse_event(MOUSEEVENTF_MOVE,0,1,0,0);
    Application.ProcessMessages;
  end;
end;

procedure TForm1.Step2;//小人走开时，检索小人的位置，并点击他，激活广告条
var
  BkColor:TColor;
  X,Y:integer;
  dc:HDC;
begin
  IsStep2:=True;
  X:=pManX;
  Y:=pManY;
  dc:=GetDC(0);

  while (X<1000) and (IsStep2) do
  begin
    BkColor:=GetPixel(dc,X,Y);
    if (BkColor<pManColor+1000000) and (BkColor>pManColor-1000000) then//检索小人
    begin
      SetCursorPos(X,Y);
      mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
      mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
//      break;
    end;
    X:=X+1;
    Application.ProcessMessages;
  end;
  IsStep2:=False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  X,Y:integer;
begin
  if IsStep2 then Exit;
  if not CheckBox1.Checked then//无人模式下，随机移动鼠标，防监测
  begin
    Randomize;
    x:=Random(1024);
    y:=Random(768);
    SetCursorPos(x,y);
    mouse_event(MOUSEEVENTF_MOVE,1,0,0,0);
  end;
  if IsRun then
  begin
    Label2.Font.Color:=clGreen;
    Timer1.Tag:=0;
    exit;
  end;
  if CheckBox1.Checked then//在工作模式下，如果广告条不计点了，就用声音提醒，不做其他操作，以免影响计算机的使用
  begin
    SndPlaySound('c:\windows\media\tada.wav',SND_ASYNC);
    Exit;
  end;
  Label2.Font.Color:=clRed;
  if Timer1.Tag=1 then
  begin
    Step2;
    CloseIE;
    Timer1.Tag:=0;
    Memo2.Lines.Add(TimeToStr(now)+' step2');
  end
  else
  begin
    Step1;
    Timer1.Tag:=1;
    Memo2.Lines.Add(TimeToStr(now)+' step1');
  end;
end;

function TForm1.IsRun:boolean;//判断小人是否在走动
var
  BkColor:TColor;
  R,G,B:Byte;
  HStr:string;
begin
  BkColor:=GetPixel(GetDC(0),pManDownX,pManDownY);
  R:=GetRValue(BkColor);
  G:=GetGValue(BkCOlor);
  B:=GetBValue(BkColor);
  HStr:=HexB(R)+HexB(G)+HexB(B);
  if HStr=pManDownColor then
    Result:=False
  else
    Result:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=not Timer1.Enabled;
  if Timer1.Enabled then
  begin
    Button1.Caption:='Click To Stop';
    Label1.Font.Color:=clGreen;
  end
  else
  begin
    Button1.Caption:='Click To Start';
    Label1.Font.Color:=clRed;
    IsStep2:=False;
  end;
end;

end.

我的广告条是在1024*768的方式下运行的，而且是放在屏幕下方，如果您的设置与我不一样，请调整几个常量的值（pManX,pManY,pManDownX,pManDownY）。

源代码下载http://ono.3322.org/mysoft/cash.zip

赚钱详尽注册方法http://ono.3322.org/bbs/dispbbs.asp?boardID=2&RootID=19&ID=19

如果注册的话，请别忘了加上我的ID，看在我写了这么多的面子上吧。

注册地址：http://www.cashfiesta.com/php/join.php?ref=ericss

 

本文地址：http://com.8s8s.com/it/it5457.htm