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

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

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

程序制作说明

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

 

  • 0
    点赞
  • 0
    收藏
  • 打赏
    打赏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:大白 设计师:CSDN官方博客 返回首页
评论 1

打赏作者

ZhuJunfeng

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值