{
  Класс отправки клавиш. Использует драйвер r0kedrv
}

unit SendKeys;

interface

uses
  SysUtils, Classes, Windows, WinSvc, Forms, Functions;

const
  SC_MANAGER_ALL_ACCESS = $F003F;
  SERVICE_KERNEL_DRIVER = $00000001;
  SERVICE_DEMAND_START = $00000003;
  SERVICE_ERROR_IGNORE = $00000000;

  DRIVER = 'ring0keyboard'; // Имя файла драйвера (без *.sys) а заодно и регистрируемой службы
  DEVICE_FILE = '\\\\.\\r0kedrv';

  IOCTL_KB_PS2_WRITE = 1;

  ERR_CANT_START = 'Can''t start keyboard emulator driver';
  ERR_ALREADY_EXIST = 1073;

type
  TByteArray = array of byte;

type
  TKey = record
    key: string;
    code: integer;
  end;

type
  TsendKeys = class(TObject)
  private
    { Private declarations }
    SCManagerHandle: THandle;
    ServiceHandle: THandle;
    function StartService(): Boolean;
    procedure StopService();
  protected
    { Protected declarations }
  public
    { Public declarations }
    waiting: integer;
    constructor Create();
    destructor Destroy();
    function SendCodes(codes: TByteArray): Boolean;
    function SendKeys(keys: string): Boolean;
  end;

implementation

{ TKeySend }

function SKey(key: string; code: integer): TKey;
begin
  Result.key := key;
  Result.code := code;
end;

function StringToPWide(sStr: string): PWideChar;
var
  w: WideString;
begin
  w := sStr;
  Result := PWideChar(w);
end;

function ScanCode(key: string; down: Boolean): integer;
var
  keys: array [0 .. 69] of TKey;
  i: integer;
