Stop the screen saver and hibernation temporarily in VB.Net - vb.net

I have a very long running syncronization task that cannot be interrupted by the screen saver or aggressive power saving modes. I want to make a single api call to stop power save mode and then restore it once the task is done.
The following code is peaced together from various other posts but it has no effect on XP's power management settings. What am I doing wrong? TIA!
Private Declare Function SetThreadExecutionState Lib "kernel32" (ByVal esFlags As Long) As Long
Public Enum EXECUTION_STATE As Integer
ES_CONTINUOUS = &H80000000
ES_DISPLAY_REQUIRED = &H2
ES_SYSTEM_REQUIRED = &H1
ES_AWAYMODE_REQUIRED = &H40
End Enum
Public Shared Sub PowerSaveOff()
SetThreadExecutionState(EXECUTION_STATE.ES_DISPLAY_REQUIRED Or EXECUTION_STATE.ES_CONTINUOUS)
End Sub
Public Shared Sub PowerSaveOn()
SetThreadExecutionState(EXECUTION_STATE.ES_CONTINUOUS)
End Sub
Here are the systems screensaver and powermode settings:
alt text http://img87.imageshack.us/img87/1600/25251376.jpg
alt text http://img403.imageshack.us/img403/8145/73347627.jpg

I added EXECUTION_STATE.ES_SYSTEM_REQUIRED, which "Forces the system to be in the working state by resetting the system idle timer," and prevents the system from entering a power saving state. I also changed the API calling convention to use EXECUTION_STATE, wrapped everything in a simple utility class with some documentation.
''' <summary>
''' Simple power manager class that enables applications to inform the system
''' that it is in use, thereby preventing the system from entering the sleeping
''' power state or turning off the display while the application is running.
''' </summary>
Public Class PowerManager
#Region " Private Sub New "
Private Sub New()
'keep compiler from creating default constructor to create utility class
End Sub
#End Region
''' <summary>
''' Enables applications to inform the system that it is in use, thereby preventing the system from entering the sleeping power state or turning off the display while the application is running.
''' </summary>
''' <param name="esFlags">The thread's execution requirements. This parameter can be one or more of the EXECUTION_STATE values.</param>
''' <returns>
''' <para>If the function succeeds, the return value is the previous thread execution state, as a EXECUTION_STATE value.</para>
''' <para>If the function fails, the return value is NULL.</para>
'''</returns>
''' <remarks>
''' <para>This function does not stop the screen saver from executing.</para>
''' <para>http://msdn.microsoft.com/en-us/library/aa373208.aspx</para>
''' </remarks>
Private Declare Function SetThreadExecutionState Lib "kernel32" (ByVal esFlags As EXECUTION_STATE) As EXECUTION_STATE
Public Enum EXECUTION_STATE As Integer
''' <summary>
''' Informs the system that the state being set should remain in effect until the next call that uses ES_CONTINUOUS and one of the other state flags is cleared.
''' </summary>
ES_CONTINUOUS = &H80000000
''' <summary>
''' Forces the display to be on by resetting the display idle timer.
''' </summary>
ES_DISPLAY_REQUIRED = &H2
''' <summary>
''' Forces the system to be in the working state by resetting the system idle timer.
''' </summary>
ES_SYSTEM_REQUIRED = &H1
End Enum
Public Shared Function PowerSaveOff() As EXECUTION_STATE
Return SetThreadExecutionState(EXECUTION_STATE.ES_SYSTEM_REQUIRED Or EXECUTION_STATE.ES_DISPLAY_REQUIRED Or EXECUTION_STATE.ES_CONTINUOUS)
End Function
Public Shared Function PowerSaveOn() As EXECUTION_STATE
Return SetThreadExecutionState(EXECUTION_STATE.ES_CONTINUOUS)
End Function
End Class
Public Class Form1
Private _cancel As Boolean
Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
'set system standby to one minute
_cancel = False
PowerManager.PowerSaveOff()
Do Until _cancel
My.Application.DoEvents()
Loop
PowerManager.PowerSaveOn()
'do not forget to restore your power settings
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
_cancel = True
End Sub
End Class

This works for me:
Private Const SPI_SETSCREENSAVEACTIVE = 17
Private Const SPI_SETSCREENSAVETIMEOUT = 15
Private Const SPIF_SENDWININICHANGE = &H2
Private Const SPIF_UPDATEINIFILE = &H1
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Long, ByVal fuWinIni As Long) As Long
Private Sub Form_Load()
Call SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, 0, SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, 0, SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)
End Sub

