asked on

Delphi - detect a left/right mouse click anywhere on the screen.

Hopefully this will be my last posting on this subject :-).

With the help of the Delphi Experts I have put together a keyboard logger that records in a memo box anything the user types on the screen. This is for about 1,000 disabled internet students in and around London so that their remote tutors can see what they are actually typing. It all working swimmingly together with accurate renditions of the Num/Caps/Scroll Lock lights.

But what I am missing is the ability to see what mouse clicks have been pressed?

Any ideas?

Ed

p.s. Here's the code for the key stroke trapper DLL....

IBRARY KeyHandler;
uses
Windows,
Messages;

CONST
CM_SEND_KEY = WM_USER + $1000;

VAR
Keybrd: HHook;
MemFile: THandle;
Reciever: ^Integer;

Function HookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
{This is the CallBack function called by the Hook}
Begin
{if a key was pressed/released}
if (code = HC_ACTION) then begin
{attempt to map to MemFile}
MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
{if mapping successful, send keypress to receiver application}
if (MemFile <> 0) then begin
Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);
PostMessage(Reciever^, CM_SEND_KEY, wParam, lParam);
UnmapViewOfFile(Reciever);
CloseHandle(MemFile);
end;
end;
{call to next hook of the chain}
Result := CallNextHookEx(Keybrd, Code, wParam, lParam)
End;

Procedure HookOn; stdcall;
{procedure to install the hook}
Begin
Keybrd := SetWindowsHookEx(WH_KEYBOARD, @HookCallBack, HInstance, 0);
End;

Procedure HookOff; stdcall;
{procedure to uninstall the hook}
Begin
UnhookWindowsHookEx(Keybrd);
End;

EXPORTS

{ Export the following Procedures/Functions }

HookOn,
HookOff;

BEGIN
END.

Member_2_760301

here's a tip:

https://www.experts-exchange.com/questions/21828809/Delphi-how-to-capture-all-keystrokes.html

private
procedure WMNCRBUTTONDOWN(var msg: TMessage); message WM_NCRBUTTONDOWN;
procedure WMNCLBUTTONDOWN(var msg: TMessage); message WM_NCLBUTTONDOWN;
procedure WMNCLBUTTONDBLCLK(var msg: TMessage); message WM_NCLBUTTONDBLCLK;
end;

implementation

procedure TForm1.WMNCRBUTTONDOWN(var msg: TMessage);
begin
if msg.wParam = HTCAPTION then Caption := 'Right Click!';
// Message.Result := 0; {to ignore the message}
inherited;
end;

procedure TForm1.WMNCLBUTTONDOWN(var msg: TMessage);
begin
if msg.wParam = HTCAPTION then Caption := 'Left Click!';
// Message.Result := 0; {to ignore the message}
inherited;
end;

procedure TForm1.WMNCLBUTTONDBLCLK(var msg: TMessage);
begin
if msg.wParam = HTCAPTION then Caption := 'Double Click!';
// Message.Result := 0; {to ignore the message}
inherited;
end;

probably might help. //from torry's page

edhasted

ASKER

I saw that in your original reply. What I don't understand is where to position the procedures
TForm1.WMNCRBUTTONDOWN(var msg: TMessage); etc
so they trap the mouseclicks and then display the message....

Ed

2266180

since you want to trap it anywhere on the screen, you will need some sort of mouse hooks. either use the one comming with windows api or use some 3rd party components (I recommend using madhook from madshi)

ZhaawZ

If you're using Windows NT/2000/XP, you may use WH_KEYBOARD_LL and WH_MOUSE_LL hooks - quite easy to use and no need for external library (i.e., HookProc may be kept inside of .exe file).

SOLUTION

ZhaawZ

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

edhasted

ASKER

ZhaawZ, the keyboard parts works perfectly.
The mouse bit which is what I'm after didn't work.
I had to remove the "variant" uses - is that because I'm on Delphi5?

Almost there,

Ed

