USB键盘/鼠标的驱动级硬件模拟实现

[fang_liang]

前来的大侠，你们好。
小弟使用WINIO能实现非USB接口方式的键盘和鼠标的驱动级硬件模拟，找遍了网络没有找到如何实现USB的方式，恳请各位大侠提供点思路，谢谢。。。

[erhan]

有效的啊，我试了2台usb键盘的机器，都可以的

procedure TKeyThread.Execute();
begin
        mKeyDown(VK_CONTROL);  //ctrl
        mKeyDown($56);         //v
        //mKeyDown(VK_SPACE);
        //keybd_event( 32, 0, 0, 0);
        sleep(2000);
        //keybd_event( 32,0, KEYEVENTF_KEYUP, 0);
        mKeyUp($56);
        //mKeyUp(VK_SPACE);
        mKeyUp(VK_CONTROL);
end;

[fang_liang]

执行后，没反应的。
我测试方法：
1.先复制一段文本。
2.点击BTN按纽
3.MEMO1不出现刚才复制的文本。

[fang_liang]

有其他的方法可以实现吗？谢谢了。

[Quote=引用 3 楼 sz100wwb 的回复:]
引用 1 楼 erhan 的回复:

对USB键盘是有效的，应该是你要的那个级别的吧
。
Delphi(Pascal) code

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, E……
[/Quote]

[erhan]

对USB键盘是有效的，应该是你要的那个级别的吧。

unit Unit1;

interface

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

type
        TKeyThread = class(TThread)
        private
                procedure WaitEmpty();
                procedure mKeyDown(vk: byte);
                procedure mKeyUp(vk: byte);
        protected
                procedure Execute;override;
end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function InitializeWinIo:Boolean;stdcall;external 'WinIo.dll' name'InitializeWinIo';
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 InstallWinIoDriver(pszWinIoDriverPath:PString;IsDemandLoaded:boolean=false):Boolean;stdcall;external 'WinIo.dll' name 'InstallWinIoDriver';
function RemoveWinIoDriver:Boolean;stdcall;external 'WinIo.dll' name 'RemoveWinIoDriver';
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 TKeyThread.WaitEmpty();
var
        mValue: byte;
begin
        repeat
                GetPortVal($64,@mValue,1);
                if (mValue and $2)=0 then break;
                sleep(10);
        until (mValue and $2)=0;
end;

procedure TKeyThread.mKeyDown(vk: byte);
begin
        WaitEmpty();
        SetPortVal($64,$D2,1);
        WaitEmpty();
        SetPortVal($60,MapVirtualKey(vk,0),1);
end;

procedure TKeyThread.mKeyUp(vk: byte);
begin
        WaitEmpty();
        SetPortVal($64,$D2,1);
        WaitEmpty();
        SetPortVal($60,MapVirtualKey(vk,0) or $80,1);
end;

procedure TKeyThread.Execute();
begin
        mKeyDown(VK_SPACE);
        //keybd_event( 32, 0, 0, 0);
        sleep(2000);
        //keybd_event( 32,0, KEYEVENTF_KEYUP, 0);
        mKeyUp(VK_SPACE);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
        mKeyThread: TKeyThread;
begin
        Memo1.SetFocus;
        mKeyThread := TKeyThread.Create(True);
        mKeyThread.FreeOnTerminate := True;
        mKeyThread.Resume;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        if InitializeWinIo=False then begin
                ShowMessage('初始化失败！');
        end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
        ShutdownWinIo;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
        Memo1.Lines.Add('down');
end;

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
        Memo1.Lines.Add('up')
end;

end.

[erhan]

测试方法是对的，点一次你在memo里看到几个down和up？
程序里面2个down和2个up间加sleep(100)再试下，刚才我的机器也出了问题，加上就好了。

正常应该看到2个down和2个up，中间是粘贴的文本

[fang_liang]

现使用了网上的一个MouseKeyboard.pas单元，目前是可以实现PS/2接口的键盘和鼠标，因是用汇编写的发送方式，我觉得是不是可以找到USB的入口也就能实现了，因本人不懂汇编，请高手来解答一下，谢谢。

//向指定的键盘鼠标端口发送数据包，返回是否成功，
//Len为数据包的字节长度。
function MKSendData(const Data : TMKPacketData; Len : Byte; Typ : TMKDataType): Boolean;
var
i,b : Byte;

procedure fSetByte(Por,Cod : Byte);
begin
Sleep(10);
asm
PUSH EAX
PUSH EDX
//等待状态寄存器标志位OBF置0
@Loop:
IN AL,$64
AND AL,10b
JNZ @Loop
//写入数据
MOV AL,Cod
MOV DL,Por
MOV DH,0
OUT DX,AL
POP EDX
POP EAX
end;
end;

begin
if not MKInitAlready then
begin
result:=MKInitMouseKey;
if not result then exit;
end;
if Typ=dtMouse then b:=$D3
else b:=$D2;
for i:=0 to Len-1 do
begin
fSetByte($64,b);
fSetByte($60,Data[i]);
end;
result:=true;
end;

[fang_liang]

点击BTN后，没有出现down和up的。


[Quote=引用 8 楼 erhan 的回复:]
测试方法是对的，点一次你在memo里看到几个down和up？
程序里面2个down和2个up间加sleep(100)再试下，刚才我的机器也出了问题，加上就好了。

正常应该看到2个down和2个up，中间是粘贴的文本
[/Quote]

[erhan]

怪事，难道我这测试机的usb键盘装了驱动后，加了个ps/2的虚拟机？

[fang_liang]

如果在MEMO中使用CRTL+V键，是出现和你一样的结果的。但不应该是那样吧。 应该是点击BTN后，出现才是正确的对吧。

[erhan]

我再研究一下，看看别人怎么说，也许我这真是装了什么玩意

[fang_liang]

继续期待回复

[fang_liang]

我想换种思路：USB键盘和鼠标的缓冲区入口地址如何才能找到，通过WINIO。期待啊~~~~

[erhan]

看下这个
http://blog.csdn.net/mergerly/article/details/4838655

[山东蓝鸟贵薪]

期待并学习中

[fang_liang]

组合键好像不可以发，期待您的再次帮助。非常的感谢!!!

[sz100wwb]

[Quote=引用 1 楼 erhan 的回复:]

对USB键盘是有效的，应该是你要的那个级别的吧。
Delphi(Pascal) code

unit Unit1;

interface

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

type
……
[/Quote]

你的不就是在用winio吗 对USB无效的

[fang_liang]

非常的感谢，这段代码不知道怎么转成DELPHI的。 唉。。。。。

[Quote=引用 16 楼 erhan 的回复:]
看下这个
http://blog.csdn.net/mergerly/article/details/4838655
[/Quote]

[fang_liang]

继续等待中。。。。。。。。。。。

[yggk]

引用 8 楼 erhan 的回复:

测试方法是对的，点一次你在memo里看到几个down和up？ 程序里面2个down和2个up间加sleep(100)再试下，刚才我的机器也出了问题，加上就好了。 正常应该看到2个down和2个up，中间是粘贴的文本

这段例程，为什么要放在线程里面，是因为放主线程会阻塞界面吗？