求Delphi驱动级模拟按键实例
如题。。求模拟按键驱动级的实例
如果写不下麻烦发送至邮箱858860666@qq.com
追问:这个例子我也看到了,
可是我按button1后貌似没有什么动作
如题。。求模拟按键驱动级的实例
如果写不下麻烦发送至邮箱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'