winio_delphi.txt

WINIO驱动方式模拟按键的Delphi源码

嘿嘿，这里感谢一下广海社区的gzhzc和CCB老师，我经常看去他们的帖子，但自觉很菜就从来没有发过帖子都是在潜水；--猫猫

Unit1.pas单元；

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.

Project1.dpr单元；

program Project1;

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

{$R *.res}

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


unit1.dfm;

object Form1: TForm1
   Left = 750
   Top = 475
   Width = 256
   Height = 218
   Caption = #27979#35797
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   OldCreateOrder = False
   OnActivate = FormActivate
   OnClose = FormClose
   PixelsPerInch = 96
   TextHeight = 13
   object Button1: TButton
     Left = 136
     Top = 152
     Width = 49
     Height = 25
     Caption = #21551#21160
     TabOrder = 0
     OnClick = Button1Click
   end
   object Memo1: TMemo
     Left = 8
     Top = 8
     Width = 233
     Height = 137
     Lines.Strings = (
       #12288
       #38190#30424#39537#21160#27169#25311#65288'WinIo'#65289
       #12288#20250#22312#24403#21069#21069#21488#20219#20309#31243#24207#20013#20316#38190#30424#27169#25311#12290
       #12288
       #27979#35797#35828#26126#65306
       #12288'1'#12289#26032#25171#24320#19968#20010#31354#30333#35760#20107#26412#12290
       #12288'2'#12289#25353#21551#21160#38190#65292#20999#25442#21040#35760#20107#26412#65292#20250#22312#24403
       #12288'       '#21069#31243#24207#36755#20837'"1234"'#12290)
     ReadOnly = True
     TabOrder = 2
   end
   object Button2: TButton
     Left = 192
     Top = 152
     Width = 49
     Height = 25
     Caption = #20572#27490
     Enabled = False
     TabOrder = 1
     OnClick = Button2Click
   end
   object Timer1: TTimer
     Enabled = False
     OnTimer = Timer1Timer
     Left = 96
     Top = 152
   end
end