分享
 
 
 

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

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

各位程序员,大家辛苦了!!!

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

程序制作说明

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

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有