1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:

unit FMain;

interface

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

type
  TKeyStateInfo = class
    TimeStamp : TDateTime;
    VKey      : Integer;
    State     : Integer;
  end;

  TForm1 = class(TForm)
    tiSend: TTimer;
    Button1: TButton;
    meInput: TMemo;
    nbListen: TButton;
    nbClear: TButton;
    tiStartSend: TTimer;
    tiReadKeyStates: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure tiSendTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure nbListenClick(Sender: TObject);
    procedure nbClearClick(Sender: TObject);
    procedure tiStartSendTimer(Sender: TObject);
    procedure tiReadKeyStatesTimer(Sender: TObject);
  private
    FCatchBeginTime: TDatetime;
    FSendBegintime : TDateTime;
    FKeyStates     : TStringList;
    fCount: Integer;
    fListen : Boolean;
    FKeyLog   : TList;
    FKeyLogTmp: TList;
    { Private declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Math;

const
  RecordKeys : Array [0..4] of Integer = (VK_LEFT,
                                          VK_RIGHT,
                                          VK_UP,
                                          VK_DOWN,
                                          VK_LCONTROL);

{$R *.dfm}
/// SENDEN DER AUFGENOMMENEN KEYS STARTET IN 5 Sekunden
procedure TForm1.Button1Click(Sender: TObject);   
begin
  FKeyLogTmp.Assign(FKeyLog);
  tiStartSend.Enabled := not tiSend.Enabled;
  if tiStartSend.Enabled then begin
    Self.Caption := 'EIN';
  end else begin
    tiSend.Enabled := FALSE;
    Self.Caption := 'AUS';
  end;
end;

// WIRD ALLE 1 MS AUSGEFÜHRT
procedure TForm1.tiSendTimer(Sender: TObject);
var
  lObj   : TKeyStateInfo;
  lInput : TInput;
  lDxKey : Integer;
begin
  if Assigned(FKeyLogTmp) then begin
    while (FKeyLogTmp.Count > 0) do begin
      lObj := TKeyStateInfo(FKeyLogTmp.Items[0]);
      if (lObj.TimeStamp <= (now - FSendBegintime)) then begin
        lDxKey := lObj.VKey;
        case lObj.VKey of
          VK_LEFT      : lDxKey := 203;
          VK_RIGHT     : lDxKey := 205;
          VK_UP        : lDxKey := 200;
          VK_DOWN      : lDxKey := 208;
          VK_LCONTROL  : lDxKey := 29;
        end;

        lInput.Itype    := INPUT_KEYBOARD;
        lInput.ki.wVk   := 0;
        lInput.ki.wScan := lDxKey;
        lInput.ki.time  := 0;
        lInput.ki.dwExtraInfo := 0;
        if (lObj.State < 0) then begin
          lInput.ki.dwFlags := 0;
        end else begin
          lInput.ki.dwFlags := KEYEVENTF_KEYUP;
        end;
        SendInput(1, lInput, SizeOf(lInput));

        FKeyLogTmp.Delete(0);
      end else begin
        break;
      end;
    end;
  end;   
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FKeyLog := TList.Create;
  FKeyLogTmp := TList.Create;
  FKeyStates := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FKeyStates.Free;
  FKeyLog.Free;  // TODO: Obj freigeben
  FKeyLogTmp.Free;
end;

//STARTET / STOPPT DAS AUFNEHMEN DER KEYS
procedure TForm1.nbListenClick(Sender: TObject);
begin
  tiReadKeyStates.Enabled := not tiReadKeyStates.Enabled;
  if tiReadKeyStates.Enabled then begin
    FCatchBeginTime  := now;
    nbListen.Caption := 'Listen - ON';
  end else begin
    nbListen.Caption := 'Listen - OFF';
  end;
end;

procedure TForm1.nbClearClick(Sender: TObject);
begin
  meInput.Lines.Clear;
  FKeyStates.Clear;
  FKeyLog.Clear;
end;

procedure TForm1.tiStartSendTimer(Sender: TObject);
begin
  FSendBegintime := now;
  tiSend.Enabled := TRUE;
  tiStartSend.Enabled := FALSE;
end;

//WIRD ALLE 1 MS AUSGEFÜHRT
procedure TForm1.tiReadKeyStatesTimer(Sender: TObject);
var
  i      : Integer;
  lObj   : TKeyStateInfo;
  lState : Integer;
begin
  for i := Low(RecordKeys) to High(RecordKeys) do begin
    lState := GetAsyncKeyState(RecordKeys[i]);
    if (lState < 0) then lState := -1
    else                 lState := 1;
    if (FKeyStates.Values[IntToStr(RecordKeys[i])] <> InttoStr(lState)) then begin
      FKeyStates.Values[IntToStr(RecordKeys[i])] := IntToStr(lState);
      lObj := TKeyStateInfo.Create;
      lObj.TimeStamp := now - FCatchBeginTime;
      lObj.VKey      := RecordKeys[i];
      lObj.State     := lState;
      meInput.Lines.Add('Key: ' + IntToStr(RecordKeys[i]));
      FKeyLog.Add(lObj);
    end;
  end;
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

        if (lEventStrut.message = WM_KEYDOWN) or (lEventStrut.message = WM_KEYUP) then begin
          case Lo(lEventStrut.paramL) of
            VK_LEFT : begin
              lEventStrut.paramL := (203 shl 8);
            end;
            VK_UP: begin
              lEventStrut.paramL := (200 shl 8);
            end;
            VK_RIGHT: begin
              lEventStrut.paramL := (205 shl 8);
            end;
            VK_DOWN: begin
              lEventStrut.paramL := (208 shl 8);
            end;
          end;
        end;