API SendMessage() does not work for external app dialog - winapi

I created a form that has 2 buttons. One button pops a msgbox and the other runs form frmAPI (code is listed below) listed below. If I open the msgbox and leave it open and then run the frmAPI it will list the msgbox and its text and then close it. THis is what I expect it to do. If I open another application and generate a msgbox in that app with my frmAPI still running it will in fact list the other apps msgbox and the text but it does not close the msgbox from the other app. If Irun the frmAPI from the other app and do the same test the results are reversed. So in short it will only close the dialog from within the same app.
I would like to be able to close a dialog from any app based on it being a dialog and having text that will match my criteria. Any help on what I am doing wrong?
Thanks
Imports System.Runtime.InteropServices
Imports System.Text
Partial Public Class TestMSgBoxStuff
Inherits Form
Public Sub New()
InitializeComponent()
End Sub
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function FindWindow(lpClassName As String, lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function FindWindowEx(hwndParent As IntPtr, hwndChildAfter As IntPtr, lpszClass As String, lpszWindow As String) As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Private Shared Function GetWindowText(hWnd As IntPtr, lpString As StringBuilder, nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function GetWindowTextLength(hWnd As IntPtr) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function SendMessage(hWnd As HandleRef, Msg As UInteger, wParam As IntPtr, lParam As IntPtr) As IntPtr
End Function
<DllImport("user32", CharSet:=Runtime.InteropServices.CharSet.Auto, SetLastError:=True, ExactSpelling:=True)>
Private Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As IntPtr
End Function
Private Const WM_IME_NOTIFY As Integer = &H282
Private Const WM_DESTROY As Integer = &H2
Private Const WM_NCDESTROY As Integer = &H82
Private Const WM_CLOSE As Integer = &H10
Private Const IMN_CLOSESTATUSWINDOW As Integer = &H1
Private Const WM_KILLFOCUS As Integer = &H8
Private Const WM_COMMAND As Integer = &H11
Private Sub TestMSgBoxStuff_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim timer As New Timer()
Timer1.Interval = 10000
'detect the MessageBox every seconds
'Timer1.Tick += New EventHandler(Timer1_Tick)
Timer1.Start()
End Sub
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
'Get the MessageBox handle
Dim handle As IntPtr = FindWindow("#32770", Nothing)
Me.RichTextBox1.AppendText("Handle: " + handle.ToString() + vbLf)
'Get the Text window handle
Dim txtHandle As IntPtr = FindWindowEx(handle, IntPtr.Zero, "Static", Nothing)
Me.RichTextBox1.AppendText(vbTab & "text handle: " + txtHandle.ToString() + vbLf)
Dim len As Integer = GetWindowTextLength(txtHandle)
Dim sb As New StringBuilder()
'Get the text
GetWindowText(txtHandle, sb, len + 1)
Me.RichTextBox1.AppendText(vbTab & "text: " + sb.ToString() + vbLf & vbLf)
Me.RichTextBox1.ScrollToCaret()
SetForegroundWindow(handle)
'close the messagebox WM_CLOSE
Dim lResults As Integer = SendMessage(New HandleRef(Nothing, handle), WM_NCDESTROY, IntPtr.Zero, IntPtr.Zero)
End Sub
End Class

You may be running into User Interface Privilege Isolation. That'll block your messages from going to a higher privilege process. See also ChangeWindowsMessageFilter()
I'd suggest trying to send it a WM_COMMAND instead of a WM_CLOSE; WM_COMMAND is generally treated more gently by the system and may get through. Use BN_CLICKED as the high word of WPARAM and IDOK as the low word (assuming it has an OK button), and the handle to the OK button in LPARAM.. Other button messages are here.

Related

Windows: Auto close annoying popup (Logitech gaming software)

So Logitech keyboard s/w engineers in all their wisdom decided to implement a popup ever time you switch an application that you have custom keyboard script mapping for. Meaning that you get this pop all the time when switching for explorer to chrome to desktop to whatever. I wrote to tek support and they said in the next update it'll be addressed though that was 3 months ago and I found ppl moaning to them about this F.ing feature for a over a year and a half.
So I wrote some code to kill it.
Imports System.Runtime.InteropServices
Public Class Form1
gtr; DllImport("user32.dll", EntryPoint:="FindWindowW" lesr;
Public Shared Function FindWindowW(<MarshalAs(UnmanagedType.LPTStr)> ByVal lpClassName As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpWindowName As String) As IntPtr
End Function
gtr; DllImport("user32", EntryPoint:="SendMessageA", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True) lesr;
Public Shared Function SendMessageByString(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, <MarshalAs(UnmanagedType.VBByRefStr)> ByRef lParam As String) As Integer
End Function
Public Const WM_SYSCOMMAND As Integer = 274
Public Const SC_CLOSE As Integer = 61536
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim hWnd As IntPtr = FindWindowW("Qt5QWindowToolSaveBits", "Logitech Gaming Software")
If hWnd !== IntPtr.Zero Then
Label1.Text = "Found"
SendMessageByString(hWnd, WM_SYSCOMMAND, SC_CLOSE, 0)
Else
Label1.Text = "Nothing"
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ShowInTaskbar = False
NotifyIcon1.Visible = True
End Sub
Private Sub CloseToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CloseToolStripMenuItem.Click
Me.Close()
End Sub
End Class
So nub of this is the timer runs every 200 ms and closes the window if it is there. And it works fine but surely, and I will call you Surely, there is a better way? As you can see its coded in VB net but a bit altered to get around the code tag mangaling. I feel that this code is causing some unwanted windows problems I have that I won't go into.
Ideas ppl?

Are some modifiers not supported by SendKeys.SendWait?

I have a code that works perfectly, copying selected text from any windows application pressing CTRL+B.
However, when I change the modifiers that trigger the SendKeys.SendWait("^c") from MOD_CONTROL to MOD_ALT + MOD_SHIFT, the command SendKeys doesn't copy the text from the active window.
So pressing ALT+SHIFT+B still launch the command SendKeys, but the command doesn't copy the selected text to the clipboard.
Is there some incopatibility between the sendkeys command and the modifiers other then MOD_CONTROL?
I have tried registering different hotkeys, and different modifiers for each hotkey: sendkeys works with every hotkey with MOD_CONTROL modifier but doesn't with every hotkey with any other modifiers combination.
Public Class Form1
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
UnregisterHotKey(Nothing, HotKeyID)
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
RegisterHotKey(Me.Handle, HotKeyID, MOD_CONTROL, VK_b)
End Sub
Private Declare Function GetForegroundWindow Lib "User32" () As IntPtr
Private Declare Function RegisterHotKey Lib "User32.dll" (ByVal hWnd As IntPtr, ByVal ID As Integer, ByVal Modifiers As UInteger, ByVal VK As UInteger) As Boolean
Private Declare Function UnregisterHotKey Lib "User32.dll" (ByVal hWnd As IntPtr, ByVal ID As Integer) As Boolean
Private HotKeyID As Integer = 1
Private Const WM_HOTKEY As Integer = &H312
Private Const MOD_ALT As UInteger = 1
Private Const MOD_CONTROL As UInteger = 2
Private Const MOD_SHIFT As UInteger = 4
Private Const VK_b As UInteger = &H42
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_HOTKEY Then
Dim Modif As UInteger = (CType(m.LParam, Integer) And &HFFFF)
Dim Key As UInteger = CType(m.LParam, Integer) >> 16
If Key = VK_b And Modif = MOD_CONTROL Then
'Check foregroundwindow has a valid handle
If GetForegroundWindow <> IntPtr.Zero Then
'Send the Ctrl+C command to the active window
SendKeys.SendWait("^c")
End If
End If
Else
MyBase.WndProc(m)
End If
End Sub
End Class
If I change
If Key = VK_b And Modif = MOD_CONTROL Then
'Check foregroundwindow has a valid handle
If GetForegroundWindow <> IntPtr.Zero Then
'Send the Ctrl+C command to the active window
SendKeys.SendWait("^c")
End If
End If
With:
If Key = VK_b And Modif = MOD_ALT + MOD_SHIFT Then
'Check foregroundwindow has a valid handle
If GetForegroundWindow <> IntPtr.Zero Then
'Send the Ctrl+C command to the active window
SendKeys.SendWait("^c")
End If
End If
The command SendKeys.SendWait doesn'nt copy the selected text: can someone give me a clue?
Thank you
At last I managed it to work adding the line:
System.Threading.Thread.Sleep(300)
just before the command SendKeys.SendWait("^c")
It seems that SendKeys have issue with timing and the pause inserted resolve the issue.
So, now this code works:
Public Class Form1
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
UnregisterHotKey(Nothing, HotKeyID)
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
RegisterHotKey(Me.Handle, HotKeyID, MOD_ALT + MOD_SHIFT, VK_b)
End Sub
Private Declare Function GetForegroundWindow Lib "User32" () As IntPtr
Private Declare Function RegisterHotKey Lib "User32.dll" (ByVal hWnd As IntPtr, ByVal ID As Integer, ByVal Modifiers As UInteger, ByVal VK As UInteger) As Boolean
Private Declare Function UnregisterHotKey Lib "User32.dll" (ByVal hWnd As IntPtr, ByVal ID As Integer) As Boolean
Private Const WM_HOTKEY As Integer = &H312
Private Const MOD_ALT As UInteger = 1
Private Const MOD_CONTROL As UInteger = 2
Private Const MOD_SHIFT As UInteger = 4
Private Const VK_b As UInteger = 66
Private HotKeyID As Integer = 1
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_HOTKEY Then
Dim Modif As UInteger = (CType(m.LParam, Integer) And &HFFFF)
Dim Key As UInteger = CType(m.LParam, Integer) >> 16
If Key = VK_b And Modif = MOD_ALT + MOD_SHIFT Then
'Check foregroundwindow has a valid handle
If GetForegroundWindow <> IntPtr.Zero Then
'Send the Ctrl+C command to the active window
System.Threading.Thread.Sleep(300)
SendKeys.SendWait("^c")
End If
End If
Else
MyBase.WndProc(m)
End If
End Sub
End Class

VB.net Unable to load data with Windows API into ComboBox

I'm trying to fasten up the loading of one form, which populates several combobox with a big amount of data. I did my best stopping the UI while loading ecc shredding the loading time from 20s to 13s, but still the only bottleneck remaining is loading data into ComboBox which takes about 3-4s each. I did research on the internet and found that using Windows API you can fasten it up a lot more. So I did the code:
Private Const CB_ERR As Integer = -1
Private Const CB_ADDSTRING As Integer = &H143
Private Const CB_SETITEMDATA As Integer = &H151
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, lParam As String) As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, <MarshalAs(UnmanagedType.AsAny)> lParam As Object) As IntPtr
End Function
Public Sub AddItem(cmb As ComboBox, Item As Object)
Dim l As IntPtr
Dim kryptoncmb As KryptonComboBox
Try
kryptoncmb = TryCast(cmb.Parent.Parent, KryptonComboBox)
If kryptoncmb Is Nothing Then kryptoncmb = TryCast(cmb.Parent.Parent, KubaUtility.KryptonComboBox)
If kryptoncmb IsNot Nothing Then
l = SendMessage(kryptoncmb.Handle, CB_ADDSTRING, IntPtr.Zero, Item.ToString())
SendMessage(kryptoncmb.Handle, CB_SETITEMDATA, l, Item)
Else
l = SendMessage(cmb.Handle, CB_ADDSTRING, IntPtr.Zero, Item.ToString())
SendMessage(cmb.Handle, CB_SETITEMDATA, l, Item)
End If
Catch ex As Exception
End Try
End Sub
My problem is that when it gets to CB_SETITEMDATA, it tries to load the item's data but instead it throws an Exception:
No existing PInvoke conversion for the value passed to the Object type parameter.
The object I try to pass is a custom class but it's plain simple, just bunch of properties.

How can I get any Browser's URL in VB6?

Recently, I was trying to make a program for saving all visited URLs in a text file from any browser using Visual Basic 6. I have found some codes for VB.NET, but I like programming in VB6.
VB.NET Code for getting browser URL
Option Explicit On
Imports System.Text
Imports System.Runtime.InteropServices.Marshal
Module CurrentUrl
#Region " Overview & References "
'Overview:
'Function GetCurrentUrl returns the URL of the selected browser (IE or Chrome; Firefox to be added).
'Most of the code is based on the references listed below, but this function starts with
'the browser's main window handle and returns only 1 URL.
'It also builds a simple "treeview" of the windows up to the target window's classname.
'References:
'http://www.xtremevbtalk.com/archive/index.php/t-129988.html
'http://social.msdn.microsoft.com/forums/en-us/vbgeneral/thread/321D0EAD-CD50-4517-BC43-29190542DCE0
'http://social.msdn.microsoft.com/Forums/en/vbgeneral/thread/02a67f3a-4a26-4d9a-9c67-0fdff1428a66
#End Region
#Region " Declares, Constants, and Variables"
Private Delegate Function EnumProcDelegate(ByVal hwnd As IntPtr, ByVal lParam As IntPtr) As Boolean 'Delegate added
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumProcDelegate, ByVal lParam As IntPtr) As Boolean
Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal wCmd As IntPtr) As IntPtr
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As IntPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDFIRST = 0
Private sURL As String 'String that will contain the URL
Private cbWindows As ComboBox 'Treeview"
Private sIndent As String 'Spaces
Private sBrowser As String 'Starting window (IE or Chrome)
Private sClassName As String = "Edit" 'Default
#End Region
Public Function GetCurrentUrl(ByVal hwnd As IntPtr, ByVal browser As String, ByVal classname As String, ByVal combo As ComboBox) As String
sBrowser = browser
sClassName = classname
cbWindows = combo
If cbWindows IsNot Nothing Then
If cbWindows.GetType.Name = "ComboBox" Then
cbWindows.Items.Clear()
Else
cbWindows = Nothing
End If
End If
sURL = ""
sIndent = ""
EnumWindows(AddressOf EnumProc, hwnd) 'hwnd - originally IntPtr.Zero
Return sURL
End Function
' Enumerate the windows
' Find the URL in the browser window
Private Function EnumProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Dim buf As StringBuilder = New StringBuilder(256) 'String * 1024
Dim title As String
Dim length As Integer
' Get the window's title.
length = GetWindowText(hWnd, buf, buf.Capacity)
title = Left(buf.ToString, length)
' See if the title ends with the browser name
Dim s As String = sBrowser
Dim inprivate = sBrowser & " - [InPrivate]" 'IE adds this to the window title
If title <> "" Then
If (Right(title, s.Length) = s) Or (Right(title, inprivate.Length) = inprivate) Then
' This is it. Find the URL information.
sURL = EditInfo(hWnd, cbWindows)
Return False
End If
End If
' Continue searching
Return True
End Function
' If this window is of the Edit class (IE) or Chrome_AutocompleteEditView (Google), return its contents.
' Otherwise search its children for such an object.
Private Function EditInfo(ByVal window_hwnd As IntPtr, ByRef cbWindows As ComboBox) As String
Dim txt As String = ""
Dim buf As String
Dim buflen As Integer
Dim child_hwnd As IntPtr
Dim children() As IntPtr = {}
Dim num_children As Integer
Dim i As Integer
'Get the class name.
buflen = 256
buf = Space(buflen - 1)
buflen = GetClassName(window_hwnd, buf, buflen)
buf = Left(buf, buflen)
'Add an item to the window list combo, indent as required
If cbWindows IsNot Nothing Then
cbWindows.Items.Add(sIndent & buf)
End If
' See if we found an Edit/AutocompleteEditView object.
If buf = sClassName Then
Return WindowText(window_hwnd)
End If
' It's not an Edit/AutocompleteEditView object. Search the children.
' Make a list of the child windows.
num_children = 0
child_hwnd = GetWindow(window_hwnd, GW_CHILD)
While child_hwnd <> 0
num_children = num_children + 1
ReDim Preserve children(0 To num_children) 'was 1 to ..
children(num_children) = child_hwnd
child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
End While
' Get information on the child windows.
sIndent &= " "
For i = 1 To num_children
txt = EditInfo(children(i), cbWindows)
If txt <> "" Then Exit For
Next i
sIndent = Left(sIndent, sIndent.Length - 4)
Return txt
End Function
' ************************************************
' Return the text associated with the window.
' ************************************************
Private Function WindowText(ByVal window_hwnd As IntPtr) As String
Dim txtlen As Integer
Dim txt As String
txt = "" 'WindowText = ""
If window_hwnd = 0 Then Return "" 'Exit Function
'Get the size of the window text
txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
If txtlen = 0 Then Return "" 'Exit Function
'Extra for terminating char
txtlen = txtlen + 1
'Alloc memory for the buffer that recieves the text
Dim buffer As IntPtr = AllocHGlobal(txtlen)
'Send The WM_GETTEXT Message
txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, buffer) 'byval txt
'Copy the characters from the unmanaged memory to a managed string
txt = PtrToStringAnsi(buffer)
Return Left(txt, txtlen)
End Function
End Module