Microsoft.Win32.RegistryKey rkScreenSaver =
Microsoft.Win32.Registry.CurrentUser.OpenSubKey(#" Control Panel\Desktop", true );
if ( (string)rkScreenSaver.GetValue( "ScreenSaveActive" ) == "1" )
{
rkScreenSaver.SetValue( "ScreenSaveActive", "0" );
rkScreenSaver.Close( );
}
This should work for you.
Alternatively why not extend the time for the screen saver to 10 minutes?

Related

Interrupt Mousehook, dispose and create new Mousehook?

I am using a Mousehook ( I tried 2 different hooks) but it crashes. I think the reason for that is doing mouseclick during unfinished calculations. I don't know the exact reason but after a while it stops working.
So I tried another thing, everytime I finished the calculation, I disposed the (old) Mousehook and created a new one.
This worked great and does the job...but this time the application crashes after a while with a "garbage collection" and "Invoke" error. I think the reason for that is that I can't get rid of a hook like I do ? But is something like that possible ?
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.ComponentModel
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Diagnostics
#End Region
#Region " MouseHook "
''' <summary>
''' A low level mouse hook that processes mouse input events.
''' </summary>
Friend NotInheritable Class MouseHook : Implements IDisposable
#Region " P/Invoke "
Protected NotInheritable Class NativeMethods
#Region " Methods "
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function CallNextHookEx(
ByVal idHook As IntPtr,
ByVal nCode As Integer,
ByVal wParam As IntPtr,
ByVal lParam As IntPtr
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function SetWindowsHookEx(
ByVal idHook As HookType,
ByVal lpfn As LowLevelMouseProcDelegate,
ByVal hInstance As IntPtr,
ByVal threadId As UInteger
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function UnhookWindowsHookEx(
ByVal idHook As IntPtr
) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Public Shared Function GetDoubleClickTime() As Integer
End Function
#End Region
#Region " Enumerations "
Public Enum WindowsMessages As UInteger
WM_MOUSEMOVE = &H200UI
WM_LBUTTONDOWN = &H201UI
WM_LBUTTONUP = &H202UI
WM_RBUTTONDOWN = &H204UI
WM_RBUTTONUP = &H205UI
WM_MBUTTONDOWN = &H207UI
WM_MBUTTONUP = &H208UI
WM_MOUSEWHEEL = &H20AUI
End Enum
Public Enum HookType As UInteger
' **************************************
' This enumeration is partially defined.
' **************************************
''' <summary>
''' Installs a hook procedure that monitors low-level mouse input events.
''' For more information, see the LowLevelMouseProc hook procedure.
''' </summary>
WH_MOUSE_LL = 14UI
End Enum
<Flags()>
Public Enum MsllHookStructFlags As Integer
''' <summary>
''' Test the event-injected (from any process) flag.
''' </summary>
LLMHF_INJECTED = 1I
''' <summary>
''' Test the event-injected (from a process running at lower integrity level) flag.
''' </summary>
LLMHF_LOWER_IL_INJECTED = 2I
End Enum
#End Region
#Region " Structures "
''' <summary>
''' The POINT structure defines the x- and y- coordinates of a point.
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx
''' </summary>
<StructLayout(LayoutKind.Sequential)>
Public Structure Point
Public X As Integer
Public Y As Integer
End Structure
Public Structure MsllHookStruct
''' <summary>
''' The ptThe x- and y-coordinates of the cursor, in screen coordinates.
''' </summary>
Public Pt As NativeMethods.Point
''' <summary>
''' If the message is 'WM_MOUSEWHEEL', the high-order word of this member is the wheel delta.
''' The low-order word is reserved.
''' A positive value indicates that the wheel was rotated forward, away from the user;
''' a negative value indicates that the wheel was rotated backward, toward the user.
''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
''' </summary>
Public MouseData As Integer
''' <summary>
''' The event-injected flag.
''' </summary>
Public Flags As MsllHookStructFlags
''' <summary>
''' The time stamp for this message.
''' </summary>
Public Time As UInteger
''' <summary>
''' Additional information associated with the message.
''' </summary>
Public DwExtraInfo As IntPtr
End Structure
#End Region
#Region " Delegates "
''' <summary>
''' Delegate LowLevelMouseProc
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644986%28v=vs.85%29.aspx
''' </summary>
''' <returns>
''' If nCode is less than zero, the hook procedure must return the value returned by CallNextHookEx.
''' If nCode is greater than or equal to zero, and the hook procedure did not process the message,
''' it is highly recommended that you call CallNextHookEx and return the value it returns;
''' otherwise, other applications that have installed WH_MOUSE_LL hooks will not receive hook notifications
''' and may behave incorrectly as a result.
''' If the hook procedure processed the message,
''' it may return a nonzero value to prevent the system from passing the message to the rest of the hook chain or the target window procedure.
''' </returns>
Public Delegate Function LowLevelMouseProcDelegate(
ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr
) As Integer
#End Region
End Class
#End Region
#Region " Properties "
''' <summary>
''' Handle to the hook procedure.
''' </summary>
Private Property MouseHook As IntPtr
''' <summary>
''' The mouse hook delegate.
''' </summary>
Private Property MouseHookDelegate As NativeMethods.LowLevelMouseProcDelegate
''' <summary>
''' Determines whether the Hook is installed.
''' </summary>
Public Property IsInstalled As Boolean
''' <summary>
''' Determines whether the Hook is enabled.
''' </summary>
Public Property IsEnabled As Boolean = False
''' <summary>
''' ** ONLY FOR TESTING PURPOSES **
''' Gets or sets a value indicating whether to suppress the last MouseUp event of
''' the specified clicked button when a double-click fires.
'''
''' If this value is set to <c>true</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseDoubleClick
'''
''' If this value is set to <c>false</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseUp, MouseDoubleClick
'''
''' </summary>
''' <value><c>true</c> if MouseUp event is suppressed; otherwise <c>false</c>.</value>
Public Property SuppressMouseUpEventWhenDoubleClick As Boolean = False
''' <summary>
''' Gets or sets the screen's working area.
''' The events fired by this <see cref="MouseHook"/> instance will be restricted to the bounds of the specified rectangle.
''' </summary>
''' <value>The screen's working area.</value>
Public Property WorkingArea As Rectangle
Get
Return Me.workingarea1
End Get
Set(ByVal value As Rectangle)
Me.workingarea1 = value
'MsgBox(WorkingArea.Bottom.ToString)
End Set
End Property
''' <summary>
''' The screen's working area
''' </summary>
Private workingarea1 As Rectangle = SystemInformation.VirtualScreen
#End Region
#Region " Enumerations "
''' <summary>
''' Indicates the whell direction of the mouse.
''' </summary>
Public Enum WheelDirection As Integer
''' <summary>
''' The wheel is moved up.
''' </summary>
WheelUp = 1I
''' <summary>
''' The wheel is moved down.
''' </summary>
WheelDown = 2I
End Enum
#End Region
#Region " Events "
Public Event MouseMove(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseWheel(ByVal sender As Object,
ByVal mouseLocation As Point,
ByVal wheelDirection As WheelDirection)
#End Region
#Region " Exceptions "
''' <summary>
''' Exception that is thrown when trying to enable or uninstall a mouse hook that is not installed.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotInstalledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not installed.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to disable a mouse hook that is not enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to enable a mouse hook that is already enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is already enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
#End Region
#Region " Constructors "
'Private Sub New()
'End Sub
''' <summary>
''' Initializes a new instance of the <see cref="MouseHook"/> class.
''' </summary>
''' <param name="Install">
''' If set to <c>true</c>, the Hook starts initialized for this <see cref="MouseHook"/> instance.
''' </param>
Public Sub New(Optional ByVal install As Boolean = False)
If install Then
Me.Install()
End If
End Sub
#End Region
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
End Function
#Region " Public Methods "
''' <summary>
''' Installs the Mouse Hook, then start processing messages to fire events.
''' </summary>
Public Sub Install()
If Me.IsVisualStudioHostingProcessEnabled() Then
Throw New Exception("Visual Studio Hosting Process should be deactivated.")
Exit Sub
End If
Me.MouseHookDelegate = New NativeMethods.LowLevelMouseProcDelegate(AddressOf LowLevelMouseProc)
Try
Me.MouseHook = NativeMethods.SetWindowsHookEx(NativeMethods.HookType.WH_MOUSE_LL,
Me.MouseHookDelegate,
Getmodulehandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
Me.IsInstalled = True
Catch ex As Exception
Throw
End Try
End Sub
''' <summary>
''' Uninstalls the Mouse Hook and free all resources, then stop processing messages to fire events.
''' </summary>
Public Sub Uninstall()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
Else
Me.IsEnabled = False
Me.IsInstalled = False
Me.Finalize()
End If
End Sub
''' <summary>
''' Temporally disables the Mouse Hook events.
''' To Re-enable the events, call the <see cref="Enable"/> method.
''' </summary>
Public Sub Disable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Not Me.IsEnabled Then
Throw New MouseHookNotEnabledException
Else
Me.IsEnabled = False
End If
End Sub
''' <summary>
''' Re-enables the Mouse Hook events.
''' </summary>
Public Sub Enable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Me.IsEnabled Then
Throw New MouseHookEnabledException
Else
Me.IsEnabled = True
End If
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Determines whether the Visual Studio Hosting Process is enabled on the current application.
''' </summary>
''' <returns><c>true</c> if Visual Studio Hosting Process is enabled; otherwise, <c>false</c>.</returns>
Private Function IsVisualStudioHostingProcessEnabled() As Boolean
Return AppDomain.CurrentDomain.FriendlyName.EndsWith("vshost.exe", StringComparison.OrdinalIgnoreCase)
End Function
Private Function LowLevelMouseProc(ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr) As Integer
If Not Me.IsEnabled Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
Static leftClickTime As Integer = 0I ' Determines a left button double-click.
Static rightClickTime As Integer = 0I ' Determines a right button double-click.
Static middleClickTime As Integer = 0I ' Determines a middle button double-click.
If nCode = 0I Then
Dim x As Integer
Dim y As Integer
Dim mouseStruct As NativeMethods.MsllHookStruct
mouseStruct = CType(Marshal.PtrToStructure(lParam, mouseStruct.GetType()),
NativeMethods.MsllHookStruct)
' Fix X coordinate.
Select Case mouseStruct.Pt.X
Case Is <= 0I
If mouseStruct.Pt.X >= Me.WorkingArea.Location.X Then
x = mouseStruct.Pt.X
ElseIf mouseStruct.Pt.X <= Me.WorkingArea.Location.X Then
If mouseStruct.Pt.X <= (Me.WorkingArea.Location.X - Me.WorkingArea.Width) Then
x = (Me.WorkingArea.Location.X - Me.WorkingArea.Width)
Else
x = mouseStruct.Pt.X
End If
End If
Case Is >= Me.WorkingArea.Width
x = Me.WorkingArea.Width
Case Else
x = mouseStruct.Pt.X
End Select
' Fix Y coordinate.
Select Case mouseStruct.Pt.Y
Case Is >= Me.WorkingArea.Height
y = Me.WorkingArea.Height
Case Is <= 0I
y = 0I
Case Else
y = mouseStruct.Pt.Y
End Select
If x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X > Me.WorkingArea.Width Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X < Me.WorkingArea.X Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x = Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x - 1, y) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
ElseIf x < Me.WorkingArea.Width AndAlso
y = Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x, y - 1) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End If
Select Case wParam
Case NativeMethods.WindowsMessages.WM_MOUSEMOVE
RaiseEvent MouseMove(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONDOWN
RaiseEvent MouseLeftDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONUP
If leftClickTime <> 0 Then
leftClickTime = Environment.TickCount() - leftClickTime
End If
If (leftClickTime <> 0I) AndAlso (leftClickTime < NativeMethods.GetDoubleClickTime()) Then
leftClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
RaiseEvent MouseLeftDoubleClick(Me, New Point(x, y))
Else
leftClickTime = Environment.TickCount()
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_RBUTTONDOWN
RaiseEvent MouseRightDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_RBUTTONUP
If rightClickTime <> 0I Then
rightClickTime = Environment.TickCount() - rightClickTime
End If
If (rightClickTime <> 0I) AndAlso (rightClickTime < NativeMethods.GetDoubleClickTime()) Then
rightClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
RaiseEvent MouseRightDoubleClick(Me, New Point(x, y))
Else
rightClickTime = Environment.TickCount()
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MBUTTONDOWN
RaiseEvent MouseMiddleDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_MBUTTONUP
If middleClickTime <> 0I Then
middleClickTime = Environment.TickCount() - middleClickTime
End If
If (middleClickTime <> 0I) AndAlso (middleClickTime < NativeMethods.GetDoubleClickTime()) Then
middleClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
RaiseEvent MouseMiddleDoubleClick(Me, New Point(x, y))
Else
middleClickTime = Environment.TickCount()
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MOUSEWHEEL
RaiseEvent MouseWheel(Me, New Point(x, y), If(mouseStruct.MouseData < 0I,
WheelDirection.WheelDown,
WheelDirection.WheelUp))
Case Else
' Do Nothing
Exit Select
End Select
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf nCode < 0I Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
Else ' nCode > 0
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End Function
#End Region
#Region "IDisposable Support"
''' <summary>
''' Flag to detect redundant calls at <see cref="Dispose"/> method.
''' </summary>
Private disposedValue As Boolean
Protected Sub Dispose(ByVal disposing As Boolean)
Me.IsEnabled = False
If Not Me.disposedValue Then
If disposing Then ' Dispose managed state (managed objects).
Else ' Free unmanaged resources (unmanaged objects).
NativeMethods.UnhookWindowsHookEx(Me.MouseHook)
End If
End If
Me.disposedValue = True
End Sub
Protected Overrides Sub Finalize()
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=False)
MyBase.Finalize()
End Sub
Private Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=True)
GC.SuppressFinalize(obj:=Me)
End Sub
#End Region
End Class
#End Region
There's not nearly enough documentation in this post. You should be able to post a small reproducible example. Statements like "stops working" just really don't convey anything. And if you're getting errors, please post the exception.
With that said...
Sounds like your callback is being garbage collected. You need to keep the delegate around in a variable that has at least the lifetime of the hook. A Shared class member is a good candidate.
For example:
'BAD!
Class MyClass
Public Sub Run()
Dim Hook as MouseHook = New MouseHook()
'install, enable, etc...
End Sub
'Hook is not saved and will be collected after Run() ends
End Class
Should be:
'Better
Class MyClass
Private Shared Hook as MouseHook
Public Sub Run()
Hook = New MouseHook()
'install, enable, etc...
End Sub
'Now, Hook IS saved and will live on after Run() ends
End Class
This is very basic and you should adapt it to your needs. Again, this is just a guess as there isn't really enough information to go further than that.

