会delphi的帮编译下这个程序

zhagen2

会delphi的帮编译下这个程序

wuyou高手多，上来求助下，虽然不是启动相关技术，除了wuyou没怎么呆过别的坛子，觉得无关的谅解下。

最近在用一款软件，但总是自动退出，
博客里有人写了一个delphi程序模拟鼠标点击可以解决这个问题。


http://hi.baidu.com/beyond0769/b ... dfd316b21bbae2.html





要在可视面板上建立4个button     3个lable 2个edit 一个panel 一个计时器 一个checkbox。
我拖了个界面，可没有功能。

请懂delphi的帮着看看，方便的话给个编译好的文件。
我是下面这样建的，编译成了，可是好像不行。



Unit1.dfm，Unit1.pas，Project1.dpr




Unit1.pas内容为



//++++++++++++++++++++ 程序源代码开始 ++++++++++++++++++++++++++++++

unit Unit1;

interface

uses
     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
     Dialogs, StdCtrls, ExtCtrls, ComCtrls, TlHelp32, Registry;

type
     TForm1 = class(TForm)
         Button2: TButton;
         Button3: TButton;
         Timer1: TTimer;
         Label1: TLabel;
         Edit1: TEdit;
         Edit2: TEdit;
         Label2: TLabel;
         Label3: TLabel;
         Panel1: TPanel;
         Button1: TButton;
         Button4: TButton;
     Check: TCheckBox;
         procedure Timer1Timer(Sender: TObject);
         procedure Button2Click(Sender: TObject);
         procedure Button3Click(Sender: TObject);
         procedure FormCreate(Sender: TObject);
         procedure Button1Click(Sender: TObject);
         procedure FormKeyDown(Sender: TObject; var Key: Word;
             Shift: TShiftState);
         procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
         procedure Button4Click(Sender: TObject);
     procedure CheckClick(Sender: TObject);
     private
         procedure MinAllWindows;
         procedure ToDblClick;
         procedure AutoRun(Flag: Boolean);
     public
         { Public declarations }
     end;

var
     Form1: TForm1;
     iTime: integer; //累计时间；
     s: string; //密码
     Locked: Boolean; //是否锁定
implementation

{$R *.dfm}

{ TForm1 }

function CheckTask(ExeFileName: string): Boolean; //检测XX进程是否存在函数
const
     PROCESS_TERMINATE = $0001;
var
     ContinueLoop: BOOL;
     FSnapshotHandle: THandle;
     FProcessEntry32: TProcessEntry32;
begin
     result := False;
     FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
     FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
     ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
    while integer(ContinueLoop) <> 0 do begin
        if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
            or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
             result := True;
         ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
     end;
end;

function KillTask(ExeFileName: string): integer; // 把XX进程结束掉的函数
const
     PROCESS_TERMINATE = $0001;
var
     ContinueLoop: Boolean;
     FSnapshotHandle: THandle;
     FProcessEntry32: TProcessEntry32;
begin
     result := 0;
     FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
     FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
     ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
    while integer(ContinueLoop) <> 0 do begin
        if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
             UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
             UpperCase(ExeFileName))) then
             result := integer(TerminateProcess(
                 OpenProcess(PROCESS_TERMINATE,
                BOOL(0),
                 FProcessEntry32.th32ProcessID),
                 0));
         ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
     end;
     CloseHandle(FSnapshotHandle);
end;

procedure TForm1.MinAllWindows; //最小化所有窗口的过程，有两招哦。
var h: HWnd;
begin
    //Form1.WindowState:=wsMinimized;
    // 第一招，检测当前所有可视窗口，逐一最小化。
     h := Handle;
    while h > 0 do begin
        if IsWindowVisible(h) then
             Postmessage(h, WM_SYSCOMMAND, SC_MINIMIZE, 0);
         h := GetnextWindow(h, GW_HWNDNEXT);
     end;

    //还有一招，直接给操作系统发送一个 Win + D 组合键，轻松搞定。

     keybd_event(91, MapVirtualKey(91, 0), 0, 0); //    win    键按下
     keybd_event(77, MapVirtualKey(77, 0), 0, 0); //    M    键按下
     keybd_event(77, MapVirtualKey(77, 0), KEYEVENTF_KEYUP, 0); //    M    键抬起
     keybd_event(91, MapVirtualKey(91, 0), KEYEVENTF_KEYUP, 0); //    win    键抬起
end;

