i__h4x programming?

GetWindowPos - The equivalent of SetWindowPos API

Right, well for anyone that has used the SetWindowPos API, you will realise that there is no single way to get the equivalent values returned to you.

As I’m lazy, I like to be able to do things easily in one nice neat function, without having to call things here and there to achieve my target.

If you use the function on a control, it will return the handles for the buttons next in the forms Z order.

If the handle passed for hwnd is invalid, the function will return 0 for all values.

hwnd - In - The handle of the window you wish to get the information from

ptrPhwnd - Out - Returns the handle of the previous window in the Z order

ptrNhwnd - Out - Returns the handle of the next window in the Z order

ptPoint - Out - Returns the location of the specified window on the screen

szSize - Out - Returns the size of the specified window

intShowCmd - Out - Returns the state of the window, returns a WNDSTATE value

Public Sub GetWindowPos( _

ByVal hwnd As Integer, _

ByRef ptrPhwnd As Integer, _

ByRef ptrNhwnd As Integer, _

ByRef ptPoint As Point, _

ByRef szSize As Size, _

ByRef intShowCmd As WNDSTATE _

)

Dim wInf As WINDOWPLACEMENT

wInf.Length = System.Runtime.InteropServices.Marshal.SizeOf(wInf)

GetWindowPlacement(hwnd, wInf)

szSize = New Size(wInf.rcNormalPosition.Right - wInf.rcNormalPosition.Left, _

wInf.rcNormalPosition.Bottom - wInf.rcNormalPosition.Top)

ptPoint = New Point(wInf.rcNormalPosition.Left, wInf.rcNormalPosition.Top)

ptrPhwnd = GetNextWindow(hwnd, GW_HWNDPREV)

ptrNhwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

intShowCmd = wInf.showCmd

End Sub

Example usage of this:

”The size of the window

Dim wSize As New Size

”The location of the window

Dim wLocation As New Point

”The previous/next windows handles

Dim wPhwnd, wNhwnd As Integer

”The window state of the window

Dim wShowCmd As WNDSTATE

”Calling the function to these variables

GetWindowPos(Me.Handle, wPhwnd, wNhwnd, wLocation, wSize, wShowCmd)

________________________

And for the WNDSTATE Enum used in the function

Public Enum WNDSTATE

SW_HIDE = 0

SW_SHOWNORMAL = 1

SW_NORMAL = 1

SW_SHOWMINIMIZED = 2

SW_MAXIMIZE = 3

SW_SHOWNOACTIVATE = 4

SW_SHOW = 5

SW_MINIMIZE = 6

SW_SHOWMINNOACTIVE = 7

SW_SHOWNA = 8

SW_RESTORE = 9

SW_SHOWDEFAULT = 10

SW_MAX = 10

End Enum

________________________

And the APIs used in the Function

Private Declare Function GetNextWindow Lib “user32″ Alias “GetWindow” (ByVal hwnd As IntPtr, ByVal wFlag As Integer) As IntPtr

Private Declare Function GetWindowPlacement Lib “user32″ (ByVal hwnd As IntPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Integer

________________________

And the rest

Private Const GW_HWNDNEXT = 2

Private Const GW_HWNDPREV = 3

Private Structure POINTAPI

Public x As Integer

Public y As Integer

End Structure

Private Structure RECT

Public Left As Integer

Public Top As Integer

Public Right As Integer

Public Bottom As Integer

End Structure

Private Structure WINDOWPLACEMENT

Public Length As Integer

Public flags As Integer

Public showCmd As Integer

Public ptMinPosition As POINTAPI

Public ptMaxPosition As POINTAPI

Public rcNormalPosition As RECT

End Structure

This is just a slightly more efficient way to change your MSN name than using SendKeys.

It uses the SendMessage API in order to set the text, rather than SendKeys.

The code is pretty fully commented, and so there is nothing much to explain…

Below is the full source file:

Imports System.Runtime.InteropServices

Public Class Form1

”API

<DllImport(“User32.dll”)> Private Shared Function EnumChildWindows(ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess, ByVal lParam As IntPtr) As Boolean

End Function

<DllImport(“user32.dll”, CharSet:=CharSet.Auto)> Private Shared Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)

End Sub

