当前位置:编程学习 > Delphi >>

求Delphi驱动级模拟按键实例

如题。。求模拟按键驱动级的实例

如果写不下麻烦发送至邮箱858860666@qq.com

追问:

这个例子我也看到了,

可是我按button1后貌似没有什么动作

答案:

网上一搜一大把。

需要个驱动:WinIo.sys

DLL 模块:WinIo.dll

 

下面是调用窗口单元:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  KBC_KEY_CMD  = $64;
  KBC_KEY_DATA = $60;
  VK_1 = $31;
  VK_2 = $32;
  VK_3 = $33;
  VK_4 = $34;
  VK_W = $57;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function InitializeWinIo:Boolean;stdcall;external 'WinIo.dll' name'InitializeWinIo';
function InstallWinIoDriver(pszWinIoDriverPath:PString;IsDemandLoaded:boolean=false):Boolean;stdcall;external 'WinIo.dll' name 'InstallWinIoDriver';
function RemoveWinIoDriver:Boolean;stdcall;external 'WinIo.dll' name 'RemoveWinIoDriver';
function GetPortVal(PortAddr:Word;PortVal:PDWord;bSize:Byte):Boolean;stdcall;external 'WinIo.dll' name 'GetPortVal';
function SetPortVal(PortAddr:Word;PortVal:DWord;bSize:Byte):Boolean;stdcall;external 'WinIo.dll' name 'SetPortVal';
function GetPhysLong(PhysAddr:PByte;PhysVal:PDWord):Boolean;stdcall;external 'WinIo.dll' name 'GetPhysLong';
function SetPhysLong(PhysAddr:PByte;PhysVal:DWord):Boolean;stdcall;external 'WinIo.dll' name 'SetPhysLong';
function MapPhysToLin(PhysAddr:PByte;PhysSize:DWord;PhysMemHandle:PHandle):PByte;stdcall;external 'WinIo.dll' name 'MapPhysToLin';
function UnMapPhysicalMemory(PhysMemHandle:THandle;LinAddr:PByte):Boolean;stdcall;external 'WinIo.dll' name 'UnmapPhysicalMemory';
procedure ShutdownWinIo;stdcall;external 'WinIo.dll' name'ShutdownWinIo';

procedure KBCWait4IBE; //等待键盘缓冲区为空
var
  dwVal:DWord;
begin
  repeat
    GetPortVal($64,@dwVal,1);
  until (dwVal and $2)=0;
end;

procedure MyKeyDown(vKeyCoad:Integer);
var
  btScancode:DWord;
begin
  btScancode:=MapVirtualKey(vKeyCoad, 0);
  KBCWait4IBE;
  SetPortVal($64, $D2, 1);
  KBCWait4IBE;
  SetPortVal($60, btScancode, 1);
end;

procedure MyKeyUp(vKeyCoad:Integer);
var
  btScancode:DWord;
begin
  btScancode:=MapVirtualKey(vKeyCoad, 0);
  KBCWait4IBE;
  SetPortVal($64, $D2, 1);
  KBCWait4IBE;
  SetPortVal($64, (btScancode or $80), 1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled := True;
  Button1.Enabled := False;
  Button2.Enabled := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  Button1.Enabled := True;
  Button2.Enabled := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  MyKeyDown(VK_W);
  Sleep(50);
  MyKeyUp(VK_W);
           {
  Sleep(50);
  MyKeyDown(VK_2);
  Sleep(50);
  MyKeyUp(VK_2);

  Sleep(50);
  MyKeyDown(VK_3);
  Sleep(50);
  MyKeyUp(VK_3);

  Sleep(50);
  MyKeyDown(VK_4);
  Sleep(50);
  MyKeyUp(VK_4);
  }
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ShutdownWinIo;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  if InitializeWinIo=False then begin
    Messagebox(handle,'初始化失败!','提示',MB_OK+MB_IconError)
  end;
end;

end.

上一个:delphi改怎么学??
下一个:delphi提示Undeclared identifier:'MainFirmOnTaskbar'

CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,