procedure TForm1.ToDblClick;
begin
     SetCursorPos(strtoint(Edit1.Text), strtoint(Edit2.Text));
     mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
     mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
     mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
     mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
     SendMessage(Form1.Handle, WM_LBUTTONDBLCLK, 0, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin //计时器的步长为6秒触发一次，每分钟触发10次，

     iTime := iTime + 1; //每触发一次，iTime加1

    if not CheckTask('shua.exe') then begin // 没有检测到进程，则模拟双击。
         MinAllWindows; //最小化所有窗口
         sleep(2000);
         ToDblClick; //模拟双击
         sleep(4000);
     end;

    //每　XXX　分钟主动把进程结束，并重新运行，保证不出错。
    if (iTime >= 300) then begin             // 知道 300　是多长时间吧，自己算算
         KillTask('shua.exe'); //结束进程
         iTime := 0;
         sleep(2000);
     end;
     Panel1.Caption := '正在运行...';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     Timer1.Enabled := True;
     Panel1.Caption := '正在运行...';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
     Timer1.Enabled := False;
     Panel1.Caption := '就绪...';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     iTime := 0;
     Locked := True;
     Button1.Enabled := False;
     Button2.Enabled := False;
     Button3.Enabled := False;
     Button4.Enabled := False;
     Edit1.Enabled := False;
     Edit2.Enabled := False;
     Check.Enabled:=False;

     Button2Click(self);
     Autorun(True);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     MinAllWindows; //最小化所有窗口
     sleep(2000);
     ToDblClick; //模拟双击
     sleep(4000);
end;

//锁定这个软件的正常运行，若其它人想使用它，先输入密码吧。密码是什么？？？ ~~~
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);      
begin
     s := s + chr(Key); //用户输入"Author"这显示
    if StrUpper(Pchar(s)) = 'BEYOND' then begin
         Form1.Caption := 'Auto clicker by 黄仁来(已解锁)';
         Locked := False;
         s := '';
         Button1.Enabled := True;
         Button2.Enabled := True;
         Button3.Enabled := True;
         Edit1.Enabled := True;
         Edit2.Enabled := True;
         Button4.Enabled := True;
         Check.Enabled:=True;
     end;
    if Key = 13 then s := '';
end;

//添加一个基本无用的过程，锁定这个小软件不被其它随意关闭。哈哈。
//不过这个功能明显不够专业，在“任务管理器里还是很容易被关掉的”
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    if Locked then begin
         CanClose := False;
         showmessage('请先解锁');
         exit;
     end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
     Locked := True;
     Button1.Enabled := False;
     Button2.Enabled := False;
     Button3.Enabled := False;
     Edit1.Enabled := False;
     Edit2.Enabled := False;
     Button4.Enabled := False;
     Check.Enabled:=False;
     Form1.Caption := 'Auto clicker by 黄仁来(已锁定)';

end;

procedure TForm1.AutoRun(Flag: Boolean); //自动运行函数，注意主键是 HKEY_CURRENT_USER
var
     tempreg: TRegistry;
begin
    try
         tempreg := TRegistry.Create;
         tempreg.RootKey := HKEY_CURRENT_USER;
         tempreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
        if Flag then tempreg.WriteString('AutoClicker', '"' + Application.ExeName + '"')
           else
            begin
             if not Tempreg.DeleteValue ('AutoClicker') then showmessage('删除失败');
            end;
     finally
         tempreg.Closekey;
         tempreg.Free;
     end;

end;

procedure TForm1.CheckClick(Sender: TObject);
begin
    if not Check.Checked then Autorun(False) else Autorun(True); //是否自动运行。
end;

end.
//++++++++++++++++++ 程序源代码到此结束 ++++++++++++++++++++++++++++++++++




















Unit1.dfm内容为

object Form1: TForm1
  Left = 192
  Top = 115
  Width = 870
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 184
    Top = 88
    Width = 473
    Height = 257
    Caption = 'Panel1'
    TabOrder = 0
    object Label1: TLabel
      Left = 192
      Top = 32
      Width = 31
      Height = 13
      Caption = 'Label1'
    end
    object Label2: TLabel
      Left = 72
      Top = 88
      Width = 31
      Height = 13
      Caption = 'Label2'
    end
    object Label3: TLabel
      Left = 288
      Top = 88
      Width = 31
      Height = 13
      Caption = 'Label3'
    end
    object Edit1: TEdit
      Left = 128
      Top = 72
      Width = 65
      Height = 21
      TabOrder = 0
      Text = 'Edit1'
    end
    object Edit2: TEdit
      Left = 352
      Top = 72
      Width = 73
      Height = 21
      TabOrder = 1
      Text = 'Edit2'
    end
    object Check: TCheckBox
      Left = 136
      Top = 152
      Width = 41
      Height = 25
      Caption = 'CheckBox1'
      TabOrder = 2
    end
    object Button1: TButton
      Left = 80
      Top = 112
      Width = 33
      Height = 17
      Caption = 'Button1'
      TabOrder = 3
    end
    object Button2: TButton
      Left = 152
      Top = 104
      Width = 33
      Height = 17
      Caption = 'Button2'
      TabOrder = 4
    end
    object Button3: TButton
      Left = 224
      Top = 104
      Width = 41
      Height = 17
      Caption = 'Button3'
      TabOrder = 5
    end
    object Button4: TButton
      Left = 304
      Top = 112
      Width = 49
      Height = 17
      Caption = 'Button4'
      TabOrder = 6
    end
  end
  object Timer1: TTimer
    Left = 408
    Top = 240
  end
end






Project1.dpr 内容为




program Project1;

{%DelphiDotNetAssemblyCompiler '$(SystemRoot)\microsoft.net\framework\v1.1.4322\system.drawing.dll'}

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

[ 本帖最后由 zhagen2 于 2012-1-6 14:12 编辑 ]

aweihaitun

程序蛮简单的，不过我这里没有delphi
如果你只是为了自动点击的话，建议用按键精灵，足够满足你的需求了
想要自己定制很多功能的话，易语言也行
这两种上手都容易，不过推荐不会编程的用按键精灵

zhagen2

恩，谢谢，不过按键精灵不知道能不能像代码里那样杀进程。这里要监视软件运行

thomas0769

不是用消息，用的是 keybd_event ，用了这个，所有的程序都要受影响，程序本身没什么特别，用Delphi7.0可编译，不过有很多类似的小程序，更简单，如： 自动点击.exe

zhagen2

博客文章的地址是这个：http://hi.baidu.com/beyond0769/b ... dfd316b21bbae2.html