<DllImport(“user32.dll”, SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer

End Function

<DllImport(“user32.dll”, SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer

End Function

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wparam As Integer, ByVal lparam As System.Text.StringBuilder) As IntPtr

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr

Private Declare Auto Function FindWindow Lib “user32″ (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr

”API Functions

Private Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr()

Dim ChildrenList As New List(Of IntPtr)

Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)

Try

EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle))

Finally

If ListHandle.IsAllocated Then ListHandle.Free()

End Try

Return ChildrenList.ToArray

End Function

Private Shared Function EnumWindow(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

Dim ChildrenList As List(Of IntPtr) = GCHandle.FromIntPtr(Parameter).Target

If ChildrenList Is Nothing Then Throw New Exception(“GCHandle Target could not be cast as List(Of IntPtr)”)

ChildrenList.Add(Handle)

Return True

End Function

Public Shared Function GetText(ByVal hWnd As IntPtr) As String

Dim length As Integer

If hWnd.ToInt32 <= 0 Then

Return Nothing

End If

length = GetWindowTextLength(hWnd)

If length = 0 Then

Return Nothing

End If

Dim sb As New System.Text.StringBuilder(“”, length + 1)

GetWindowText(hWnd, sb, sb.Capacity)

Return sb.ToString()

End Function

”Constants

Private Const WM_SETTEXT = &HC

Private Const WM_CHAR = &H102

Private Const WM_KEYDOWN = &H100

Private Const WM_KEYUP = &H101

Private Const WM_SETFOCUS = &H7

”Window Enum Delegate

Private Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

”This function finds the Handle for the MSN Options window

Private Shared Function FindMSN() As IntPtr

FindMSN = FindWindow(vbNullString, “Options”)

End Function

”This function Sends the text to the Options window

Public Shared Function SendText(Optional ByVal Display_Text As String = “”, Optional ByVal Personal_Text As String = “”) As Boolean

”Create the Messenger API

Dim iMessenger As MessengerAPI.Messenger

iMessenger = New MessengerAPI.Messenger

”Show the options window

iMessenger.OptionsPages(0, MessengerAPI.MOPTIONPAGE.MOPT_GENERAL_PAGE)

”Get the options windows handle

Dim handle As IntPtr = FindMSN()

”This will keep looping until the window is found

Do

handle = FindMSN()

Loop Until handle <> 0

”Sleeps the thread while the options window loads

System.Threading.Thread.Sleep(60)

”i is our counter for which control we are on

Dim i As Integer = 0

”Loop through each of the child windows

For Each child As IntPtr In GetChildWindows(handle)

”Gets the class name of the child

Dim sClassName As New System.Text.StringBuilder(“”, 256)

Call GetClassName(child, sClassName, 256)

”Converts it to a readable string

Dim x As String = sClassName.ToString

”If its a textbox

If x = “RichEdit20W” Then

i += 1

”If we are on the first control, the display name box

If i = 1 Then

”If display text is being changed

If Display_Text <> “” Then

”Send the display text to the textbox

Dim sb As New System.Text.StringBuilder(Display_Text)

SendMessage(child, WM_SETTEXT, 0, sb)

SendMessage(child, WM_CHAR, 13, 1)

End If

”If we are on the second control, the personal message box

ElseIf i = 2 Then

”If we are changing the personal text

If Personal_Text <> “” Then

”Send the personal message text to the textbox

Dim sb As New System.Text.StringBuilder(Personal_Text)

SendMessage(child, WM_SETTEXT, 0, sb)

SendMessage(child, WM_CHAR, 13, 1)

End If

End If

”If the child control is the “OK” button

ElseIf GetText(child) = “OK” Then

”Focus the button

SendMessage(child, WM_SETFOCUS, 0, 0)

”Press the Space button, to save changes

SendMessage(child, WM_KEYDOWN, &H20, 390001)

SendMessage(child, WM_CHAR, &H63, 11101)

SendMessage(child, WM_KEYUP, &H20, 390001)

End If

Next

End Function

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

”Create the Messenger API

Dim oMessenger As MessengerAPI.Messenger

oMessenger = New MessengerAPI.Messenger

”Set the status to offline

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE

”Change name

SendText(“Mine”)

”Sleep the thread

System.Threading.Thread.Sleep(700)

”Set status to online

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE

”Repeat

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE

SendText(“beats”)

System.Threading.Thread.Sleep(700)

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE

SendText(“yours”)

System.Threading.Thread.Sleep(700)

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE

SendText(“cyb3r”)

System.Threading.Thread.Sleep(700)

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE

SendText(“d3m0n”)

System.Threading.Thread.Sleep(700)

oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE

End Sub

End Class

You might want to make a function that automates the repeating

Imports System.Runtime.InteropServices
Public Class Form1

”API
<DllImport(”User32.dll”)> Private Shared Function EnumChildWindows(ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess, ByVal lParam As IntPtr) As Boolean
End Function
<DllImport(”user32.dll”, CharSet:=CharSet.Auto)> Private Shared Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)
End Sub
<DllImport(”user32.dll”, SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
End Function
<DllImport(”user32.dll”, SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer
End Function

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wparam As Integer, ByVal lparam As System.Text.StringBuilder) As IntPtr
Private Declare Auto Function SendMessage Lib “user32″ (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr
Private Declare Auto Function FindWindow Lib “user32″ (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr

”API Functions
Private Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr()
Dim ChildrenList As New List(Of IntPtr)
Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)
Try
EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle))
Finally
If ListHandle.IsAllocated Then ListHandle.Free()
End Try
Return ChildrenList.ToArray
End Function
Private Shared Function EnumWindow(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean
Dim ChildrenList As List(Of IntPtr) = GCHandle.FromIntPtr(Parameter).Target
If ChildrenList Is Nothing Then Throw New Exception(”GCHandle Target could not be cast as List(Of IntPtr)”)
ChildrenList.Add(Handle)
Return True
End Function
Public Shared Function GetText(ByVal hWnd As IntPtr) As String
Dim length As Integer
If hWnd.ToInt32 <= 0 Then
Return Nothing
End If
length = GetWindowTextLength(hWnd)
If length = 0 Then
Return Nothing
End If
Dim sb As New System.Text.StringBuilder(”", length + 1)
GetWindowText(hWnd, sb, sb.Capacity)
Return sb.ToString()
End Function

”Constants
Private Const WM_SETTEXT = &HC
Private Const WM_CHAR = &H102
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_SETFOCUS = &H7

”Window Enum Delegate
Private Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

”This function finds the Handle for the MSN Options window
Private Shared Function FindMSN() As IntPtr
FindMSN = FindWindow(vbNullString, “Options”)
End Function

”This function Sends the text to the Options window
Public Shared Function SendText(Optional ByVal Display_Text As String = “”, Optional ByVal Personal_Text As String = “”) As Boolean
”Create the Messenger API
Dim iMessenger As MessengerAPI.Messenger
iMessenger = New MessengerAPI.Messenger
”Show the options window
iMessenger.OptionsPages(0, MessengerAPI.MOPTIONPAGE.MOPT_GENERAL_PAGE)
”Get the options windows handle
Dim handle As IntPtr = FindMSN()
”This will keep looping until the window is found
Do
handle = FindMSN()
Loop Until handle <> 0
”Sleeps the thread while the options window loads
System.Threading.Thread.Sleep(60)
”i is our counter for which control we are on
Dim i As Integer = 0
”Loop through each of the child windows
For Each child As IntPtr In GetChildWindows(handle)
”Gets the class name of the child
Dim sClassName As New System.Text.StringBuilder(”", 256)
Call GetClassName(child, sClassName, 256)
”Converts it to a readable string
Dim x As String = sClassName.ToString
”If its a textbox
If x = “RichEdit20W” Then
i += 1
”If we are on the first control, the display name box
If i = 1 Then
”If display text is being changed
If Display_Text <> “” Then
”Send the display text to the textbox
Dim sb As New System.Text.StringBuilder(Display_Text)
SendMessage(child, WM_SETTEXT, 0, sb)
SendMessage(child, WM_CHAR, 13, 1)
End If
”If we are on the second control, the personal message box
ElseIf i = 2 Then
”If we are changing the personal text
If Personal_Text <> “” Then
”Send the personal message text to the textbox
Dim sb As New System.Text.StringBuilder(Personal_Text)
SendMessage(child, WM_SETTEXT, 0, sb)
SendMessage(child, WM_CHAR, 13, 1)
End If
End If
”If the child control is the “OK” button
ElseIf GetText(child) = “OK” Then
”Focus the button
SendMessage(child, WM_SETFOCUS, 0, 0)
”Press the Space button, to save changes
SendMessage(child, WM_KEYDOWN, &H20, 390001)
SendMessage(child, WM_CHAR, &H63, 11101)
SendMessage(child, WM_KEYUP, &H20, 390001)
End If
Next
End Function

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
”Create the Messenger API
Dim oMessenger As MessengerAPI.Messenger
oMessenger = New MessengerAPI.Messenger
”Set the status to offline
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE
”Change name
SendText(”Mine”)
”Sleep the thread
System.Threading.Thread.Sleep(700)
”Set status to online
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE

”Repeat
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE
SendText(”beats”)
System.Threading.Thread.Sleep(700)
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE
SendText(”yours”)
System.Threading.Thread.Sleep(700)
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE
SendText(”cyb3r”)
System.Threading.Thread.Sleep(700)
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_INVISIBLE
SendText(”d3m0n”)
System.Threading.Thread.Sleep(700)
oMessenger.MyStatus = MessengerAPI.MISTATUS.MISTATUS_ONLINE
End Sub
End Class

Installing a Low Level Mouse Hook

MouseHookYeah!

This hook is basically the same as the Keyboard hook, just, with a mouse and a few extra things…

Below is the basic class that you need:

Private Class MouseHook

”Constants

Private Const HC_ACTION As Integer = 0

Private Const WH_MOUSE_LL As Integer = 14

Private Const WM_MOUSEMOVE As Integer = &H200

Private Const WM_LBUTTONDOWN As Integer = &H201

Private Const WM_LBUTTONUP As Integer = &H202

Private Const WM_LBUTTONDBLCLK As Integer = &H203

Private Const WM_RBUTTONDOWN As Integer = &H204

Private Const WM_RBUTTONUP As Integer = &H205

Private Const WM_RBUTTONDBLCLK As Integer = &H206

Private Const WM_MBUTTONDOWN As Integer = &H207

Private Const WM_MBUTTONUP As Integer = &H208

Private Const WM_MBUTTONDBLCLK As Integer = &H209

Private Const WM_MOUSEWHEEL As Integer = &H20A

”Mouse Structures

Public Structure POINT

Private x As Integer

Private y As Integer

End Structure

Private Structure MSLLHOOKSTRUCT

Private pt As POINT

Private mouseData As Integer

Private flags As Integer

Private time As Integer

Private dwExtraInfo As Integer

End Structure

”API Functions

Private Declare Function SetWindowsHookEx Lib “user32″ Alias “SetWindowsHookExA” (ByVal idHook As Integer, ByVal lpfn As MouseProcDelegate, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer

Private Declare Function CallNextHookEx Lib “user32″ (ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As MSLLHOOKSTRUCT) As Integer

Private Declare Function UnhookWindowsHookEx Lib “user32″ (ByVal hHook As Integer) As Integer

”Our Mouse Delegate

Private Delegate Function MouseProcDelegate(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As MSLLHOOKSTRUCT) As Integer

”The Mouse events

Public Shared Event MouseMove()

Public Shared Event MouseEvent(ByVal mEvent As Integer)

”The identifyer for our MouseHook

Private Shared MouseHook As Integer

”MouseHookDelegate

Private Shared MouseHookDelegate As MouseProcDelegate

Public Sub New()

”Installs a Low Level Mouse Hook

MouseHookDelegate = New MouseProcDelegate(AddressOf MouseProc)

MouseHook = SetWindowsHookEx(WH_MOUSE_LL, MouseHookDelegate, Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)

End Sub

Private Shared Function MouseProc(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As MSLLHOOKSTRUCT) As Integer

”If it is a Mouse event

If (nCode = HC_ACTION) Then

If wParam = WM_MOUSEMOVE Then

”If it is the mouse moving

RaiseEvent MouseMove()

ElseIf wParam = WM_LBUTTONDOWN Or wParam = WM_LBUTTONUP Or wParam = WM_LBUTTONDBLCLK Or wParam = WM_RBUTTONDOWN Or wParam = WM_RBUTTONUP Or wParam = WM_RBUTTONDBLCLK Or wParam = WM_MBUTTONDOWN Or wParam = WM_MBUTTONUP Or wParam = WM_MBUTTONDBLCLK Or wParam = WM_MOUSEWHEEL Then

”If it is a different mouse event

RaiseEvent MouseEvent(wParam)

End If

End If

”Next

Return CallNextHookEx(MouseHook, nCode, wParam, lParam)

End Function

Protected Overrides Sub Finalize()

”On close it UnHooks the Hook

UnhookWindowsHookEx(MouseHook)

MyBase.Finalize()

End Sub

End Class

The important part this time is in the MouseProc function

If (nCode = HC_ACTION) Then

If wParam = WM_MOUSEMOVE Then

”If it is the mouse moving

RaiseEvent MouseMove()

ElseIf wParam = WM_LBUTTONDOWN Or wParam = WM_LBUTTONUP Or wParam = WM_LBUTTONDBLCLK Or wParam = WM_RBUTTONDOWN Or wParam = WM_RBUTTONUP Or wParam = WM_RBUTTONDBLCLK Or wParam = WM_MBUTTONDOWN Or wParam = WM_MBUTTONUP Or wParam = WM_MBUTTONDBLCLK Or wParam = WM_MOUSEWHEEL Then

”If it is a different mouse event

RaiseEvent MouseEvent(wParam)

End If

End If

This raises one of the two events: MouseMove or MouseEvent

Private Shadows Sub MouseMove() Handles MHook.MouseMove

”This keeps the form on top, and sets it so that it moves with the cursor

Me.BringToFront()

Me.Location = New Point(Windows.Forms.Cursor.Position.X - (Me.Width / 2), Windows.Forms.Cursor.Position.Y - (Me.Height / 2))

End Sub

That’s just a basic sub that moves the form’s centre to the location of the mouse cursor, whenever the mouse is moved it follows it around.

Private Sub MouseEvent(ByVal mEvent As Integer) Handles MHook.MouseEvent

”Saves a basic log of the mouse events

Dim x As Integer = Windows.Forms.Cursor.Position.X

Dim y As Integer = Windows.Forms.Cursor.Position.Y

If mEvent = 513 Then

Log &= Now & ” - Left Down - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = 514 Then

Log &= Now & ” - Left Up - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H203 Then

Log &= Now & ” - Left Double Click - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H204 Then

Log &= Now & ” - Right Down - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H205 Then

Log &= Now & ” - Right Up - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H206 Then

Log &= Now & ” - Right Double Click - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H207 Then

Log &= Now & ” - Middle Down - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H208 Then

Log &= Now & ” - Middle Up - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H209 Then

Log &= Now & ” - Middle Double Click - (” & x & “, “ & y & “)” & vbNewLine

ElseIf mEvent = &H20A Then

Log &= Now & ” - Mouse Scroll - (” & x & “, “ & y & “)” & vbNewLine

”Displays the log

MsgBox(Log)

End If

End Sub

That has a little more to it, it determines what the event was, then saves a log accordingly.

Now, in order to make this function, just add the MouseHook class, and the two subs to your form along with this:

Private WithEvents MHook As MouseHook

Dim Log As String

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

”Hooks The Mouse

MHook = New MouseHook

End Sub

Which makes the whole thing work J

Oh, and just for the record, either run this program OUTSIDE the IDE or:

In solution explorer, click on My Project

Go to Debug

Uncheck ‘Enable the Visual Studio hosting process’

Same goes with the keyboard hook.

Installing a Low Level Keyboard Hook

KeyBoardHookYeah!

Below is the basic class you need in order to Hook the Keyboard:

Private Class KeyboardHook

”Constants

Private Const HC_ACTION As Integer = 0

Private Const WH_KEYBOARD_LL As Integer = 13

Private Const WM_KEYDOWN = &H100

Private Const WM_KEYUP = &H101

Private Const WM_SYSKEYDOWN = &H104

Private Const WM_SYSKEYUP = &H105

”Keypress Structure

Public Structure KBDLLHOOKSTRUCT

Public vkCode As Integer

Public scancode As Integer

Public flags As Integer

Public time As Integer

Public dwExtraInfo As Integer

End Structure

”API Functions

Private Declare Function SetWindowsHookEx Lib “user32″ Alias “SetWindowsHookExA” (ByVal idHook As Integer, ByVal lpfn As KeyboardProcDelegate, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer

Private Declare Function CallNextHookEx Lib “user32″ (ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As KBDLLHOOKSTRUCT) As Integer

Private Declare Function UnhookWindowsHookEx Lib “user32″ (ByVal hHook As Integer) As Integer

”Our Keyboard Delegate

Private Delegate Function KeyboardProcDelegate(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer

”The KeyPress event

Public Shared Event KeyDown(ByVal vkCode As Integer)

Public Shared Event KeyUp(ByVal vkCode As Integer)

”The identifyer for our KeyHook

Private Shared KeyHook As Integer

”KeyHookDelegate

Private Shared KeyHookDelegate As KeyboardProcDelegate

Public Sub New()

”Installs a Low Level Keyboard Hook

KeyHookDelegate = New KeyboardProcDelegate(AddressOf KeyboardProc)

KeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, KeyHookDelegate, Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)

End Sub

Private Shared Function KeyboardProc(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer

”If it is a keypress

If (nCode = HC_ACTION) Then

Select Case wParam

”If it is a Keydown Evend

Case WM_KEYDOWN, WM_SYSKEYDOWN

”Activates the KeyDown event in Form 1

RaiseEvent KeyDown(lParam.vkCode)

Case WM_KEYUP, WM_SYSKEYUP

”Activates the KeyUp event in Form 1

RaiseEvent KeyUp(lParam.vkCode)

End Select

End If

”Next

Return CallNextHookEx(KeyHook, nCode, wParam, lParam)

End Function

Protected Overrides Sub Finalize()

”On close it UnHooks the Hook

UnhookWindowsHookEx(KeyHook)

MyBase.Finalize()

End Sub

End Class

The important part to notice is in the KeyboardProc:

Select Case wParam

”If it is a Keydown Evend

Case WM_KEYDOWN, WM_SYSKEYDOWN

”Activates the KeyDown event in Form 1

RaiseEvent KeyDown(lParam.vkCode)

Case WM_KEYUP, WM_SYSKEYUP

”Activates the KeyUp event in Form 1

RaiseEvent KeyUp(lParam.vkCode)

End Select

This is the code that will fire up the KeyDown or KeyUp events, in these two subs:

Private Shadows Sub KeyUp(ByVal KeyCode As Integer) Handles KeyHook.KeyUp

Dim cha As Char = ChrW(KeyCode)

My.Computer.FileSystem.WriteAllText(“logU.txt”, cha, True)

End Sub

Private Shadows Sub KeyDown(ByVal KeyCode As Integer) Handles KeyHook.KeyDown

Dim cha As Char = ChrW(KeyCode)

My.Computer.FileSystem.WriteAllText(“logD.txt”, cha, True)

End Sub

This will basically convert the key that was pressed to its char equivalent, and then save it to a log file, however this isn’t suitable for all the keys (E.g. space, ctrl, alt, shift, etc) as they do not have char characters.

Now, I thought for a while about what the best way to create a proper log would be, and I kind of gave up of doing it a clever way, so I replaced the code inside of the two events with:

Dim str As String = “”

If KeyCode = 27 Then

str = “{Esc}”

ElseIf KeyCode = &H3 Then

str = “{Cancel}”

ElseIf KeyCode = &H8 Then

str = “{Backspace}”

ElseIf KeyCode = &H9 Then

str = “{Tab}”

ElseIf KeyCode = &HC Then

str = “{Clear}”

ElseIf KeyCode = &HD Then

str = “{Enter}” & vbNewLine

ElseIf KeyCode = &H10 Then

str = “{Shift}”

ElseIf KeyCode = &H11 Then

str = “{Ctrl}”

ElseIf KeyCode = &H12 Then

str = “{Menu}”

ElseIf KeyCode = &H13 Then

str = “{Pause}”

ElseIf KeyCode = &H14 Then

str = “{Caps Lock}”

ElseIf KeyCode = &H20 Then

str = ” “

ElseIf KeyCode = &H21 Then

str = “{Page Up}”