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

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

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

程序制作说明

广告条左角的小人在走动时，表示在计费，如果小人停止了，请用光标点击小人，让它走动。
注意！！当广告条打开时，计算机屏幕右下角启动条上会显示一个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;

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有