模拟键盘操作Delphi单元

所属类别：DELPHI
推荐指数：★★★☆
文档人气：34
本周人气：34
发布日期：2008-4-29

近日来写程序，要用到键盘模拟操作，写了一个调用单元，供大家学习、使用。

unit dbyoung_Keyboard;

interface

uses Windows;
{
引用代码：
KeyDown_SendInput_OneKey(VK_SCROLL);
KeyDown_SendInput_OneKey(VK_NUMLOCK);
KeyDown_SendInput_OneKey(VK_CAPITAL);
KeyDown_SendInput_TwoKey(VK_LCONTROL,VK_ESCAPE);

KeyDown_WINIO_OneKey(VK_SCROLL);
KeyDown_WINIO_OneKey(VK_NUMLOCK);
KeyDown_WINIO_OneKey(VK_CAPITAL);
}
procedure KeyDown_WINIO_OneKey(vKeyCode: Cardinal);

procedure KeyDown_SendInput_OneKey(vKeyCode: Integer); //单键
procedure KeyDown_SendInput_TwoKey(vKeyCode1, vKeyCode2: Cardinal); //复合键

implementation

procedure KeyDown_SendInput_OneKey(vKeyCode: Integer);
procedure KeyDown(wvk: Integer);
var
    sInput                              : tInput;
begin
    sInput.Itype := INPUT_KEYBOARD;
    sInput.ki.dwflags := 0;
    sInput.ki.wScan := 0;
    sInput.ki.wvk := wvk;
    SendInput(1, sInput, SizeOf(tInput));
end;

procedure KeyUp(wvk: Integer);
var
    sInput                              : tInput;
begin
    sInput.Itype := INPUT_KEYBOARD;
    sInput.ki.dwflags := KEYEVENTF_KEYUP;
    sInput.ki.wvk := wvk;
    sInput.ki.wScan := 0;
    SendInput(1, sInput, SizeOf(tInput));
end;
begin
KeyDown(vKeyCode);
KeyUp(vKeyCode);
end;

procedure KeyDOWN_SendInput_TwoKey(vKeyCode1, vKeyCode2: Cardinal);
var
sInput : array[0..3] of tInput;
begin
sInput[0].itype := INPUT_KEYBOARD;
sInput[1].itype := INPUT_KEYBOARD;
sInput[2].itype := INPUT_KEYBOARD;
sInput[3].itype := INPUT_KEYBOARD;
sInput[0].ki.wVk := vKeyCode1;
sInput[2].ki.wVk := vKeyCode1;
sInput[1].ki.wVk := vKeyCode2;
sInput[3].ki.wVk := vKeyCode2;
sInput[2].ki.dwFlags := KEYEVENTF_KEYUP;
sInput[3].ki.dwFlags := KEYEVENTF_KEYUP;
SendInput(4, sInput[0], sizeof(sInput[0]));
end;

function EnableDebugPrivilege(CanDebug: boolean): Boolean;
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
var
    TP                                  : Windows.TOKEN_PRIVILEGES;
    Dummy                               : Cardinal;
begin
    TP.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
    if bEnable then TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED else TP.Privileges[0].Attributes := 0;
    AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
    Result := GetLastError = ERROR_SUCCESS;
end;
var
hToken                                : Cardinal;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
Result := EnablePrivilege(hToken, 'SeDebugPrivilege', CanDebug);
CloseHandle(hToken);
hToken := 0;
end;

type
_DEBUG_CONTROL_CODE = (
    DebugSysReadIoSpace = 14,
    DebugSysWriteIoSpace = 15,
    DebugSysReadMsr = 16,
    DebugSysWriteMsr = 17,
    DebugSysReadBusData = 18,
    DebugSysWriteBusData = 19
    );
DEBUG_CONTROL_CODE = _DEBUG_CONTROL_CODE;

function ZwSystemDebugControl(ControlCode: _DEBUG_CONTROL_CODE; InputBuffer: Pointer; InputBufferLength: ULONG; OutputBuffer: Pointer; OutputBufferLength: ULONG; ReturnLength: PULONG): LongInt; stdcall; external 'ntdll.dll';

procedure KeyDown_WINIO_OneKey(vKeyCode: Cardinal);
const
KBC_KEY_CMD = $64; //键盘命令端口
KBC_KEY_DATA = $60; //键盘数据端口

type
TIOStruct = record
    IoAddr: DWORD;
    Reserved1: DWORD;
    pBuffer: Pointer;
    NumBYTEs: DWORD;
    Reserved4: DWORD;
    Reserved5: DWORD;
    Reserved6: DWORD;
    Reserved7: DWORD;
end;

function InPortB(Port: DWORD): Byte;
var
    Value                               : BYTE;
    io                                  : TIOStruct;
begin
    Value := 0;
    io.IoAddr := Port;
    io.Reserved1 := 0;
    io.pBuffer := Pointer(@Value);
    io.NumBYTEs := sizeof(BYTE);
    io.Reserved4 := 1;
    io.Reserved5 := 0;
    io.Reserved6 := 1;
    io.Reserved7 := 0;
    ZwSystemDebugControl(DebugSysReadIoSpace, @io, sizeof(io), nil, 0, nil);
    Result := Value;
end;

procedure OutPortB(Port: DWORD; Value: Byte);
var
    io                                  : TIOStruct;
begin
    io.IoAddr := Port;
    io.Reserved1 := 0;
    io.pBuffer := Pointer(@Value);
    io.NumBYTEs := sizeof(BYTE);
    io.Reserved4 := 1;
    io.Reserved5 := 0;
    io.Reserved6 := 1;
    io.Reserved7 := 0;
    ZwSystemDebugControl(DebugSysWriteIoSpace, @io, sizeof(io), nil, 0, nil);
end;

procedure KbcWait4IBE;
var
    dwRegVal                            : DWORD;
begin
    dwRegVal := 0;
    while (dwRegVal and $00000001 = 1) do
    begin
      dwRegVal := InPortB(KBC_KEY_CMD);
    end;
end;

procedure KeyDown(vKeyCoad: Cardinal);                                                            //这个用来模拟按下键，参数vKeyCoad传入按键的虚拟码
var
    btScancode                          : Cardinal;
begin
    btScancode := MapVirtualKey(vKeyCoad, 0);
    KBCWait4IBE;                                                                                    //0xD2:写键盘缓冲区,0xD3:写鼠标缓冲区,发送数据前应该先等待键盘缓冲区为空
    OutPortB(KBC_KEY_CMD, $D2);                                                                     //发送键盘写入命令, SetPortVal函数用于向端口写入数据，它的用法是SetPortVal 端口号,欲写入的数据，写入数据的长度
    KBCWait4IBE;
    OutPortB(KBC_KEY_DATA, btScancode);                                                             //写入按键信息,按下键
end;

procedure KeyUp(vKeyCoad: Cardinal);                                                              //这个用来模拟释放键，参数vKeyCoad传入按键的虚拟码
var
    btScancode                          : Cardinal;
begin
    btScancode := MapVirtualKey(vKeyCoad, 0);
    KBCWait4IBE;                                                                                    //等待键盘缓冲区为空
    OutPortB(KBC_KEY_CMD, $D2);                                                                     //发送键盘写入命令
    KBCWait4IBE;
    OutPortB(KBC_KEY_DATA, (btScancode or $80));                                                    //写入按键信息，释放键
end;
begin
KeyDown(vKeyCode);
KeyUp(vKeyCode);
end;

initialization
EnableDebugPrivilege(True);

finalization
EnableDebugPrivilege(False);

end.