begin
  keys[0] := SKey('1', 2);
  keys[10] := SKey('-', 12);
  keys[20] := SKey('O', 24);
  keys[1] := SKey('2', 3);
  keys[11] := SKey('=', 13);
  keys[21] := SKey('P', 25);
  keys[2] := SKey('3', 4);
  keys[12] := SKey('Q', 16);
  keys[22] := SKey('[', 26);
  keys[3] := SKey('4', 5);
  keys[13] := SKey('W', 17);
  keys[23] := SKey(']', 27);
  keys[4] := SKey('5', 6);
  keys[14] := SKey('E', 18);
  keys[24] := SKey('A', 30);
  keys[5] := SKey('6', 7);
  keys[15] := SKey('R', 19);
  keys[25] := SKey('S', 31);
  keys[6] := SKey('7', 8);
  keys[16] := SKey('T', 20);
  keys[26] := SKey('D', 32);
  keys[7] := SKey('8', 9);
  keys[17] := SKey('Y', 21);
  keys[27] := SKey('F', 33);
  keys[8] := SKey('9', 10);
  keys[18] := SKey('U', 22);
  keys[28] := SKey('G', 34);
  keys[9] := SKey('0', 11);
  keys[19] := SKey('I', 23);
  keys[29] := SKey('H', 35);

  keys[30] := SKey('J', 36);
  keys[40] := SKey('V', 47);
  keys[31] := SKey('K', 37);
  keys[41] := SKey('B', 48);
  keys[32] := SKey('L', 38);
  keys[42] := SKey('N', 49);
  keys[33] := SKey(';', 39);
  keys[43] := SKey('M', 50);
  keys[34] := SKey('''', 40);
  keys[44] := SKey(',', 51);
  keys[35] := SKey('`', 41);
  keys[45] := SKey('.', 52);
  keys[36] := SKey('\', 43);
  keys[46] := SKey('/', 53);
  keys[37] := SKey('Z', 44);
  keys[47] := SKey(' ', 57);
  keys[38] := SKey('X', 45);
  keys[48] := SKey('SPACE', 57);
  keys[39] := SKey('C', 46);

  keys[49] := SKey('ESC', 1);
  keys[59] := SKey('SCROLLLOCK', 70);
  keys[50] := SKey('BACKSPACE', 14);
  keys[60] := SKey('F1', 59);
  keys[51] := SKey('TAB', 15);
  keys[61] := SKey('F2', 60);
  keys[52] := SKey('ENTER', 28);
  keys[62] := SKey('F3', 61);
  keys[53] := SKey('RETURN', 28);
  keys[63] := SKey('F4', 62);
  keys[54] := SKey('CTRL', 29);
  keys[64] := SKey('F5', 63);
  keys[55] := SKey('SHIFT', 42);
  keys[65] := SKey('F6', 64);
  keys[56] := SKey('ALT', 56);
  keys[66] := SKey('F7', 65);
  keys[57] := SKey('CAPS', 58);
  keys[67] := SKey('F8', 66);
  keys[58] := SKey('NUMLOCK', 58);
  keys[68] := SKey('F9', 67);

  keys[69] := SKey('F10', 68);

  for i := 0 to 69 do
    if keys[i].key = key then
      break;

  Result := keys[i].code;

end;

constructor TsendKeys.Create;
begin
  AddToLog('Driver loading ...');
  inherited;
  if not StartService() then begin
    AddToLog(ERR_CANT_START + ':' + FloatToStr(GetLastError()));
	  StopService();
    raise Exception.Create(ERR_CANT_START);
    Application.Terminate();
  end;
  AddToLog('Driver loaded');
  Sleep(5000);
  Self.SendKeys('n;t;TAB');
end;

destructor TsendKeys.Destroy;
begin
  AddToLog('Driver unloading');
  StopService();
  AddToLog('Driver unloaded');
  inherited;
end;

function TsendKeys.SendCodes(codes: TByteArray): Boolean;
var
  h: THandle;
  tmp:Boolean;
  ret:Cardinal;
begin

  h := CreateFile(StringToPWide(DEVICE_FILE), GENERIC_READ + GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, 0, 0);
  if h = INVALID_HANDLE_VALUE then
    Result := False
  else
  begin
    ret:=0;
    tmp := DeviceIoControl(h,
                           IOCTL_KB_PS2_WRITE,nil,0,
                           @codes,Length(codes) * sizeof(codes),
                           ret, nil);
    Result := not tmp;
    if not Result then AddToLog('Can''t send data');

    CloseHandle(h);
  end;
end;

function TsendKeys.SendKeys(keys: string): Boolean;
var
  send: array of string;
  lastchar: char;
  i, k: integer;
  code: TByteArray;
  sc:string;
begin
  SetLength(send, 1);
  send[0] := '';
  k := 0;
  lastchar := chr(0);

  for i := 1 to Length(keys) do
  begin
    if (keys[i] = ';') and (lastchar <> '\') then
    begin
      k := k + 1;
      SetLength(send, Length(send) + 1);
      send[k] := '';
    end
    else if (keys[i] <> '\') or ((keys[i] = '\') and (lastchar = '\')) then
      send[k] := send[k] + keys[i];
  end;

  sc:='';
  for i:=0 to Length(send)-1 do
    sc:=sc+send[i]+',';
  sc[Length(sc)]:=']';
  AddToLog('Sending keys : '+keys[i]);
  AddToLog('Translated to scan-codes array : '+sc);

  Result := True;
  for i := 0 to Length(send) do
  begin
    SetLength(code, 1);
    code[0] := ScanCode(send[i], False);
    Result := Result and SendCodes(code);
    if not Result then
      break;

    Sleep(waiting);

    SetLength(code, 1);
    code[0] := ScanCode(send[i], True);
    Result := Result and SendCodes(code);
    if not Result then
      break;

    Sleep(waiting);
  end;
end;

function TsendKeys.StartService: Boolean;
var
  path: string;
  pw:PWideChar;
  f:file of THandle;
begin
  SCManagerHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManagerHandle = 0 then begin
    Result := False;
    AddToLog('Can''t connect to service manager');
  end
  else
  begin
    path := ExtractFilePath(ParamStr(0)) + '\' + DRIVER + '.sys';
    ServiceHandle := CreateService(SCManagerHandle, StringToPWide(DRIVER),
      StringToPWide('ring 0 keyboard emulator'), SC_MANAGER_ALL_ACCESS,
      SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START, SERVICE_ERROR_IGNORE,
      StringToPWide(path), nil, nil, nil, nil, nil);
    if ServiceHandle = 0 then begin
      Result := False;
      AddToLog('Can''t connect ro service');
    end
    else
      Result := WinSvc.StartService(ServiceHandle, 0, pw);
  end;

  AssignFile(f,'handles');
  Rewrite(f);
  Write(f,SCManagerHandle,ServiceHandle);
  CloseFile(f);
end;

procedure TsendKeys.StopService;
var
  s: TServiceStatus;
begin
  ControlService(ServiceHandle, SERVICE_CONTROL_STOP, s);
  DeleteService(ServiceHandle);
  CloseServiceHandle(ServiceHandle);
  CloseServiceHandle(SCManagerHandle);
end;

end.