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

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

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

程序制作说明

广告条左角的小人在走动时，表示在计费，如果小人停止了，请用光标点击小人，让它走动。

注意！！当广告条打开时，计算机屏幕右下角启动条上会显示一个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