ZhaawZ

About keyboard part - I just showed you the way of hooking keyboard by using low-level hook without making external .dll file. You also do not need memory-mapped files to work with low-level hooks ;) But as these are low-level hooks, they're supported only in w2k/nt/xp. If you need an example for older windows, just say.

About "variant" - you may safelly remove it (I think it was added in D6, but I've never used it).

edhasted

ASKER

A lot of the studentsare runing on '98.
So could you let me know how I attack the issue under these older operating systems.

Wtih many thanks,

Ed

ZhaawZ

by using WH_KEYBOARD hook.

Try this:

uses
windows;

var
hook : cardinal;

function HookProc(nCode, wParam, lParam : integer) : integer; stdcall;
var
lpChar : word;
kState : TKeyboardState;
begin
result := CallNextHookEx(hook, nCode, wParam, lParam);
GetKeyboardState(kState);
if ToAscii(wParam, (lParam shr 16) and $ff, kState, @lpChar, 0) > 0 then begin
// lpChar should be ascii value of char - send it to your app
end;
end;

procedure HookOn;
begin
hook := SetWindowsHookEx(wh_mouse, @HookProc, hInstance, 0);
end;

procedure HookOff;
begin
UnhookWindowsHookEx(hook);
end;

ASKER CERTIFIED SOLUTION

Member_2_248744

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

edhasted

ASKER

Slick,

I've compiled the DLL but in the executable I get an "Undeclared Identifier" against the but_StartHookClick

// this is the StartHook button Click
procedure TForm1.but_StartHookClick(Sender: TObject);

What have I missed? If in doubt assume ignorance.

Many thanks,

Ed

Member_2_248744

???
I tried to give you the info in the comment -

// this is the StartHook button Click

what about that do you not understand? It is a standard Delphi Button click procedure, , , but that really does NOT matter, you can place the code I gave in ANY place where you want it to run, just have your own procedure or function and use the code above

Member_2_248744

OK, , maybe you are not familar with using Delphi ? ?
When you have your Delphi IDE running and you can see your Designing Form (Form1 I guess), click on the "Button" control in the Component Library and then click on your form where you want the button to be, , , now go to the Object inspector (usually ,default, on the left hand side of IDE) and Click the "Events" tab for the the button you just added (Button1) and double click on the "OnClick" event for that button, you should get New Code in your Form .PAS file, like this -

procedure TForm1.Button1Click(Sender: TObject);
begin

end;

now add the code from above, so you have -

procedure TForm1.Button1Click(Sender: TObject);
begin
var
StartHook: function(FormHandle: THandle): Integer;
Re: Integer;
MsgStr: String;
begin
MsgStr := 'FAILED to Load Library';
hLibGI := LoadLibrary('GetInput.dll');
if hLibGI > 0 then
begin
@StartHook := GetProcAddress(hLibGI,'StartHook');
if @StartHook <> nil then
begin
Re := StartHook(Handle);
if Re = 0 then
MsgStr := 'Success - Hooks Are Running'
else
MsgStr := 'ERROR - Hooks NOT Started, Error code is '+IntToStr(Re);
end else
begin
FreeLibrary(hLibGI);
MsgStr := 'ERROR - StartHook function NOT in Library';
end;
end;

= = = = = = = = = = = = = = = = = = =
that's as much as I know how to tell you what to do for this, , , It's just a button click. . .
I guess I should ask, , do you understand any of the code methods used here, or are you just copy and paste, and hope it works?

edhasted

ASKER

Apologies - I should have looked at the OnClick button syntax.

This works a treat and the mouse co-ordinates are neat and I'll transpose them onto a little grid box.

One final question - with the disabled students we need to know what keys they are pressing. This passes through the letters and punctuation. Can it copy with the other keys, function keys etc and show when they have been pressed.

With many thanks,

Ed

edhasted

ASKER

Thank you all for a massive amount of input oin a non-one liner solution.

Firstly I have increased to amount of points that need to be awardsed as this has taken a large amount of work. I have decided to split the points giving 200 to Slick812 as his solution gave me a working answer.

I am sure ZhaawZ's would have worked if I had the wit to work my way round it.

To you both many thanks,

Ed

edhasted

ASKER

One thing I noticed in Slick812's code when running it is that final line in

WM_LBUTTONDOWN: Str1 := 'Left Button Down';
WM_LBUTTONUP: Str1 := 'WM_LBUTTONUP';
WM_MBUTTONDOWN: Str1 := 'WM_MBUTTONDOWN';
WM_MBUTTONUP: Str1 := 'WM_MBUTTONUP';
//WM_MOUSEMOVE: Str1 := 'WM_MOUSEMOVE';
WM_NCLBUTTONDOWN: Str1 := 'WM_NCLBUTTONDOWN';
WM_RBUTTONDOWN: Str1 := 'WM_RBUTTONDOWN';
WM_RBUTTONUP: Str1 := 'WM_RBUTTONDOWN';

should read

WM_RBUTTONUP: Str1 := 'WM_RBUTTONUP';

Member_2_248744

You asked about also getting the non-ascii key input, , here is some code changes that may get that to happen, at least this works for me, but I have no Idea how you might need the non-ascii key press to be translated, used, or presented.

All code in DLL is the SAME except I changed some code in the KeyHookFunc shown below -

function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): Integer; stdcall;
var
KeyState1: TKeyBoardState;
AryChar: Array[0..1] of Char;
Count: Integer;
begin
Result := 0;
if Code = HC_NOREMOVE then Exit;
Result := CallNextHookEx(0, Code, VirtualKey, KeyStroke);
if (Code <> HC_ACTION) or IsBadCodePtr(pFHandle) then Exit;

