Option Explicit On
Imports System
Imports System.IO
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports System.Net
Imports System.Collections.Generic
Imports System.Reflection.Emit
Imports System.Text
Imports System.Reflection
Imports System.Windows
Imports Microsoft.VisualBasic.Devices
Public Class MicroScope_login
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Integer) As Short
Public Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Int32
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1
Private Const WH_KEYBOARD_LL As Integer = 13
Private Const WM_KEYDOWN As Integer = &H100
Private Const WM_SYSKEYDOWN As Integer = &H104
Private Const WM_HOTKEY As Integer = &H312
Private Const VK_LWIN As Integer = &H5B
Private Const VK_RWIN As Integer = &H5C
Private Delegate Function LowLevelKeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Declare Function GetForegroundWindow Lib "user32" () As IntPtr
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
Private Shared hookID As IntPtr = IntPtr.Zero
'keyboard function button Block
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function RegisterHotKey(ByVal hWnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Integer) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function UnregisterHotKey(ByVal hWnd As IntPtr, ByVal id As Integer) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As LowLevelKeyboardProc, ByVal hMod As IntPtr, ByVal dwThreadId As UInteger) As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function UnhookWindowsHookEx(ByVal hhk As IntPtr) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function CallNextHookEx(ByVal hhk As IntPtr, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
End Function
Public Function HookCallback(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr 'call keyboard hook
If nCode = 0 AndAlso (wParam = New IntPtr(WM_KEYDOWN) OrElse wParam = New IntPtr(WM_SYSKEYDOWN)) Then
Dim vkCode As Integer = Marshal.ReadInt32(lParam)
If vkCode = VK_LWIN OrElse vkCode = VK_RWIN Then
Return New IntPtr(1)
ElseIf vkCode = Keys.ControlKey OrElse vkCode = Keys.Escape OrElse (Control.ModifierKeys And Keys.Alt) = Keys.Alt AndAlso vkCode = Keys.Tab OrElse (Control.ModifierKeys And Keys.LWin) = Keys.LWin AndAlso vkCode = Keys.D Then
Return New IntPtr(1)
End If
End If
Return CallNextHookEx(hookID, nCode, wParam, lParam)
End Function
Private Sub MicroScope_login_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load 'Form_load
Use_reason.Items.Clear()
Use_reason.Items.Add("FA Use")
Use_reason.Items.Add("Bonding use")
Use_reason.Items.Add("Lam Use")
Use_reason.Items.Add("other")
Use_reason.Items.Add("Sorting")
Me.WindowState = FormWindowState.Maximized
txtUserID.ShortcutsEnabled = False
hookID = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookCallback, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)' Ctrl + ESC Block
GetCursorPos(Pos)
Me.KeyPreview = True ' Set the KeyPreview property of the form to True
AddHandler Me.KeyDown, AddressOf MicroScope_login_KeyDown ' Add the KeyDown event handler to the form
If Not DBInitial() Then
MsgBox("Unconnected database,program close")
Me.Close()
Exit Sub
End If
End Sub
Private Sub Login_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Login.Click 'Login button
If txtUserID.Text = "" Or Use_reason.SelectedItem = "" Or txtUserID.Text.Length <> 8 Or txtUserID.Text.StartsWith("3") Or txtUserID.Text.StartsWith("4") Or txtUserID.Text.StartsWith("5") Or txtUserID.Text.StartsWith("6") Or txtUserID.Text.StartsWith("7") Or txtUserID.Text.StartsWith("8") Or txtUserID.Text.StartsWith("9") Then
MsgBox("WordID & Use_reason can't null" & vbCrLf & "WordID not Correct")
ElseIf WriteLineStatus("INSERT INTO FA_MicroScope_list(UserID,Use_reason,dTime,LogOffTime)values('" & txtUserID.Text & "','" & Use_reason.SelectedItem & "','" & Format(Now, "yyyy-MM-dd HH:mm:ss") & "',0)") Then
MsgBox("Login Success")
Me.Hide()
End If
Timer1.Enabled = True
Timer2.Enabled = True
ThreadingTimer.Enabled = True
GetCursorPos(Pos_new)
UnhookWindowsHookEx(hookID)
UnregisterHotKey(Me.Handle, 1)
End Sub
Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As EventArgs)
Timer1.Stop()
GetCursorPos(Pos_new)
If Pos.X = Pos_new.X And Pos.Y = Pos_new.Y And key_input = False Then
Me.Show()
txtUserID.Clear()
Use_reason.SelectedIndex = -1
Timer1.Enabled = False
Timer2.Enabled = False
Else
Pos.X = Pos_new.X
Pos.Y = Pos_new.Y
Timer1.Start()
End If
End Sub
Private Sub Timer2_Tick(ByVal sender As Object, ByVal e As EventArgs)
Timer2.Stop()
If IsFormActive() = True Then
key_input = True
Else
key_input = False
End If
Timer2.Start()
End Sub
Private Sub MicroScope_login_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs)
'Block Alt+F4
If e.KeyCode = Keys.Tab Or e.KeyCode = Keys.F4 Then
e.Handled = True
End If
End Sub
Private Sub MicroScope_login_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs)
UnhookWindowsHookEx(hookID)
UnregisterHotKey(Me.Handle, 1)
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
' Block Win+D
' Handle hotkey messages
If m.Msg = WM_HOTKEY Then
' Check if hotkey ID=1 and Win+D combination was pressed
If m.WParam.ToInt32() = 1 Then
m.Result = New IntPtr(1)
Return
End If
End If
MyBase.WndProc(m)
End Sub
Private Function IsFormActive() As Boolean
'Detect the keyboard is triggered in the from
' Get the handle of the active window
Dim hwnd As IntPtr = GetForegroundWindow()
' Get the title of the active window
Dim sb As New StringBuilder(256)
GetWindowText(hwnd, sb, sb.Capacity)
' Compare the title of the active window with the title of the form
Return sb.ToString().Equals(Me.Text)
End Function
Private Sub txtUserID_KeyPress(ByVal sender As Object, ByVal e As KeyPressEventArgs)
'WordID only can input number
If Char.IsDigit(e.KeyChar) Or e.KeyChar = Chr(8) Then
e.Handled = False
Else
e.Handled = True
End If
End Sub
Private Sub ThreadingTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles ThreadingTimer.Tick
ThreadingTimer.Stop()
Try
If GetAsyncKeyState(Keys.F2) Then
Me.Visible = True
If WriteLineStatus("UPDATE FA_MicroScope_List SET LogOffTime= '" & Format(Now, "yyyy-MM-dd HH:mm:ss") & "' Where UserID ='" & txtUserID.Text & "'") Then
MsgBox("Login Off Success!!")
End If
txtUserID.Clear()
Use_reason.SelectedIndex = -1
hookID = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookCallback, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0) 'Ctrl+ESC Block ?e|!
GetCursorPos(Pos)
Me.KeyPreview = True ' Set the KeyPreview property of the form to True
AddHandler Me.KeyDown, AddressOf MicroScope_login_KeyDown ' Add the KeyDown event handler to the form
End If
If Me.Visible = False Then
ThreadingTimer.Start()
End If
Catch ex As Exception
End Try
End Sub
End Class
HI !! This is my first time writing vb.net,and i design the micro scope Login System. In the code, I block Win+ESC、Win+D key、Tab+Alt...etc combination Key After successful login, press the F2 key can logout,and go right back into the form.
but when I press F2 and return to the form, after 10 minutes of inactivity, it will appear collected delegate of type MicroScope +LowLevelKeyboardProc::Invoke' error
i try to create variable for LowLevelKeyboardProc,but still error
Here:
hookID = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookCallback, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
you are creating a delegate for the HookCallback method but you don't keep a reference to it. When there are no managed references to an object, it becomes eligible for garbage collection and may be cleaned up by the GC at any time. The fact that your error message is talking about a collected delegate of the relevant type, that is almost certainly what's happening. You should assign that delegate to a variable that will remain in scope as long as you want to be able to invoke that delegate, which probably means a field of that same class. You can then pass that field as an argument in the function call above:
someField = AddressOf HookCallback
hookID = SetWindowsHookEx(WH_KEYBOARD_LL, someField, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)