i would like to have program a timer that will count the seconds during which there is mouse movement or any keyboard movement.
the point of this application is to record the amount of time an employee has been using the computer (does not matter what purpose or application it has been in use for)
i would like to do this in vb.net for winforms
I do exactly this using P/Invoke to talk to the GetLastInputInfo API.
Edit: Here's a complete VB.Net program to display the number of milliseconds since the last input event, system-wide. It sleeps for a second before getting the information, so it reports a time of around a thousand milliseconds, assuming you use the mouse or keyboard to run it. :-)
Imports System.Runtime.InteropServices
Module Module1
<StructLayout(LayoutKind.Sequential)> _
Public Structure LASTINPUTINFO
Public Shared ReadOnly SizeOf As Integer = Marshal.SizeOf(GetType(LASTINPUTINFO))
<MarshalAs(UnmanagedType.U4)> _
Public cbSize As Integer
<MarshalAs(UnmanagedType.U4)> _
Public dwTime As Integer
End Structure
<DllImport("user32.dll")> _
Public Function GetLastInputInfo(ByRef plii As LASTINPUTINFO) As Boolean
End Function
Sub Main()
Dim lii As New LASTINPUTINFO()
lii.cbSize = LASTINPUTINFO.SizeOf
lii.dwTime = 0
System.Threading.Thread.Sleep(1000)
GetLastInputInfo(lii)
MsgBox((Environment.TickCount - lii.dwTime).ToString)
End Sub
End Module
Related
I am making a bare bone application and I would like to avoid adding a form class to my project.
Here is what I have done so far
First my new project is a "Empty Project (.NET framework"
Then I added a single empty class file
Then I added the system.windows.forms reference to my project
Lastly I add the following code
Imports System.Windows.Forms
Public Class AppCore
Inherits ApplicationContext
Shared Sub main()
Dim myAppCore As AppCore
myAppCore = New AppCore
System.Windows.Forms.Application.Run(myAppCore)
End Sub
End Class
From that point on, I have a barebone working app that does nothing but stays running forever.
Now I want to registers the keys combo "ALT+F6" and "ALT+F7"
I add the following code
Public Const MOD_CONTROL As Integer = &H11
Public Const MOD_SHIFT As Integer = &H10
Public Const MOD_ALT As Integer = &H1
Public Const WM_HOTKEY As Integer = &H312
Public Declare Function RegisterHotKey Lib "user32.dll" Alias "RegisterHotKey" (ByVal hwnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Integer) As Integer
Public Declare Function UnregisterHotKey Lib "user32.dll" Alias "UnregisterHotKey" (ByVal hwnd As IntPtr, ByVal id As Integer) As Integer
Sub New()
RegisterHotKey(Me.Handle, 100, MOD_ALT, Keys.F6)
RegisterHotKey(Me.Handle, 200, MOD_ALT, Keys.F7)
End Sub
Protected Overrides Sub DefWndProc(ByRef m As System.Windows.Forms.Message)
MyBase.DefWndProc(m)
Dim x As Long
If m.Msg = WM_HOTKEY Then
Select Case CType(m.WParam, Integer)
Case 100
Beep()
Case 200
Beep()
End Select
End If
End Sub
This is where I run into trouble
First in Sub New(), the IDE is telling me that Handle is not part of appcore/applicationcontext
Second, I get the following error
At this point I am stuck !
How can I create hotkeys without adding a form ?
For DefWndProc, maybe I can get away with only removing the "Overrides" keywork and dropping "MyBase.DefWndProc(m)" ?
But I think the bigger problem is how to get a handle ?
Maybe I should look at the CreateWindow API ?
EDIT :
I have modified this project to include a new class of type NativeWindow
as follows
Imports System.Windows.Forms
Public Class clsHotkey
Inherits NativeWindow
Public Const WM_HOTKEY As Integer = &H312
Protected Overloads Sub DefWndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_HOTKEY Then
Select Case CType(m.WParam, Integer)
Case 100
Console.WriteLine("ID 100")
Case 200
Console.WriteLine("ID 200")
End Select
End If
End Sub
End Class
This provides the bare minimum to have a window handle for RegisterHotkey.
I have also modified the AppCore class to work with it.
It compiles and runs without error but the hotkeys do nothing
I believe this is because I have replaced the override keywork in the definition of the DefWndProc subroutine by overloads
If I try to use overrides, I get the following error
BC31086 'Protected Overrides Sub DefWndProc(ByRef m As Message)' cannot override 'Public Overloads Sub DefWndProc(ByRef m As Message)' because it is not declared 'Overridable'.
At this point I am stuck. I would rather not use a form class because of the added complexity (especially the addition of a designer file for it which will make manual compiling more complicated)
Is there a way to make it work with NativeWindow class ? Or some other alternative class that can obtain a window handle ?
Thanks !
My English is not so good, but I try to make a logic story.
I like home domotica, so I made a program in visual basic (visual studio) that control de lightning of my room (with Arduino). A function of the program is turning on/off the lights when I run an application in full screen (for movies, gaming). I used a code for detect full screen from internet, but the part for comparing the forgroundscreen with the desktop isn't working, I get a falsely fullscreen. :
Private Function detectfullscreen()
'Detect if the current app is running in full screen
Dim runningFullScreen As Boolean = False
Dim appBounds As RECT
Dim screenBounds As Rectangle
Dim hWnd As IntPtr
'get the dimensions of the active window
hWnd = GetForegroundWindow()
If hWnd <> Nothing AndAlso Not hWnd.Equals(IntPtr.Zero) Then
'Check we haven't picked up the desktop or the shell
If Not (hWnd.Equals(desktopHandle) OrElse hWnd.Equals(shellHandle)) Then
'If hWnd <> GetDesktopWindow() Then
GetWindowRect(hWnd, appBounds)
'determine if window is fullscreen
screenBounds = Screen.FromHandle(hWnd).Bounds
If (appBounds.Bottom - appBounds.Top) = screenBounds.Height AndAlso (appBounds.Right - appBounds.Left) = screenBounds.Width Then
runningFullScreen = True
End If
End If
End If
Return runningFullScreen
End Function
The rest of de code (for the register) is:
<StructLayout(LayoutKind.Sequential)> Public Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Private desktopHandle As IntPtr = GetDesktopWindow()
Private shellHandle As IntPtr = GetShellWindow()
<DllImport("user32.dll")> Private Shared Function GetForegroundWindow() As IntPtr
End Function
<DllImport("user32.dll")> Private Shared Function GetDesktopWindow() As IntPtr
End Function
The code works perfect and i use a timer to run this sub, but if I go to desktop, the program also thinks I use a full screen application.
My operatingsystem is Windows 10, is it possible that I need an other way to detect if the current forgroundscreen is the desktop? I try to use de ID of the desktop, but when I restart the computer, this ID will change.
I hoop my story was clear. Thank you for reading this!
So, I've made an iterative Towers of Hanoi algorithm in Visual Basic, that runs in a while loop (recursion is slow in VB). The catch is it compiles okey, it even runs okey when launched through Visual Studio, but when launched though the Debug and Release generated execs the animation stops with the following message:
After a while, I just see all the pieces moved to the destination pole and the message disappears. So its not a crash per say, as the application is still running in the background, its just this message that pops out, ruining the animation. I just want my program to run just as it runs when launched directly from Visual Studio.
After a bit of thinking ...
I'm starting to believe this happens because Win7 treats the fact the application runs in a while loop as unresponsive (7 pieces in Towers of Hanoi ca take a while to rearrange), therefore it tries to close it.
How can I just make my application ignore Window's advertisements ?
I suggest that you do the calculation in the application idle event just like you do when creating a windows game. This way you ensure that the message queue is not blocked.
Public Class Form1
Public Sub New()
Me.InitializeComponent()
AddHandler Application.Idle, AddressOf Me.OnApplicationIdle
End Sub
Private Sub OnApplicationIdle(sender As Object, e As EventArgs)
Static rnd As New Random()
Dim message As MSG = Nothing
Do While (Not PeekMessage(message, IntPtr.Zero, 0, 0, 0))
'...
Me.BackColor = Color.FromArgb(rnd.Next(0, 256), rnd.Next(0, 256), rnd.Next(0, 256))
'...
Loop
End Sub
<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
Friend Shared Function PeekMessage(<[In](), Out()> ByRef msg As MSG, ByVal hwnd As IntPtr, ByVal msgMin As Integer, ByVal msgMax As Integer, ByVal remove As Integer) As Boolean
End Function
<StructLayout(LayoutKind.Sequential)> _
Friend Structure MSG
Public hwnd As IntPtr
Public message As Integer
Public wParam As IntPtr
Public lParam As IntPtr
Public time As Integer
Public pt_x As Integer
Public pt_y As Integer
End Structure
End Class
I have installed Phoenetic Key board for Urdu language, that I can select from Control Panel > Languages > Keyboard
Can I add languages and select keyboard using my vb.net code?
Thanks
The InputLanguage.CurrentInputLanguage property lets you switch keyboard layouts. Not so sure it can deal with multiple layouts for a single language but I don't really know what "Phoenetic Key board" really means. The underlying Windows api functions are LoadKeyboardLayout() and ActivateKeyboardLayout(), you could pinvoke them. GetKeyboardLayoutList() to get a list of installed layouts, you probably need that, GetKeyboardLayoutName() to get a description of a layout. Also covered by the InputLanguage class.
You normally leave it up to the user to select keyboard layouts, forcing your preference is pretty hostile to usability. Easy to do with the language bar.
You can change your application Input language this way:
InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(New System.Globalization.CultureInfo("ZH-CN"))
but if you don't have the required InputLanguage Installed you can install your cultures input language from code temporary by using windows api:
<DllImport("user32.dll")> _
Private Shared Function UnloadKeyboardLayout(hkl As IntPtr) As Boolean
End Function
<DllImport("user32.dll")> _
Private Shared Function LoadKeyboardLayout(pwszKLID As String, Flags As UInteger) As IntPtr
End Function
Public Class KeyboardHolder
Implements IDisposable
Private ReadOnly pointer As IntPtr
Public Sub New(klid As Integer)
pointer = LoadKeyboardLayout(klid.ToString("X8"), 1)
End Sub
Public Sub New(culture As CultureInfo)
Me.New(culture.KeyboardLayoutId)
End Sub
Public Sub Dispose()
UnloadKeyboardLayout(pointer)
GC.SuppressFinalize(Me)
End Sub
Protected Overrides Sub Finalize()
Try
UnloadKeyboardLayout(pointer)
Finally
MyBase.Finalize()
End Try
End Sub
End Class
and use it this way:
' install keyboard layout temporary
Dim keyboard As New KeyboardHolder(New System.Globalization.CultureInfo("ZH-CN"))
' after finishing what you want remove temporary added keyboard layout:
keyboard.Dispose()
I'm trying to use an unmanaged dll in VB.NET. The example source code provided with the dll is in VB6 and below is my attempt to convert it to .NET. When the dll tries to do a callback I get a "Attempted to read or write protected memory" exception. I really don't care about the callback function getting actually called.
My code:
<DllImport("AlertMan.dll")> _
Public Shared Function AlertManC( _
ByVal CallbackAddr As AlertManCallbackDel) As Long
End Function
Public Delegate Sub AlertManCallbackDel(ByVal data As Long)
Public Sub AlertManCallback(ByVal data As Long)
End Sub
Public mydel As New AlertManCallbackDel(AddressOf AlertManCallback)
'protected memeory exception here
Dim IStat as Long = AlertManC(mydel)
Original VB6 example code:
Declare Function AlertManC _
Lib "AlertMan.dll" _
Alias "AlertManC" (ByVal CallbackAddr As Long) As Long
Private Sub AlertManCallback(ByVal data As Long)
End Sub
' calling code
Dim IStat As Long
IStat = AlertManC(AddressOf AlertManCallBack)
Original dll header
typedef void TACBFUNC(char *);
int AlertManC(TACBFUNC *WriteCaller cHANDLEPARM);
Can you post the original native definiton for AlertManC?
My guess though is that the data parameter of the callback function is actually an Integer vs. a Long. In VB6 I believe Long's were actually only 32 bits vs. VB.Net where they are 64 bit. Try this
<DllImport("AlertMan.dll")> _
Public Shared Function AlertManC(ByVal CallbackAddr As AlertManCallbackDel) As Long
End Function
Public Delegate Sub AlertManCallbackDel(ByVal data As IntPtr)
Public Sub AlertManCallback(ByVal data As IntPtr)
End Sub
Edit
I updated the code based on the native signature you posted. Can you try this out?
Your callback should look like this:
Public Delegate Sub AlertManCallbackDel(ByRef data As Byte)
The reason for this being that you are passing a single-byte value by reference.
As for the declaration of the unmanaged function, it should look like this:
<DllImport("AlertMan.dll")> _
Public Shared Function AlertManC( _
ByVal CallbackAddr As AlertManCallbackDel) As Integer
End Function
Note that the return type is an Integer, which in VB.NET is a 32-bit value. In VB6, a Long was a 32-bit value, hence the need for a change in VB.NET.
The callback definition is important to get right as well, btw.
If the callback's calling convention is cdecl, you cant do that directly in C# or VB.NET.
You will have to modify the IL of the delegate to behave correctly.
You can search on CodeProject for an in-depth article.
Update:
I guess not the correct answer :) But will leave my response.