How can I lock an application after period of user inactivity?

How can I lock an application after period of user inactivity?
I have a fat Windows applocation written in VB6. User must log into the application to use it. I need to log the user out after a period of inactivity. There are over 100 separate forms with one Main form that is always open after the user logs in, so I am looking for an application solution not a form level solution.
I am thinking about monitoring keyboard and mouse usage using WIN API.
Are you looking to measure inactivity in/of the application? Or the entire desktop?
If the latter, I’d suggest looking at GetLastInputInfo which you could call from time to time, either from another app, or from a timer in your main window. You can find a VB6 example of it's use here, though you can call it from just about any language you want as it is a Win32 API.
Here is the solution I decided upon. I wanted to document it properly. As this is the approach I had envisioned, it is not my code. Someone smarter than I did awhile ago.
I simply implemented the solution into my application.
Solution was posted by DaVBMan
Sample code
Original discussion thread.
The app is an multiple-document interface app.
In a common.bas module:
WIN API Code: for Keyboard and Mouse monitoring:
Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Const LLKHF_EXTENDED = &H1&
Private Const LLKHF_INJECTED = &H10&
Private Const LLKHF_ALTDOWN = &H20&
Private Const LLKHF_UP = &H80&
Private Const VK_RIGHT = &H27
Private Const VK_LEFT = &H25
Private Const VK_RSHIFT = &HA1
Private Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
Flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private m_hDllKbdHook As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Global variables to hold DateTime last user activity and if mouse and keyboard activity has occurred
Public KeysHaveBeenPressed As Boolean
Public HasMouseMoved As Boolean
Public gLastUserActivity As Date
Code to detect keyboard activity
Public Function HookKeyboard() As Long
On Error GoTo ErrorHookKeyboard
m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
HookKeyboard = m_hDllKbdHook
Exit Function
ErrorHookKeyboard:
MsgBox Err & ":Error in call to HookKeyboard()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Function
End Function
Public Sub UnHookKeyboard()
On Error GoTo ErrorUnHookKeyboard
UnhookWindowsHookEx (m_hDllKbdHook)
Exit Sub
ErrorUnHookKeyboard:
MsgBox Err & ":Error in call to UnHookKeyboard()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Sub
End Sub
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static kbdllhs As KBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
'keys have been pressed
KeysHaveBeenPressed = True
End If
LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, nCode, wParam, lParam)
End Function
Code to detect mouse movement:
Public Sub CheckMouse()
On Error GoTo ErrCheckMouse
Dim p As POINTAPI
GetCursorPos p
If p.x <> LastMouse.x Or p.y <> LastMouse.y Then
HasMouseMoved = True
LastMouse.x = p.x
LastMouse.y = p.y
End If
Exit Sub
ErrCheckMouse:
MsgBox Err.Number & ": Error in CheckMouse(). Error Description: " & Err.Description, vbCritical, "Error"
Exit Sub
End Sub
On the Main parent Form:
Added a timer:
Private Sub muTimer_Timer()
CheckMouse
'Debug.Print "MU Timer Fire"
'Debug.Print "Keyboard:" & KeysHaveBeenPressed & " - " & "Mouse:" & HasMouseMoved
If HasMouseMoved = False And KeysHaveBeenPressed = False Then
If DateDiff("m", gLastUserActivity, Now) > gnMUTimeOut Then
muTimer.Interval = 0
<Make call to lock the application>
Else
'Debug.Print " dT "; DateDiff("s", gLastUserActivity, Now)
End If
Else
HasMouseMoved = False
KeysHaveBeenPressed = False
gLastUserActivity = Now
End If
'Debug.Print " dT "; DateDiff("s", gLastUserActivity, Now)
End Sub
Also on the MainForm load event:
Private Sub MDIForm_Load()
HookKeyboard
end sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnHookKeyboard
end sub

Resources