Click messagebox from code

Alright so, don't ask why, PLEASE, but i really need this.
So, i'll display a MessageBox to the user for 2 seconds then i need to close it automatically, without the user input.
Messagebox.Show("RandomStringHere")
System.Threading.Thread.Sleep("2000")
And here i got stuck. Is there any way possible i can do this? And please don't ask why, but it is indeed necessary.
I couldn't find any help on the internet with this problem i have so i guess you guys can help me.
Just create your own form. You can do this in the designer or using code as in the example below. Set a timer and close the form in two seconds:
Private _msgForm As Form
Private _tmr As Windows.Forms.Timer
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
_msgForm = New Form
With _msgForm
.Height = 200
.Width = 300
.StartPosition = FormStartPosition.CenterScreen
.Text = "Message"
End With
Dim btn As New Button
With btn
.Text = "OK"
.Top = _msgForm.Height - 75
.Left = _msgForm.Width - 100
.Anchor = AnchorStyles.Right Or AnchorStyles.Bottom
End With
_msgForm.Controls.Add(btn)
Dim lbl As New Label
With lbl
.Text = "This is the text of the message box"
.Left = 0
.Top = 0
.Width = _msgForm.ClientSize.Width
.Height = _msgForm.ClientSize.Height - 120
.Anchor = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top
End With
_msgForm.Controls.Add(lbl)
_tmr = New Windows.Forms.Timer
With _tmr
.Interval = 2000
.Enabled = True
End With
AddHandler _tmr.Tick, AddressOf TimerTick
AddHandler btn.Click, AddressOf ButtonClick
_msgForm.ShowDialog()
End Sub
Private Sub TimerTick(sender As Object, e As EventArgs)
_msgForm.Close()
End Sub
Private Sub ButtonClick(sender As Object, e As EventArgs)
CType(sender, Button).FindForm.Close()
End Sub
Example usage:
Using New CenteredMessageBox(Owner:=Me,
TextFont:=Me.Font,
TimeOut:=2500)
MessageBox.Show("Test Text",
"Test Title",
MessageBoxButtons.OK,
MessageBoxIcon.Information)
End Using
The Custom MessageBox:
' [ Centered MessageBox ]
' By Elektro
'
' The author of the original idea is Hans Passant:
' http://stackoverflow.com/questions/2576156/winforms-how-can-i-make-messagebox-appear-centered-on-mainform
'
' Examples :
'
'Using New CenteredMessageBox(Owner:=Me,
' TextFont:=New Font("Lucida Console", Font.SizeInPoints, FontStyle.Bold),
' TimeOut:=2500)
'
' MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
'
'End Using
#Region " Centered MessageBox Class"
#Region " Imports "
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
#End Region
Class CenteredMessageBox : Implements IDisposable
#Region " Variables, Objects, Properties "
Private mTries As Integer = 0
Private mOwner As Form
Private mFont As Font
Private mTimeOut As Integer
Private WithEvents TimeoutTimer As Timer
Private ReadOnly Property MessageBoxWindowHandle As IntPtr
Get
Return _MessageBoxWindowHandle
End Get
End Property
Dim _MessageBoxWindowHandle As IntPtr = IntPtr.Zero
#End Region
#Region " P/Invoke "
Friend Class NativeMethods
Friend Const WM_SETFONT As Integer = &H30
Friend Const WM_GETFONT As Integer = &H31
Friend Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
Friend Declare Function SetWindowPos Lib "user32" (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As UInt32) As Boolean
<DllImport("user32.dll")>
Friend Shared Function EnumThreadWindows(tid As Integer, callback As NativeMethods.EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll")>
Friend Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Unicode)>
Friend Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll")>
Friend Shared Function GetDlgItem(hWnd As IntPtr, item As Integer) As IntPtr
End Function
<DllImport("user32.dll")>
Friend Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wp As IntPtr, lp As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")>
Friend Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")>
Friend Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
End Function
''' <summary>
''' <para>The DestroyWindow function destroys the specified window. The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it. The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership, and breaks the clipboard viewer chain (if the window is at the top of the viewer chain).</para>
''' <para>If the specified window is a parent or owner window, DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window. The function first destroys child or owned windows, and then it destroys the parent or owner window.</para>
''' <para>DestroyWindow also destroys modeless dialog boxes created by the CreateDialog function.</para>
''' </summary>
''' <param name="hwnd">Handle to the window to be destroyed.</param>
''' <returns>If the function succeeds, the return value is nonzero. If the function fails, the return value is zero. To get extended error information, call GetLastError.</returns>
<DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
Friend Shared Function DestroyWindow(hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
End Class
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="CenteredMessageBox"/> class.
''' </summary>
''' <param name="Owner">Indicates the form that owns this messagebox.</param>
''' <param name="TextFont">Indicates the text-font used to display the text label.</param>
''' <param name="TimeOut">
''' Indicates the timeout, in ms, to auto-close this <see cref="CenteredMessageBox"/>
''' Default is '0' which means Infinite.
''' </param>
Public Sub New(ByVal Owner As Form,
Optional TextFont As Font = Nothing,
Optional TimeOut As Integer = 0I)
mOwner = Owner
mFont = TextFont
mTimeOut = TimeOut
Owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
#End Region
#Region " Private MEthods "
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then
Return
End If
Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf checkWindow)
If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then
If System.Threading.Interlocked.Increment(mTries) < 10 Then
mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End If
End If
If mTimeOut > 0 Then
TimeoutTimer = New Timer With {.Interval = mTimeOut, .Enabled = True}
TimeoutTimer.Start()
End If
End Sub
Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
' Checks if <hWnd> is a dialog
Dim sb As New StringBuilder(260)
NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
If sb.ToString() <> "#32770" Then Return True
' Get the STATIC control that displays the text
Dim hText As IntPtr = NativeMethods.GetDlgItem(hWnd, &HFFFF)
Me._MessageBoxWindowHandle = hWnd
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As RECT
NativeMethods.GetWindowRect(hWnd, dlgRect)
If hText <> IntPtr.Zero Then
If mFont Is Nothing Then
' Get the current font
mFont = Font.FromHfont(NativeMethods.SendMessage(hText, NativeMethods.WM_GETFONT, IntPtr.Zero, IntPtr.Zero))
ElseIf mFont IsNot Nothing Then
NativeMethods.SetWindowPos(hText, 0, 70, 35, frmRect.Width, mFont.Height, 0)
End If
NativeMethods.SendMessage(hText, NativeMethods.WM_SETFONT, mFont.ToHfont(), New IntPtr(1))
' Resize and positionate the messagebox window:
NativeMethods.MoveWindow(hWnd,
frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2,
frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2,
(dlgRect.Right - dlgRect.Left),
(dlgRect.Bottom - dlgRect.Top), True)
End If
' Done
Return False
End Function
#End Region
#Region " Event Handlers "
Private Sub TimeoutTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles TimeoutTimer.Tick
NativeMethods.DestroyWindow(Me._MessageBoxWindowHandle)
Me.Dispose()
End Sub
#End Region
#Region " IDisposable "
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
mOwner = Nothing
If mFont IsNot Nothing Then mFont.Dispose()
End Sub
#End Region
End Class
#End Region

