unit1.pas

delphi调用winio实现驱动键盘模拟

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;

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