Delphi驱动方式WINIO模拟按键 可用

http://www.delphitop.com/html/yingjian/152.html

Delphi驱动方式WINIO模拟按键

作者：admin 来源：未知 日期：2010/2/1 1:14:15 人气：2363 标签：

QQ空间新浪微博腾讯微博腾讯朋友QQ收藏百度空间百度贴吧更多0

添加控件 2个button 1个Timer 够了

代码如下:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
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_5 = $35;
VK_6 = $36;
VK_7 = $37;
VK_8 = $38;

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_1);
Sleep(50);
MyKeyUp(VK_1);

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);

Sleep(50);
MyKeyDown(VK_5);
Sleep(50);
MyKeyUp(VK_5);

Sleep(50);
MyKeyDown(VK_6);
Sleep(50);
MyKeyUp(VK_6);

Sleep(50);
MyKeyDown(VK_7);
Sleep(50);
MyKeyUp(VK_7);

Sleep(50);
MyKeyDown(VK_8);
Sleep(50);
MyKeyUp(VK_8);
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.