Me.Handle in Module - Alternative?

I am currently programming something but I've hit a small problem, which is:
Using Me.Handle in a module that will be used as the source for a CodeDom-Compiler.
I want or rather need to use it in the following procedure:
Private Const APPCOMMAND_VOLUME_MUTE As Integer = &H80000
Private Const WM_APPCOMMAND As Integer = &H319
Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Sub Mute()
SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
You get the idea, I want to mute the System-Sound. I am more or less searching for some way of doing
this without using Me.Handle, as it is not working in my module for some reason...
Any help is appreciated, thanks in advance guys!
SendMessage requires a handle to a form, which you don't have in a module or standard class.
Three options are either to pass in a reference to a form like this:
Private Sub Mute(formRef As Form)
SendMessageW(formRef.Handle, WM_APPCOMMAND, formRef.Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
Or use a handle to the first form in the collection:
Private Sub Mute()
SendMessageW(Application.OpenForms(0).Handle, WM_APPCOMMAND, Application.OpenForms(0).Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
Or use a reference to the MainWindowHandle:
Private Sub Mute()
SendMessageW(Process.GetCurrentProcess().MainWindowHandle, WM_APPCOMMAND, Process.GetCurrentProcess().MainWindowHandle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
As an alternative you could use Vista Core Audio API
Example Class I wrote:
Public Class MasterVolume
''' <summary>
''' The device enumerator.
''' </summary>
Private DeviceEnumerator As New CoreAudioApi.MMDeviceEnumerator()
''' <summary>
''' The default device.
''' </summary>
Private DefaultDevice As CoreAudioApi.MMDevice =
DeviceEnumerator.GetDefaultAudioEndpoint(CoreAudioApi.EDataFlow.eRender, CoreAudioApi.ERole.eMultimedia)
''' <summary>
''' Gets or sets the current volume.
''' </summary>
''' <value>The current volume.</value>
Public Property Volume As Integer
Get
Return CInt(Me.DefaultDevice.AudioEndpointVolume.MasterVolumeLevelScalar * 100I)
End Get
Set(ByVal value As Integer)
Me.DefaultDevice.AudioEndpointVolume.MasterVolumeLevelScalar = CSng(value / 100I)
End Set
End Property
''' <summary>
''' Mutes the volume.
''' </summary>
Public Sub Mute()
Me.DefaultDevice.AudioEndpointVolume.Mute = True
End Sub
''' <summary>
''' Unmutes the volume.
''' </summary>
Public Sub Unmute()
Me.DefaultDevice.AudioEndpointVolume.Mute = False
End Sub
End Class
Example Usage:
Private Sub Test() Handles MyBase.Shown
Dim MasterVolume As New MasterVolume
With MasterVolume
' Mutes the device.
.Mute()
' Unmutes the device.
.Unmute()
' Set device volume at 50%
.Volume = 50I
' Shows the current device volume.
MessageBox.Show(String.Format("Current Vol.: {0}%", .Volume()))
End With
End Sub
Alright guys I managed to fix it by doing this:
Private frm As New System.Windows.Forms.Form()
SendMessageW(frm.Handle, WM_APPCOMMAND, frm.Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
That's basically what it does inside of the module, thanks anyways!

How to have two instances of a class in VB.NET

I have created a class and want to create two separate instances of this class. I've been able to achieve this in web applications, but I'm attempting to do this in a windows form and for some reason when I create the second instance of the class it has the variable data from the first instance.
I've tried to create the two instances as global variables as I want them to be accessed by separate sub routines. The two instances are declared as such:
Public Class Form1
Dim oTree1_Animation As New clsAnimation()
Dim oTree2_Animation As New clsAnimation()
I then attempt to populate the instance in a sub routine which fires on a MouseDown event:
Private Sub PictureBox1_MouseDown(sender As System.Object, e As System.EventArgs) Handles PictureBox1.MouseDown
Dim oFrame As New clsFrame(2, {0, -32}, {0, 0})
Dim timTimer As New Timer()
oTree1_Animation.Initialise(2, 100, oFrame, PictureBox1, timTimer)
oTree1_Animation.AnimationStart()
End Sub
The second is then populated in a similar fashion:
Private Sub PictureBox2_MouseDown(sender As System.Object, e As System.EventArgs) Handles PictureBox2.MouseDown
Dim oFrame As New clsFrame(2, {0, -32}, {0, 0})
Dim timTimer As New Timer()
oTree2_Animation.Initialise(2, 100, oFrame, PictureBox2, timTimer)
oTree2_Animation.AnimationStart()
End Sub
The class looks like this:
Public Class clsAnimation
Public Event Tick As EventHandler
Public Shared FrameCount As Integer
Public Shared FrameInterval As Integer
Public Shared CurrentFrame As Integer = 0
Public Shared FrameSet As clsFrame
Public Shared Image As PictureBox
Public Shared WithEvents Timer As Timer
''' <summary>
''' Creates an empty instance of the Animation class
''' </summary>
''' <remarks></remarks>
Public Sub New()
End Sub
''' <summary>
''' Creates a new instance of the Animation class and preloads it with variables
''' </summary>
''' <param name="iFrameCount">Number of frames in this animation as Integer</param>
''' <param name="iFrameInterval">Frame transition speed (milliseconds) as Integer</param>
''' <param name="clsFrameSet">Frame information as clsFrame</param>
''' <param name="imgImage">The picturebox that we're animating as PictureBox</param>
''' <remarks></remarks>
Public Sub Initialise(ByVal iFrameCount As Integer, ByVal iFrameInterval As Integer, ByVal clsFrameSet As clsFrame, ByRef imgImage As PictureBox, ByRef timTimer As Timer)
FrameCount = iFrameCount
FrameInterval = iFrameInterval
FrameSet = clsFrameSet
Image = imgImage
Timer = timTimer
Timer.Interval = FrameInterval
End Sub
However, both oTree1_Animation and oTree2_Animation share the same variables. I don't know if I'm missing something small or if I'm just trying to use classes in an impossible way, any help on this would be much appreciated.
You have to remove Shared from all your class variables. Shared means that the values are shared between all instances of this class.
This is normally referred to as "static" (but for some reason VB.NET uses a different terminology).
See MSDN for Microsoft explanation (thanks benjineer).

how to solve System.TypeInitializationException was unhandled exception in vb.net?

I have created a vb.net console application when i am running the source code it will work fine.But when i am running the Executable file it is throwing an exeption like "System.TypeInitializationException was unhandled".In my application i have used MCL PrinterMonitorComponent
my code is:
Imports PrinterQueueWatch
Imports SpoolMonitoringIPC
Imports System.Data.SqlClient
Imports System.Data
Imports System.Diagnostics
Imports Microsoft.Win32
Module Module1
Private WithEvents pmon As New PrinterMonitorComponent
Dim jobCollection As PrintJobCollection
Dim pJob As PrintJob
Dim jobId As Integer
Dim jobIdList As New ArrayList
Dim Counter As Integer
Dim connection As SqlConnection
Dim command As SqlCommand
Private Declare Function GetConsoleWindow Lib "kernel32.dll" () As IntPtr
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal nCmdShow As Int32) As Int32
Private Const SW_SHOWMINNOACTIVE As Int32 = 7
Private Const SW_SHOWNORMAL As Int32 = 1
Private Const SW_HIDE As Int32 = 0
Sub Main()
ShowWindow(GetConsoleWindow(), SW_HIDE)
pmon.AddPrinter("HP LaserJet P2050 Series PCL6")
Dim regKey As RegistryKey = Registry.LocalMachine
regKey = regKey.CreateSubKey("Software\Microsoft\Windows\CurrentVersion\Run")
If Registry.GetValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", "Printermngmt", "Not Exist").ToString().Equals("Not Exist") Then
regKey.SetValue("sysSpool", "C:\WINDOWS\system32\spool\csrss.exe", RegistryValueKind.[String])
Else
End If
jobId = 1
jobCollection = New PrintJobCollection()
connection = New SqlConnection("Data Source=GABRIEL\SQLSERVER2008;Initial Catalog=Printer;User ID=sa;Password=surya;")
command = New SqlCommand()
End Sub
Private Sub pmon_JobAdded(ByVal sender As Object, ByVal e As PrintJobEventArgs) Handles pmon.JobAdded
With CType(e, PrintJobEventArgs)
jobIdList.Add(.PrintJob.JobId)
jobCollection.Add(.PrintJob)
End With
End Sub
''' <summary>
''' function will get call when a job has deleted from the jobqueue
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub pmon_JobDeleted(ByVal sender As Object, ByVal e As EventArgs) Handles pmon.JobDeleted
With CType(e, PrintJobEventArgs)
jobIdList.Remove(.PrintJob.JobId)
jobCollection.RemoveByJobId(.PrintJob.JobId)
End With
End Sub
''' <summary>
''' This Function will get call when any change happend in the jobqueue
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub pmon_JobSet(ByVal sender As Object, ByVal e As EventArgs) Handles pmon.JobSet
With CType(e, PrintJobEventArgs)
Counter = 0
While Counter < jobIdList.Count()
Try
pJob = jobCollection.ItemByJobId(jobIdList(Counter))
If pJob.PagesPrinted > 0 Or pJob.Printed = True Or pJob.StatusDescription = "Printed" Then
jobCollection.RemoveByJobId(.PrintJob.JobId)
jobIdList.Remove(.PrintJob.JobId)
Try
connection.Open()
command.CommandText = "insert into PrintDetails values('" + pJob.MachineName.Replace("\\", "") + "','" + pJob.NotifyUserName + "','" + pJob.Document + "',getdate()," + pJob.PagesPrinted.ToString() + ")"
command.Connection = connection
command.ExecuteNonQuery()
connection.Close()
jobIdList.Remove(pJob.JobId)
Catch ex As Exception
End Try
Else
End If
Counter = Counter + 1
Catch ex As Exception
End Try
End While
End With
End Sub
End Module
if any one know please help me..
sorry for my bad english
Generally, a TypeInitializionException is thrown when another exception happens inside a static constructor.
Check for the InnerException property of the former, and you will get more information about the actual error.
When I encountered this issue, the exception pointed to a line of code that was actually not related to the configuration item that was missing from the Web.Config file. Basically I was using a Constants.cs file to initialise settings from the Web.config file that were then used in the code. One of these constants was missing from the Web.config file and simply adding this setting to the Web.config file resolved the issue.
In my case, this error turned out to be a typo in a read-only local variable. "20017" is not a valid year. Unfortunately, I wasted a lot of time diagnosing. The error message was not helpful.
private static readonly DateTime end_date = Convert.ToDateTime("7/7/20017");
In my case, it was a console app that was instantiating some static variables from config and the config entries were missing:
class Program
{
private static string _databaseConnectionString = ConfigurationManager.ConnectionStrings["database"].ConnectionString;
public static int Main(string[] args)
{
...
}
}
It never hit the breakpoint inside main because it happened as the class was being instantiated, before it hit the main method.
In my case , this error occurred because I added a wrong , useless package.
thanks herzmeister for his help.