if ((KeyStroke and (1 shl 30)) <> 0) then
begin
GetKeyboardState(KeyState1);
Count := ToAscii(VirtualKey,KeyStroke, KeyState1, AryChar, 0);

// changes below
if Count = 1 then
PostMessage(pFHandle^, KeyMsg, Ord(AryChar[0]), KeyStroke)
else
PostMessage(pFHandle^, KeyMsg, -VirtualKey, KeyStroke);
// VirtualKey is made negative to singnal NON ASCII in the program message processing
end;
end;

= = = = = = = = = = = = = = = = = = = = = = = = = = = = =

All code in the program is the same except I changed some code in the HookMsgKey procedure below

procedure TForm1.HookMsgKey(var Msg1: TMessage);
var
Str1: String;
begin
{if the KEY Down is an ASCII charater that can be used in a memo text, then the
Msg1.wParam is Above Zero, if the Key Down is a NON ASCII key ,
like F6 or "Page Up" then I have set the VirtualKey to a negative in the GetInput.dll.
So I can test it here to see how to process this message}

if Msg1.wParam > 0 then // above zero, text Char to memo
Memo1.Perform(WM_CHAR, Msg1.wParam, 0)
else
begin // below zero is NOT text for memo
SetLength(Str1, 128);
if GetKeyNameText(Msg1.lParam, PChar(Str1), Length(Str1)) > 0 then
begin
{ You are not one to give information about how to deal with the output you may need !
I use the GetKeyNameText function to get some text for reference to name
the key pressed. . . HOWEVER if you need more specific actions (code functions)
or key name text you will need to set up your own case or if tests for the
Msg1.wParam (remember to change it back to a positive number) some values are -
VK_F1 = 112;
VK_F24 = 135;
VK_LEFT = 37;
VK_DOWN = 40;
VK_HOME = 36;
there are many others}

Str1 := PChar(Str1)+' Key '+IntToStr(Msg1.wParam){+ ' Vur '+IntToStr(Msg1.lParam)};
if -Msg1.wParam = VK_SHIFT then
Str1 := Str1+#13#10;
Memo1.Lines.Add(Str1);
end;
end;
end;

good luck,