Option Strict On
Option Explicit On
Imports System.Runtime.InteropServices
Module SendKeys
#Region "Window"
Const ASFW_ANY As Int32 = -1
Const GW_HWNDNEXT As Int32 = 2
Const GA_ROOT As Int32 = 2
Const KEYEVENTF_KEYUP As Int32 = 2
Const LSFW_LOCK As Int32 = 1
Const LSFW_UNLOCK As Int32 = 2
Const NEGATIVE As Int32 = -1
Const NULL As Int32 = 0
Const QS_ALLQUEUE As Int32 = 511
Const SW_HIDE As Int32 = 0
Const SW_SHOWNORMAL As Int32 = 1
Const SW_SHOWMINIMIZED As Int32 = 2
Const VK_MENU As Int32 = 18
Private Structure GUITHREADINFO
Public cbSize, flags, hWndActive, hWndFocus, hWndCapture, hWndMenuOwner, hWndMoveSize, hWndCaret As Int32, rcCaret As RECT
End Structure
Private Structure POINTAPI
Public X, Y As Int32
End Structure
Private Structure RECT
Public rLeft, rTop, rRight, rBottom As Int32
End Structure
Private Structure WINNAME
Public lpText, lpClass, lpProcessName As String
End Structure
Private Structure WINSTATE
Public IsIconic, IsHidden, IsDisabled, IsChildHidden, IsChildDisabled As Boolean
End Structure
Private Declare Function apiAllowSetForegroundWindow Lib "user32" Alias "AllowSetForegroundWindow" (ByVal dwProcessId As Int32) As Boolean
Private Declare Function apiChildWindowFromPointEx Lib "user32" Alias "ChildWindowFromPointEx" (ByVal hWndParent As Int32, ByVal ptx As Int32, ByVal pty As Int32, ByVal uFlags As Int32) As Int32
Private Declare Function apiEnableWindow Lib "user32" Alias "EnableWindow" (ByVal hWnd As Int32, ByVal fEnable As Boolean) As Boolean
Private Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Int32
Private Declare Function apiFindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32
Private Declare Function apiGetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Int32
Private Declare Function apiGetAncestor Lib "user32" Alias "GetAncestor" (ByVal hWnd As Int32, ByVal gaFlags As Int32) As Int32
Private Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Int32, ByVal lpClassName As String, ByVal nMaxCount As Int32) As Int32
Private Declare Function apiGetCursorPos Lib "user32" Alias "GetCursorPos" (ByRef lpPoint As POINTAPI) As Boolean
Private Declare Function apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Int32
Private Declare Function apiGetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As Int32
Private Declare Function apiGetGUIThreadInfo Lib "user32" Alias "GetGUIThreadInfo" (ByVal dwThreadId As Int32, ByRef lpGUIThreadInfo As GUITHREADINFO) As Int32
Private Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As Int32) As Int32
Private Declare Function apiGetQueueStatus Lib "user32" Alias "GetQueueStatus" (ByVal fuFlags As Int32) As Int32
Private Declare Function apiGetTopWindow Lib "user32" Alias "GetTopWindow" (ByVal hWnd As Int32) As Int32
Private Declare Function apiGetWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Int32, ByVal wCmd As Int32) As Int32
Private Declare Function apiGetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Int32, ByVal lpString As String, ByVal cch As Int32) As Int32
Private Declare Function apiGetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Int32) As Int32
Private Declare Function apiGetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hWnd As Int32, ByRef lpdwProcessId As Int32) As Int32
Private Declare Function apiIsIconic Lib "user32" Alias "IsIconic" (ByVal hWnd As Int32) As Boolean
Private Declare Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Int32) As Boolean
Private Declare Function apiIsWindowEnabled Lib "user32" Alias "IsWindowEnabled" (ByVal hWnd As Int32) As Boolean
Private Declare Function apiIsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal hWnd As Int32) As Boolean
Private Declare Function apikeybd_event Lib "user32" Alias "keybd_event" (ByVal vKey As Int32, ByVal bScan As Int32, ByVal dwFlags As Int32, ByVal dwExtraInfo As Int32) As Boolean
Private Declare Function apiLockSetForegroundWindow Lib "user32" Alias "LockSetForegroundWindow" (ByVal uLockCode As Int32) As Boolean
Private Declare Function apiPostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As String) As Int32
Private Declare Function apiSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As String) As Int32
Private Declare Function apiSetFocus Lib "user32" Alias "SetFocus" (ByVal hWnd As Int32) As Int32
Private Declare Function apiSetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hWnd As Int32) As Int32
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Int32, ByVal nCmdShow As Int32) As Boolean
Private Declare Function apiSwitchToThread Lib "kernel32" Alias "SwitchToThread" () As Int32
Private Declare Function apiWaitForInputIdle Lib "user32" Alias "WaitForInputIdle" (ByVal hProcess As Int32, ByVal dwMilliseconds As Int32) As Int32
Private Declare Function apiWindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Int32, ByVal yPoint As Int32) As Int32
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' A group of integer values containing the handle of the main window, and the handle of the focus window.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Use in the second parameter of the following functions: Send, Text, Message and Click.
'''
'''
Public Structure WINFOCUS
Public Foreground, Focus As Int32
End Structure
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Processes any keyboard or mouse messages currently in the queue.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Returns true is there are no messages in the queue to be processed.
'''
'''
Public Function Flush() As Boolean
If apiGetQueueStatus(QS_ALLQUEUE) <> 0 Then System.Windows.Forms.SendKeys.Flush() 'Process any messages in the queue
Flush = Not CBool(apiGetQueueStatus(QS_ALLQUEUE)) 'Set return value to current state
End Function
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Gets the available key commands, or window commands.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Use to get parameters for the Send, or GetWinHandles function.
''' This sub has no return value, it displays the contents in a notepad.
'''
'''
Public Sub GetCommands()
Dim o As New System.Windows.Forms.Keys
FileOpen(1, System.Environment.CurrentDirectory & "\Commands.txt", OpenMode.Output, OpenAccess.Write) 'Open file for writing
PrintLine(1, "Applies to the first and second parameter(wName1 and wIndex1) of the GetWinHandles method.") 'Print info
PrintLine(1, "{Command} Description") 'Show key legend
PrintLine(1, "") '''''''''''''''''''''''''''''Print blank line
PrintLine(1, "{Active}" & " Gets the active window") 'Print some lines
PrintLine(1, "{Desktop}" & " Gets the desktop window")
PrintLine(1, "{Focus}" & " Gets the window with focus")
PrintLine(1, "{Foreground}" & " Gets the foreground window")
PrintLine(1, "{Frompoint}" & " Gets the window under the cursor")
PrintLine(1, "{Ancestor}" & " Gets the ancestor window. Use with wIndex parameter.")
PrintLine(1, "{Childfrompoint}" & " Gets the child window under the cursor. Use with wIndex parameter.")
PrintLine(1, "{Parent}" & " Gets the parent window. Use with wIndex parameter.")
PrintLine(1, "{Top}" & " Gets the top window. Use with wIndex parameter.")
PrintLine(1, "") '''''''''''''''''''''''''''''Print a blank line
PrintLine(1, "") '''''''''''''''''''''''''''''Print a blank line
PrintLine(1, "Applies to the first parameter(cText) of the Send method.")
PrintLine(1, "KeyCode" & " " & "{Command}") 'Show key legend of what's below
PrintLine(1, "") '''''''''''''''''''''''''''''Print a blank line
For n As Int32 = 0 To 255 ''''''''''''''''''''Loop through all possible keys
o = CType(n, System.Windows.Forms.Keys) ''Set the nth key
PrintLine(1, System.String.Concat(n.ToString, " ", "{" & o.ToString & "}")) 'Print the nth key with it's numerical key code
Next '''''''''''''''''''''''''''''''''''''''''Next key
FileClose(1) '''''''''''''''''''''''''''''''''Close file
If System.IO.File.Exists(System.Environment.CurrentDirectory & "\Commands.txt") = True Then 'If file now exists
System.Diagnostics.Process.Start(System.Environment.CurrentDirectory & "\Commands.txt") 'Then start it
Else '''''''''''''''''''''''''''''''''''''''''If no file found
MessageBox.Show("Could not print the file", "File error", MessageBoxButtons.OK, MessageBoxIcon.Error) 'Signal error
End If
End Sub
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Gets the handle of the current foreground window and the handle of the child window with keyboard focus.
''' If keyFocus is False then the handles retrieved are the windows under the cursor with mouse focus.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Returns the WINFOCUS structure containing the current focus handles. Depends on the keyFocus parameter.
'''
'''
(Optional) Shows the title and class name of the windows,
''' to be used with the GetWinHandles function.
'''
(Optional) Returns the handle of the main window, and child window with keyboard focus.
''' If false then the function returns the handles of the windows currently under the cursor.
'''
'''
Public Function GetWinFocus(Optional ByVal showNames As Boolean = False, Optional ByVal keyFocus As Boolean = True) As WINFOCUS
If keyFocus = True Then ''''''''''''''''''''''Keyboard focus
Dim g As New GUITHREADINFO '''''''''''''''Dimension a thread input structure
g.cbSize = System.Runtime.InteropServices.Marshal.SizeOf(g) 'Initialize structure
apiGetGUIThreadInfo(apiGetWindowThreadProcessId(NULL, 0), g) 'Retrieve information about the active window
GetWinFocus.Foreground = g.hWndActive ''''Set handle of active foreground
GetWinFocus.Focus = g.hWndFocus ''''''''''Set handle of focus window
Else '''''''''''''''''''''''''''''''''''''''''Mouse focus instead
Dim p As New POINTAPI ''''''''''''''''''''Dimension a point for the mouse position
apiGetCursorPos(p) '''''''''''''''''''''''Get current cursor position
GetWinFocus.Focus = apiWindowFromPoint(p.X, p.Y) 'Get handle of window under cursor
GetWinFocus.Foreground = apiGetAncestor(GetWinFocus.Focus, GA_ROOT) 'Try to get it's ancestor
If GetWinFocus.Foreground = 0 Then GetWinFocus.Foreground = GetWinFocus.Focus 'If no ancestor then set main focus to child focus
End If
If showNames = True Then GetWinAncestory(GetWinFocus.Focus, True) 'Set ancestory using focus window
End Function
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Gets the handle of the main window and the handle of the child window that is to recieve
''' keyboard or mouse focus, by using the specified title, class name, or index.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Returns the WINFOCUS structure containing the specified focus handles.
'''
'''
The main window title or class name.
'''
(Optional) The main window index.
'''
(Optional) The first child window.
'''
(Optional) The first child index.
'''
(Optional) The second child window.
'''
(Optional) The second child index.
'''
(Optional) The third child window.
'''
(Optional) The third child index.
'''
(Optional) The fourth child window.
'''
(Optional) The fourth child index.
'''
(Optional) The fifth child window.
'''
(Optional) The fifth child index.
'''
(Optional) The sixth child window.
'''
(Optional) The sixth child index.
'''
(Optional) The seventh child window.
'''
(Optional) The seventh child index.
'''
(Optional) The eighth child window.
'''
(Optional) The eighth child index.
'''
(Optional) The ninth child window.
'''
(Optional) The ninth child index.
'''
'''
Public Function GetWinHandles(ByVal wName1 As String, Optional ByVal wIndex1 As Int32 = 1, Optional ByVal wName2 As String = " ", Optional ByVal wIndex2 As Int32 = 1, Optional ByVal wName3 As String = " ", Optional ByVal wIndex3 As Int32 = 1, Optional ByVal wName4 As String = " ", Optional ByVal wIndex4 As Int32 = 1, Optional ByVal wName5 As String = " ", Optional ByVal wIndex5 As Int32 = 1, Optional ByVal wName6 As String = " ", Optional ByVal wIndex6 As Int32 = 1, Optional ByVal wName7 As String = " ", Optional ByVal wIndex7 As Int32 = 1, Optional ByVal wName8 As String = " ", Optional ByVal wIndex8 As Int32 = 1, Optional ByVal wName9 As String = " ", Optional ByVal wIndex9 As Int32 = 1, Optional ByVal wName10 As String = " ", Optional ByVal wIndex10 As Int32 = 1) As WINFOCUS
Dim hwnd, cwnd, i As Int32, wn As String, wNames(1) As String, wF As New WINFOCUS
If wName1 <> " " Then i = 1 : ReDim wNames(1) 'Set i to index of parameters
If wName2 <> " " Then i = 3 : ReDim wNames(3)
If wName3 <> " " Then i = 5 : ReDim wNames(5)
If wName4 <> " " Then i = 7 : ReDim wNames(7)
If wName5 <> " " Then i = 9 : ReDim wNames(9)
If wName6 <> " " Then i = 11 : ReDim wNames(11)
If wName7 <> " " Then i = 13 : ReDim wNames(13)
If wName8 <> " " Then i = 15 : ReDim wNames(15)
If wName9 <> " " Then i = 17 : ReDim wNames(17)
If wName10 <> " " Then i = 19 : ReDim wNames(19)
If wName1 <> " " Then wNames(0) = wName1 : wNames(1) = wIndex1.ToString 'Set array elements
If wName2 <> " " Then wNames(2) = wName2 : wNames(3) = wIndex2.ToString
If wName3 <> " " Then wNames(4) = wName3 : wNames(5) = wIndex3.ToString
If wName4 <> " " Then wNames(6) = wName4 : wNames(7) = wIndex4.ToString
If wName5 <> " " Then wNames(8) = wName5 : wNames(9) = wIndex5.ToString
If wName6 <> " " Then wNames(10) = wName6 : wNames(11) = wIndex6.ToString
If wName7 <> " " Then wNames(12) = wName7 : wNames(13) = wIndex7.ToString
If wName8 <> " " Then wNames(14) = wName8 : wNames(15) = wIndex8.ToString
If wName9 <> " " Then wNames(16) = wName9 : wNames(17) = wIndex9.ToString
If wName10 <> " " Then wNames(18) = wName10 : wNames(19) = wIndex10.ToString
hwnd = apiFindWindow(Nothing, wName1) ''''''''Look for handle from title
If hwnd = 0 Then hwnd = apiFindWindow(wName1, Nothing) 'If not found by title, then look for handle from class name
If hwnd <> 0 AndAlso CInt(wNames(1)) > 1 Then 'If searching for window by index, ie more than 1
Dim nxtwnd As Int32 = hwnd '''''''''''''''Initialize handle containing the next window in the top level z-order
Dim Index As Int32 = 1 '''''''''''''''''''Initialize index to 1, since handle was found.
Dim n As New WINNAME '''''''''''''''''''''Create structure for window names
Do '''''''''''''''''''''''''''''''''''''''Do loop to look for handles matching paramaters
nxtwnd = apiGetWindow(hwnd, GW_HWNDNEXT) 'Set next window
If nxtwnd = 0 Then Exit Do '''''''''''Eject if there are no more top level windows
If wNames(0) <> "" Then ''''''''''''''If title or class name was given
n = GetWinName(nxtwnd, True, True) 'Get title and classname of the window
If n.lpText = wNames(0) OrElse n.lpClass = wNames(0) Then 'If title or class name matches first wNames parameter
Index += 1 '''''''''''''''''''Increment Index for the matching window
hwnd = nxtwnd ''''''''''''''''Set handle to the handle of the matching window
If Index >= CInt(wNames(1)) Then Exit Do 'If the specified index has been reached then exit with last matching handle
End If
Else '''''''''''''''''''''''''''''''''Then "" indicates the search is by index only
Index += 1 '''''''''''''''''''''''Increment Index for the matching window
hwnd = nxtwnd ''''''''''''''''''''Set handle to the handle of the matching window
If Index >= CInt(wNames(1)) Then Exit Do 'If index specified has been reached then exit with last matching handle
End If
Loop
End If
If hwnd = 0 Then '''''''''''''''''''''''''''''If not found by title or class name, then look for special commands
wn = wName1.ToLower ''''''''''''''''''''''Does not need to be case sensitive
If wn = "{focus}" Then '''''''''''''''''''If focus window is specified
hwnd = GetWinFocus.Focus '''''''''''''Get the handle of the focus window
ElseIf wn = "{foreground}" Then ''''''''''If foreground window is specified
hwnd = apiGetForegroundWindow ''''''''Get the handle of the foreground window
ElseIf wn = "{active}" Then ''''''''''''''If active window is specified
hwnd = apiGetActiveWindow ''''''''''''Get the handle of the active window
ElseIf wn = "{desktop}" Then '''''''''''''If desktop window is specified
hwnd = apiGetDesktopWindow() '''''''''Get the handle of the desktop window
ElseIf wn = "{top}" Then '''''''''''''''''If top window is specified
hwnd = apiGetTopWindow(hwnd) '''''''''Get the handle of the top window
ElseIf wn = "{ancestor}" Then ''''''''''''If ancestor window is specified
hwnd = apiGetAncestor(wIndex1, GA_ROOT) 'Get the handle of the ancestor window
ElseIf wn = "{parent}" Then ''''''''''''''If parent window is specified
hwnd = apiGetParent(wIndex1) '''''''''Get the handle of the parent window
ElseIf wn = "{ancestor}" Then ''''''''''''If ancestor window is specified
hwnd = apiGetAncestor(wIndex1, GA_ROOT) 'Get the handle of the ancestor window
ElseIf wn = "{frompoint}" Then '''''''''''If window under the cursor is specified
Dim p As New POINTAPI ''''''''''''''''Dimension a point structure
If wIndex1 <> 1 AndAlso wIndex2 <> 1 Then 'If point specified
p.X = wIndex1 ''''''''''''''''''''If x specified
p.Y = wIndex2 ''''''''''''''''''''If y specified
Else
apiGetCursorPos(p) '''''''''''''''Get cursor position as POINTAPI
End If
hwnd = apiWindowFromPoint(p.X, p.Y) ''Get the handle of the window under the cursor
ElseIf wn = "{childfrompoint}" Then ''''''If child window under the cursor is specified
Dim p As New POINTAPI ''''''''''''''''Dimension a point structure
If wIndex2 <> 1 AndAlso wIndex3 <> 1 Then 'If point specified
p.X = wIndex2 ''''''''''''''''''''If x specified
p.Y = wIndex3 ''''''''''''''''''''If y specified
Else
apiGetCursorPos(p) '''''''''''''''Get cursor position as POINTAPI
End If
hwnd = apiChildWindowFromPointEx(wIndex1, p.X, p.Y, wIndex2) 'Get the handle of the child window under the cursor
ElseIf wName1.IndexOf(".exe") <> NEGATIVE Then 'If process name specified
Dim pIndex As Int32 = 0 ''''''''''''''Initialize process index in case there are more than one matching that name
For Each p As System.Diagnostics.Process In System.Diagnostics.Process.GetProcessesByName(wName1.Substring(0, wName1.Length - 4)) 'Loop through processes matching that name
pIndex += 1 ''''''''''''''''''''''Increment index by one each time found
If pIndex = wIndex1 Then hwnd = p.MainWindowHandle.ToInt32 : Exit For 'If index matches index specified then set handle and exit loop now
Next '''''''''''''''''''''''''''''''''Next process
End If
End If
If hwnd = 0 Then '''''''''''''''''''''''''''''If handle still not found
If System.IO.File.Exists(wName1) = True Then 'If window is a valid file path
Dim p As New System.Diagnostics.Process 'Dimension a process
p.StartInfo.FileName = wName1.Substring(wName1.LastIndexOf("\") + 1) 'Set file name
p.StartInfo.WorkingDirectory = wName1.Substring(0, wName1.LastIndexOf("\")) 'Set working directory
p.Start() ''''''''''''''''''''''''''''Start process
If p.Handle.ToInt32 <> 0 Then ''''''''If there is a native process handle
p.WaitForInputIdle(2500) '''''''''Wait for it to be ready for input
apiWaitForInputIdle(p.Handle.ToInt32, 2500) 'Wait API style
hwnd = p.MainWindowHandle.ToInt32 'Set handle to new process
End If
End If
End If
If hwnd = 0 Then hwnd = -1 '''''''''''''''''''If main window not found, then set failure return
wF.Foreground = hwnd '''''''''''''''''''''''''Set structure return
wF.Focus = hwnd ''''''''''''''''''''''''''''''Set focus to main handle for now
If hwnd = -1 Then Return wF ''''''''''''''''''If no handle found then return now
If i = 1 Then ''''''''''''''''''''''''''''''''If only the main window was specified
Dim prvswnd As Int32 = apiGetForegroundWindow 'Remember the current foreground window
ForceForeground(hwnd) ''''''''''''''''''''Force foreground onto specified main window
Sleep() ''''''''''''''''''''''''''''''''''Sleep a moment
wF = GetWinFocus() '''''''''''''''''''''''Set structure
ForceForeground(prvswnd) '''''''''''''''''Force foreground back to where it was
ElseIf i > 1 Then ''''''''''''''''''''''''''''If there are child windows specified
cwnd = GetChildWindow(hwnd, wNames(2), CInt(wNames(3))) 'Set first child handle
wF.Focus = cwnd ''''''''''''''''''''''''''Set focus handle to first child
If (i - 1) > 1 Then ''''''''''''''''''''''If more than one child specified
For q As Int32 = 4 To wNames.Length - 1 Step 2 'Step through array looking for grandchildren.
cwnd = GetChildWindow(cwnd, wNames(q), CInt(wNames(q + 1))) 'Set new child window
wF.Focus = cwnd ''''''''''''''''''Set focus handle to youngest grandchild so far
Next '''''''''''''''''''''''''''''''''Next in array
End If
End If
Return wF ''''''''''''''''''''''''''''''''''''Return WINFOCUS structure
End Function
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Sleeps for the specified time, while flushing keyboard messages at the specified interval.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Returns true if there are no more messages in the queue.
'''
'''
(Optional) The number of milliseconds to sleep in milliseconds, - 5000 = 5 seconds.
''' If 0 is specified then the function sleeps until there are no more input messages in the queue to process or 5 seconds elapses.
''' Specify an integer.
'''
(Optional) The number of milliseconds between flushes.
''' Flushing helps process window messages that are still in the queue. Specify an integer from 0-4999.
'''
'''
Public Function Sleep(Optional ByVal dwMilliseconds As Int32 = 0, Optional ByVal fInterval As Int32 = 1) As Boolean
Dim tick As Int32 = System.Environment.TickCount 'Get the number of millisecons since last log on
If fInterval > 4999 Then fInterval = 4999 ''''Make sure interval is not longer than 5 seconds to avoid hanging the main app window
Do '''''''''''''''''''''''''''''''''''''''''''Loop until the specified timeout
System.Threading.Thread.Sleep(fInterval) 'Sleep for one interval at a time
apiSwitchToThread() : Flush() ''''''''''''Yield to other waiting threads of the OS's choice. Process any messages in the queue
If dwMilliseconds = 0 Then '''''''''''''''If short rest specified
If apiGetQueueStatus(QS_ALLQUEUE) = 0 OrElse System.Environment.TickCount >= (tick + 5000) Then Return True 'If there are no key/mouse messages in the queue or 5 seconds has elapsed then return
Else '''''''''''''''''''''''''''''''''''''If a timeout is specified
If System.Environment.TickCount >= (tick + dwMilliseconds) Then Return Not CBool(apiGetQueueStatus(QS_ALLQUEUE)) 'If time is up then exit with return of state
End If
Loop
End Function
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Waits for a window to exist, and waits for it to be ready for keyboard and mouse input.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Returns true if a window exists. Returns false if it does not, or the specified time ends.
'''
'''
The title or class name of the window. Specify an application title or class name.
'''
(Optional) The number of milliseconds to wait. Specify an integer.
'''
'''
Public Function WaitForWindow(ByVal wTitle As String, Optional ByVal dwMilliseconds As Int32 = 5000) As Boolean
Dim tick As Int32 = System.Environment.TickCount 'Get the number of millisecons since last log on
Dim hwnd As Int32 = 0 ''''''''''''''''''''''''Initialize handle
Do '''''''''''''''''''''''''''''''''''''''''''Loop this thread until it's time
hwnd = apiFindWindow(Nothing, wTitle) ''''Find window by title
If hwnd = 0 Then hwnd = apiFindWindow(wTitle, Nothing) 'If not found by title then find by class name
If hwnd <> 0 Then Return WaitForWindowIdle(hwnd) 'If found then wait for input idle and return
If System.Environment.TickCount >= (tick + dwMilliseconds) Then Return False 'If time is up then return
System.Threading.Thread.Sleep(1) : Flush() 'Sleep thread for one millisecond and process any messages in the queue
Loop
End Function
Private Function ForceForeground(ByVal hWnd As Int32) As Boolean
apiLockSetForegroundWindow(LSFW_UNLOCK) ''''''Unlock setforegroundwindow calls
apiAllowSetForegroundWindow(ASFW_ANY) ''''''''Allow setforeground window calls
KeyEvent(VK_MENU, False, True) '''''''''''''''Lift menu key if pressed, and it also allows the foreground window to be set
ForceForeground = CBool(apiSetForegroundWindow(hWnd)) 'Set foreground window
apiLockSetForegroundWindow(LSFW_LOCK) ''''''''Lock other apps from using setforegroundwindow
End Function
Private Function GetChildWindow(ByVal hWnd As Int32, Optional ByVal wName As String = "", Optional ByVal wIndex As Int32 = 1) As Int32
Dim cwnd, TextCount, ClassCount, NullCount As Int32, w As New WINNAME
Do '''''''''''''''''''''''''''''''''''''''''''Loop through sibling windows
cwnd = apiFindWindowEx(hWnd, cwnd, Nothing, Nothing) 'Set child handle
If cwnd = 0 Then Return cwnd '''''''''''''If no more sibling children then return
w = GetWinName(cwnd, True, True, False) ''Get the text, and class from that window
If w.lpText.IndexOf("&") <> NEGATIVE Then w.lpText = w.lpText.Remove(w.lpText.IndexOf("&"), 1) 'Remove shortcut symbols for easier evaluation
If w.lpText = wName Then TextCount += 1 ''If text matches the specified wName then increment the text count
If TextCount = wIndex Then Return cwnd ''If text count is equal to the specified wIndex then return
If w.lpClass = wName Then ClassCount += 1 'If class name matches the specified wName then increment the class count
If ClassCount = wIndex Then Return cwnd ''If class count is equal to the specified wIndex then return
If w.lpText = "" AndAlso w.lpClass = "" AndAlso wName = "" Then NullCount += 1 'If text and class name not specified, then increment by index only
If NullCount = wIndex Then Return cwnd ''If null count is equal to wIndex then return
Loop
End Function
Private Function GetWinAncestory(ByVal cWnd As Int32, ByVal gName As Boolean) As Int32()
Dim i, z, cwnd2 As Int32, hwnds() As Int32, w As New WINNAME 'Dimension some variables
cwnd2 = cWnd '''''''''''''''''''''''''''''''''Remember handle for seconds loop
w = GetWinName(cWnd, True, True, False) ''''''Get text and class name of the window
If gName = True Then MessageBox.Show(z.ToString & ": " & w.lpText & " | " & w.lpClass, "Focus window: Title | Class name", MessageBoxButtons.OK, MessageBoxIcon.Information) 'Display to developer if specified
Do '''''''''''''''''''''''''''''''''''''''''''Loop while counting ancestors
cWnd = apiGetParent(cWnd) ''''''''''''''''Get new parent handle if any found
If cWnd = 0 Then Exit Do '''''''''''''''''If there are no more parents then abort without setting anymore to the array
i += 1 '''''''''''''''''''''''''''''''''''Increment the index by 1
Loop
ReDim hwnds(i) '''''''''''''''''''''''''''''''Re-Dimension array to number of ancestors including the handle specified
Do '''''''''''''''''''''''''''''''''''''''''''Do look for parents of the window specified.
hwnds(z) = cwnd2 '''''''''''''''''''''''''Set the indexed array element to the specified handle or it's ancestors
cwnd2 = apiGetParent(cwnd2) ''''''''''''''Get new parent handle if any found
If cwnd2 = 0 Then Exit Do ''''''''''''''''If there are no more parents then abort
z += 1 '''''''''''''''''''''''''''''''''''Increment the index by 1
w = GetWinName(cwnd2, True, True, False) 'Get text and class name of the window
If gName = True Then MessageBox.Show(z.ToString & ": " & w.lpText & " | " & w.lpClass, "Parent window: Title | Class name", MessageBoxButtons.OK, MessageBoxIcon.Information) 'Display to developer if specified
Loop
System.Array.Reverse(CType(hwnds, System.Int32())) 'Reverse the order of the values so that the main handle is first, and the focus window is last.
Return hwnds '''''''''''''''''''''''''''''''''Return array of integer handles, or handle.
End Function
Private Function GetWinName(ByVal hWnd As Int32, Optional ByVal gText As Boolean = True, Optional ByVal gClass As Boolean = True, Optional ByVal gProcess As Boolean = True) As WINNAME
Dim tLength, rValue As Int32, n As New WINNAME
n.lpText = "" ''''''''''''''''''''''''''''''''Initialize string for text name
n.lpClass = "" '''''''''''''''''''''''''''''''Initialize string for class name
n.lpProcessName = "" '''''''''''''''''''''''''Initialize string for process name
If gText = True Then '''''''''''''''''''''''''If text is to be retrieved
tLength = apiGetWindowTextLength(hWnd) + 4 'Get length
n.lpText = n.lpText.PadLeft(tLength) '''''Pad with buffer
rValue = apiGetWindowText(hWnd, n.lpText, tLength) 'Get text
n.lpText = n.lpText.Substring(0, rValue) 'Strip buffer
End If
If gClass = True Then ''''''''''''''''''''''''If class name is to be retrieved
n.lpClass = n.lpClass.PadLeft(260) '''''''Pad with buffer
rValue = apiGetClassName(hWnd, n.lpClass, 260) 'Get classname
n.lpClass = n.lpClass.Substring(0, rValue) 'Strip buffer
End If
If gProcess = True Then ''''''''''''''''''''''If process name is to be retrieved
Dim phwnd As Int32 = 0 '''''''''''''''''''Initialize handle
For Each p As System.Diagnostics.Process In System.Diagnostics.Process.GetProcesses() 'Loop through all processes
phwnd = p.MainWindowHandle.ToInt32 ''Set handle of that process
If phwnd = hWnd OrElse phwnd = apiGetAncestor(hWnd, GA_ROOT) Then 'If handle matches the specified handle, or the ancestor of it
n.lpProcessName = p.ProcessName ''Get process name
Exit For '''''''''''''''''''''''''Exit loop
End If
Next '''''''''''''''''''''''''''''''''''''Next process
End If
Return n '''''''''''''''''''''''''''''''''''''Return WINNAME structure
End Function
Private Function KeyEvent(Optional ByVal vKey As Int32 = 0, Optional ByVal kDown As Boolean = True, Optional ByVal kUp As Boolean = True) As Boolean
If vKey < 0 OrElse vKey > 255 Then Return False 'If vKey is not valid between 0-255
KeyEvent = True ''''''''''''''''''''''''''''''Value for return results
If kDown = True Then '''''''''''''''''''''''''If key is to be depressed
If apikeybd_event(vKey, 0, 0, -11) = False Then KeyEvent = False 'Press key down set return of any failure
End If
If kUp = True Then '''''''''''''''''''''''''''If key is to be released
If apikeybd_event(vKey, 0, KEYEVENTF_KEYUP, -11) = False Then KeyEvent = False 'Lift key up set return of any failure
End If
End Function
Private Function WaitForWindowIdle(ByVal hWnd As Int32) As Boolean
For Each p As Process In Process.GetProcesses() 'Iterate through all processes
If p.MainWindowHandle.ToInt32 = hWnd Then 'If handle matches the specified handle
Try
p.WaitForInputIdle(2500) '''''''''Wait for process to be ready for input messages
WaitForWindowIdle = CBool(apiWaitForInputIdle(p.Handle.ToInt32, 2500)) 'Get results with API
Catch ex As Exception ''''''''''''''''If no graphical interface or other error
apiSwitchToThread() : Flush() ''''Yield to waiting threads. Process messages in the queue
End Try
Return Not WaitForWindowIdle '''''''''Return result as inverse of API
End If
Next '''''''''''''''''''''''''''''''''''''''''Next process
End Function
#End Region
#Region "KeyboardInput"
Const HC_GETNEXT As Int32 = 1
Const VK_SHIFT As Int32 = 16
Const VK_CONTROL As Int32 = 17
Const VK_CAPITAL As Int32 = 20
Const VK_ESCAPE As Int32 = 27
Const VK_LSHIFT As Int32 = 160
Const VK_RSHIFT As Int32 = 161
Const VK_LCONTROL As Int32 = 162
Const VK_RCONTROL As Int32 = 163
Const VK_LMENU As Int32 = 164
Const VK_RMENU As Int32 = 165
Const VK_LWIN As Int32 = 91
Const VK_RWIN As Int32 = 92
Const WM_SETTEXT As Int32 = 12
Const WM_KEYDOWN As Int32 = 256
Const WM_KEYUP As Int32 = 257
Const WH_KEYBOARD_LL As Int32 = 13
Private Structure KBDLLHOOKSTRUCT
Public vkCode, scanCode, flags, time, dwExtraInfo As Int32
End Structure
Private Declare Function apiAttachThreadInput Lib "user32" Alias "AttachThreadInput" (ByVal idAttach As Int32, ByVal idAttachTo As Int32, ByVal fAttach As Int32) As Int32
Private Declare Function apiCallNextKeyHookEx Lib "user32" Alias "CallNextHookEx" (ByVal hHook As Int32, ByVal nCode As Int32, ByVal wParam As Int32, ByVal lParam As KBDLLHOOKSTRUCT) As Int32
Private Declare Function apiGetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Int32
Private Declare Function apiGetKeyState Lib "user32" Alias "GetKeyState" (ByVal vKey As Int32) As Int32
Private Declare Function apiSetWindowsKeyHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Int32, ByVal lpfn As KeyboardHookDelegate, ByVal hmod As Int32, ByVal dwThreadId As Int32) As Int32
Private Declare Function apiUnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHook As Int32) As Int32
Private Declare Function apiVkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal cChar2 As Int32) As Int32
Private Delegate Function KeyboardHookDelegate(ByVal Code As Int32, ByVal wParam As Int32, ByRef lParam As KBDLLHOOKSTRUCT) As Int32
Private kcallback As KeyboardHookDelegate
Private hKey, fWnd, kSent As Int32 'Handle for the keyboard, and the main window with directive focus, and the count of the keys sent
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Sends a windows message to the specified window.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Use GetWinHandles or GetWinFocus to get a structure.
''' Returns true if the message was sent to press an individual key.
'''
'''
Virtual key code number 0-255.
'''
The structure of the window to focus on.
''' Use GetWinHandles or GetWinFocus to get a structure.
'''
(Optional) Specifies that key is to be pressed down.
'''
(Optional) Specifies that key is to be lifted up.
'''
(Optional) Posts the message into the queue,
''' instead of sending it and waiting for a return
'''
'''
Public Function Message(ByVal vKey As Int32, ByVal wFocus As WINFOCUS, Optional ByVal kDown As Boolean = True, Optional ByVal kUp As Boolean = True, Optional ByVal bPost As Boolean = False) As Boolean
Message = True '''''''''''''''''''''''''''''''Set default return value
If bPost = True Then '''''''''''''''''''''''''If post specified
If kDown = True AndAlso apiPostMessage(wFocus.Focus, WM_KEYDOWN, vKey, Nothing) = 0 Then Message = False 'Press down set return of any failure
If kUp = True AndAlso apiPostMessage(wFocus.Focus, WM_KEYUP, vKey, Nothing) = 0 Then Message = False 'Lift up set return of any failure
Else '''''''''''''''''''''''''''''''''''''''''If Sending message
If kDown = True AndAlso apiSendMessage(wFocus.Focus, WM_KEYDOWN, vKey, Nothing) = 0 Then Message = False 'Press down set return of any failure
If kUp = True AndAlso apiSendMessage(wFocus.Focus, WM_KEYUP, vKey, Nothing) = 0 Then Message = False 'Lift up set return of any failure
End If
End Function
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Sends keyboard messages or events to the specified window.
''' If asMessage is false, then this function simulates keyboard events,
''' and directs keyboard focus onto the specified window structure.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Use GetWinHandles or GetWinFocus to get a structure.
''' Returns the number of keys sent. Returns 0 only if the keyboard could not be hooked,
''' or a valid window handle cannot be found, or the foregroundwindow cannot be forced,
''' or focus could not be set, or the keys cannot be simulated.
'''
'''
The text or key commands to send. See the GetCommands sub,
''' for more details about commands.
'''
The structure of the window to focus on.
''' Use GetWinHandles or GetWinFocus to get a structure.
'''
(Optional) Send as window message, or as a keyboard event.
''' It's recommended that you use True in this parameter for writing text. If false then rForeground applies.
'''
(Optional) Returns the foreground window to it's previous focus
''' before the keys were sent. Applies only if asMessage is false.
'''
'''
Public Function Send(ByVal cText As String, ByVal wFocus As WINFOCUS, Optional ByVal asMessage As Boolean = True, Optional ByVal rForeground As Boolean = False) As Int32
Dim ws As New WINSTATE
Dim UserCapsLock, sThread, IsLetter As Boolean 'Declare some switches
Dim hwnd, cwnd, prvWnd, txtLength, VK, repeat As Int32 ''Dimension some integers
Dim txtRemain, Letter, PrevLetter As String ''Dimension some strings
txtRemain = cText ''''''''''''''''''''''''''''Initialize remaining text
txtLength = cText.Length '''''''''''''''''''''Initialize Text
If wFocus.Foreground = -1 Then Return 0 ''''''Exit failure if GetWinHandles returned -1
If wFocus.Foreground = 0 Then wFocus = GetWinFocus()
hwnd = wFocus.Foreground '''''''''''''''''''''Read structure handles, and make easier to use
cwnd = wFocus.Focus ''''''''''''''''''''''''''Set child handle
repeat = 1 '''''''''''''''''''''''''''''''''''Initialize repeat to one, for commands
Letter = "" ''''''''''''''''''''''''''''''''''Initialize the first letter to nothing
If cwnd = 0 Then cwnd = hwnd '''''''''''''''''If no child specified, then set it to main window
If apiIsWindow(hwnd) = False Then Return 0 ''Make sure it's a valid window, if not abort
If apiIsIconic(hwnd) = True Then ws.IsIconic = apiShowWindow(hwnd, SW_SHOWNORMAL) 'If window is minimized then show it, and remember
If apiIsWindowEnabled(hwnd) = False Then ws.IsDisabled = apiEnableWindow(hwnd, True) 'If window is disabled then enable it and remember
If apiIsWindowEnabled(cwnd) = False Then ws.IsChildDisabled = apiEnableWindow(cwnd, True) 'If child window is disabled then enable it and remember
If apiIsWindowVisible(hwnd) = False Then ws.IsHidden = Not apiShowWindow(hwnd, SW_SHOWNORMAL) 'If window is hidden then show it, and remember
If apiIsWindowVisible(cwnd) = False Then ws.IsChildHidden = Not apiShowWindow(cwnd, SW_SHOWNORMAL) 'If child window is hidden then show it, and remember
WaitForWindowIdle(hwnd) ''''''''''''''''''''''Wait for input idle
If apiGetKeyState(VK_CAPITAL) = 1 Then '''''''Get state of the caps lock key.
UserCapsLock = KeyEvent(VK_CAPITAL) ''''''Remember state if toggled, by return of keyevent
System.Threading.Thread.Sleep(0) '''''''''Wait for other threads
End If
Lift() '''''''''''''''''''''''''''''''''''''''Lift shift, control and menu keys
If asMessage = False Then ''''''''''''''''''''Send as chain of events
kcallback = New KeyboardHookDelegate(AddressOf Callback) 'Set new hook delegate
Dim hx As Integer
hx = System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32
'hx = Marshal.GetHINSTANCE([Assembly].GetExecutingAssembly.GetModules()(0)).ToInt32
hKey = apiSetWindowsKeyHookEx(WH_KEYBOARD_LL, kcallback, hx, 0) 'Set keyboard hook for verifying the time that a virtual key was pressed
'hKey = apiSetWindowsKeyHookEx(WH_KEYBOARD_LL, AddressOf Callback, hx, 0) 'Set keyboard hook for verifying the time that a virtual key was pressed
If hKey = 0 Then Return KeyAbort(wFocus, ws, UserCapsLock, sThread, False, prvWnd)
If apiGetWindowThreadProcessId(hwnd, 0) = apiGetCurrentThreadId Then sThread = True
If sThread = False Then ''''''''''''''''''If handle is a different thread than this one
sThread = Not AttachInput(hwnd, True) 'Attach thread input to this thread
Else '''''''''''''''''''''''''''''''''''''If the same thread
rForeground = False ''''''''''''''''''No reason to reset foreground window, because focus never leaves to begin with
End If
prvWnd = apiGetForegroundWindow ''''''''''Remember current foreground window
If ForceForeground(hwnd) = False Then Return KeyAbort(wFocus, ws, UserCapsLock, sThread, False, prvWnd) 'If the foreground cannot be set within 5 seconds then abort
If cwnd <> hwnd Then '''''''''''''''''''''If child window is different than main window
If apiSetFocus(cwnd) = 0 Then Return KeyAbort(wFocus, ws, UserCapsLock, sThread, rForeground, prvWnd) 'If focus window cannot be set then abort
End If
fWnd = hwnd ''''''''''''''''''''''''''''''Set form class variable for the foregroundwindow handle
Else '''''''''''''''''''''''''''''''''''''''''If message
sThread = True '''''''''''''''''''''''''''Set same thread to true, so it doesn't detach for no reason, since it was never set
rForeground = False ''''''''''''''''''''''Foreground is not set, so no need to return it
If hwnd = cwnd Then ''''''''''''''''''''''If the main window is the same as child
If ForceForeground(hwnd) = False Then 'If Force foreground window fails
Return KeyAbort(wFocus, ws, UserCapsLock, sThread, False, prvWnd) 'return abort's return
End If
Sleep() ''''''''''''''''''''''''''''''Sleep a moment and flush any messages so that the child window if any, gets focus.
wFocus = GetWinFocus() '''''''''''''''Set by getting the WINFOCUS structure
rForeground = True '''''''''''''''''''Should return it
End If
End If
Lift() '''''''''''''''''''''''''''''''''''''''Lift shift, control and menu keys
For i As Int32 = 1 To txtLength ''''''''''''''Loop through each character of the text specified
Dim cmdKey As String = "" ''''''''''''''''Initialize a string for special command keys
PrevLetter = Letter ''''''''''''''''''''''Set previous letter to the current before setting the current
Letter = txtRemain.Substring(0, 1) '''''''Set current letter to the left most
txtRemain = txtRemain.Substring(txtRemain.Length - (cText.Length - i)) 'Cut string to get remaining text
VK = apiVkKeyScan(Asc(Letter)) And 255 ''Set keyscan of that letter
If Letter <> Letter.ToLower OrElse Letter = "!" OrElse Letter = "@" OrElse Letter = "$" OrElse Letter = "&" OrElse Letter = "*" OrElse Letter = "_" OrElse Letter = "|" OrElse Letter = ":" OrElse Letter = " KeyEvent(VK_SHIFT, True, False) '''''Press shift if necessary
End If
If Letter = "{" Then '''''''''''''''''''''If letter is a command bracket
VK = 0 '''''''''''''''''''''''''''''''Set virtual key to zero(none)
cmdKey = txtRemain.Substring(0, txtRemain.IndexOf("}")) 'Get text within command brackets
If txtRemain.Length - (cmdKey.Length + 1) > 0 Then txtRemain = txtRemain.Substring(cmdKey.Length + 1) 'Set remaining text, as the text to the right of the command bracket
i += cmdKey.Length + 1 '''''''''''''''Increment i the number of characters within command brackets since they are not going to be processed individually
If cmdKey.IndexOf(" ") <> NEGATIVE AndAlso cmdKey.IndexOf(", ") = NEGATIVE Then 'If there is a space and no comma preceeding it then the command is to be repeated
If IsNumeric(cmdKey.Substring(cmdKey.IndexOf(" ") + 1)) Then repeat = CInt(cmdKey.Substring(cmdKey.IndexOf(" ") + 1)) 'If a number can be identified, then set it otherwise it stays 1._+{}|:"<>?
cmdKey = cmdKey.Substring(0, cmdKey.IndexOf(" ")) 'Strip off left side, which is the actual command
End If
If cmdKey.Length = 1 Then ''''''''''''If command is a single character
If cmdKey = "#" OrElse cmdKey = "+" OrElse cmdKey = "^" OrElse cmdKey = "%" OrElse cmdKey = "~" OrElse cmdKey = "(" OrElse cmdKey = ")" OrElse cmdKey = "[' OrElse cmdKey = ']" Then
KeyEvent(VK_SHIFT, True, False) 'Press shift for single character commands
End If
VK = apiVkKeyScan(Asc(cmdKey)) And 255 'Set keyscan for that letter
Else '''''''''''''''''''''''''''''''''If command is a key name
VK = NEGATIVE ''''''''''''''''''''Set to negative in case this is not a valid key command, then it's a simple string
Dim kEnum As System.Windows.Forms.Keys 'Dimension key enumeration
For n As Int32 = 0 To 255 ''''''''Loop through all possible keys
kEnum = CType(n, System.Windows.Forms.Keys) 'Set key enum to index n
If kEnum.ToString.ToLower = cmdKey.ToLower Then VK = n 'If key name is equal to the special key(non-case sensitive), then set key
Next n '''''''''''''''''''''''''''Next key
End If
ElseIf Letter = "~" Then '''''''''''''''''If letter is tilde
VK = 13 ''''''''''''''''''''''''''''''Set to return(enter) key
ElseIf Letter = "+" Then '''''''''''''''''If letter is plus
VK = 0 '''''''''''''''''''''''''''''''Do not send a regular key
KeyEvent(VK_SHIFT, True, False) ''''''Press shift instead
ElseIf Letter = "^" Then '''''''''''''''''If letter is caret
VK = 0 '''''''''''''''''''''''''''''''Do not send a regular key
KeyEvent(VK_CONTROL, True, False) ''''Press control instead
ElseIf Letter = "#" Then '''''''''''''''''If letter is number signifier
VK = 0 '''''''''''''''''''''''''''''''Do not send a regular key
KeyEvent(VK_LWIN, True, False) '''''''Press left window key instead
ElseIf Letter = "%" Then '''''''''''''''''If letter is percent
VK = 0 '''''''''''''''''''''''''''''''Do not send a regular key
KeyEvent(VK_MENU, True, False) '''''''Press menu key instead
ElseIf Letter = "(" Then '''''''''''''''''If letter is left parenthesis
VK = 0 '''''''''''''''''''''''''''''''Do not send a regular key
ElseIf Letter = ")" Then '''''''''''''''''If letter is right parenthesis
VK = 0 '''''''''''''''''''''''''''''''Do not send a regular key
Lift() '''''''''''''''''''''''''''''''Lift extented keys
End If
If VK > NEGATIVE Then ''''''''''''''''''''If valid key code
If asMessage = True Then '''''''''''''If sending a message
If VK > 64 AndAlso VK < 91 OrElse VK > 47 AndAlso VK < 58 OrElse VK > 105 AndAlso VK < 112 OrElse VK > 185 AndAlso VK < 193 OrElse VK > 218 AndAlso VK < 224 Then IsLetter = True
Message(VK, wFocus, Not IsLetter, True, True) 'Send message down and up
Else '''''''''''''''''''''''''''''''''If sending an event
If KeyEvent(VK) = False Then Return KeyAbort(wFocus, ws, UserCapsLock, sThread, rForeground, prvWnd) 'If key event fails return abort
End If
kSent += 1 '''''''''''''''''''''''''''Count the sent keys
Else '''''''''''''''''''''''''''''''''''''It's a string to be repeated
For n As Int32 = 1 To repeat '''''''''Repeat key press
Dim r As String = cmdKey '''''''''Initialize remaining text
Dim a As String = "" '''''''''''''Initialize current letter
For w As Int32 = 1 To cmdKey.Length 'Iterate the length of the string
a = r.Substring(0, 1) ''''''''Strip off left most character
r = r.Substring(1) '''''''''''Set remaining to right most characters
VK = apiVkKeyScan(Asc(a)) And 255 'Get scan code for this key
If asMessage = True Then '''''If sending a message
If VK > 64 AndAlso VK < 91 OrElse VK > 47 AndAlso VK < 58 OrElse VK > 105 AndAlso VK < 112 OrElse VK > 185 AndAlso VK < 193 OrElse VK > 218 AndAlso VK < 224 Then IsLetter = True
Message(VK, wFocus, Not IsLetter, True, True) 'Send message down and up
Else '''''''''''''''''''''''''If sending an event
If KeyEvent(VK) = False Then Return KeyAbort(wFocus, ws, UserCapsLock, sThread, rForeground, prvWnd) 'If key event fails return abort
End If
kSent += 1 '''''''''''''''''''Count the sent keys
Next w '''''''''''''''''''''''''''Next character in string
VK = NEGATIVE ''''''''''''''''''''Reset to non valid command for next loop
Next n '''''''''''''''''''''''''''''''Next repeated
repeat = 1 '''''''''''''''''''''''''''Reset repeat to one for next loop
End If
If Letter <> "(" Then ''''''''''''''''''''If character is not parenthesis
If PrevLetter = "#" Then '''''''''''''If previous letter was numeric signifier
KeyEvent(VK_LWIN, False, True) ''Lift win key
ElseIf PrevLetter = "+" Then '''''''''If previous letter was shift
KeyEvent(VK_SHIFT, False, True) ''Lift shift key
ElseIf PrevLetter = "%" Then '''''''''If previous letter was percent
KeyEvent(VK_MENU, False, True) ''Lift menu key
ElseIf PrevLetter = "^" Then '''''''''If previous letter was caret
KeyEvent(VK_CONTROL, False, True) 'Lift control key
End If
End If
If cmdKey.Length = 1 AndAlso cmdKey = "#" OrElse cmdKey = "+" OrElse cmdKey = "^" OrElse cmdKey = "%" OrElse cmdKey = "~" OrElse cmdKey = "(" OrElse cmdKey = ")" OrElse cmdKey = "[' OrElse cmdKey = ']" Then
KeyEvent(VK_SHIFT, False, True) ''''''Lift shift for command keys
End If
If Letter <> Letter.ToLower OrElse Letter = "!" OrElse Letter = "@" OrElse Letter = "$" OrElse Letter = "&" OrElse Letter = "*" OrElse Letter = "_" OrElse Letter = "|" OrElse Letter = ":" OrElse Letter = " KeyEvent(VK_SHIFT, False, True) ''''''Lift shift if necessary
End If
If asMessage = True Then System.Threading.Thread.Sleep(0) 'Wait for other threads
Next i '''''''''''''''''''''''''''''''''''''''Next character
Return KeyAbort(wFocus, ws, UserCapsLock, sThread, rForeground, prvWnd) 'Final abort upon completion
End Function
'''
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Sets the text of the specified window.
''' _____________________________________________________________________________________________________________________________________________________________________________
''' Use GetWinHandles or GetWinFocus to get a structure.
''' Returns true if the message was sent to set the text.
'''
'''
The text to send.
'''
The WINFOCUS structure.
'''
'''
Public Function Text(ByVal sText As String, ByVal wFocus As WINFOCUS) As Boolean
Return CBool(apiSendMessage(wFocus.Focus, WM_SETTEXT, 0, sText)) 'Return the full result of SendMessage
End Function
Private Function AttachInput(ByVal hWnd As Int32, Optional ByVal bAttach As Boolean = True) As Boolean
Return CBool(apiAttachThreadInput(apiGetWindowThreadProcessId(hWnd, 0), apiGetCurrentThreadId, CInt(bAttach)))
End Function
Private Function Callback(ByVal Code As Int32, ByVal wParam As Int32, ByRef lParam As KBDLLHOOKSTRUCT) As Int32
If fWnd <> 0 AndAlso apiGetForegroundWindow <> fWnd Then 'If foreground window is not where it's supposed to be
If ForceForeground(fWnd) = False Then ''''If foreground window cannot be set
If lParam.dwExtraInfo = -11 Then kSent -= 1 'Uncount this key, since it's blocked, and has been sent from the Send function
Return HC_GETNEXT ''''''''''''''''''''If foreground cannot be set then block key no matter if it's a user or internally sent from here
End If
End If
If lParam.dwExtraInfo <> -11 Then Return HC_GETNEXT 'If key action and stroke blocked then get next key in the hook chain
Return apiCallNextKeyHookEx(hKey, Code, wParam, lParam) 'Call next key hook if no action
End Function
Private Function KeyAbort(ByVal WFOCUS As WINFOCUS, ByVal WSTATE As WINSTATE, ByVal uCapsLock As Boolean, ByVal sThread As Boolean, ByVal rForeground As Boolean, ByVal prvWnd As Int32) As Int32
Lift() '''''''''''''''''''''''''''''''''''''''Lift any extended keys just in case
If sThread = False Then AttachInput(WFOCUS.Foreground, False) 'If thread was attached then detatch it
If WSTATE.IsIconic = True Then apiShowWindow(WFOCUS.Foreground, SW_SHOWMINIMIZED) 'If window was minimized, then re-minimize it
If WSTATE.IsDisabled = True Then apiEnableWindow(WFOCUS.Foreground, False) 'If window was disabled then re-disable it
If WSTATE.IsChildDisabled = True Then apiEnableWindow(WFOCUS.Focus, False) 'If child window was disabled then re-disable it
If WSTATE.IsHidden = True Then apiShowWindow(WFOCUS.Foreground, SW_HIDE) 'If window was hidden, then re-hide it
If WSTATE.IsChildHidden = True Then apiShowWindow(WFOCUS.Focus, SW_HIDE) 'If child window was hidden, then re-hide it
Sleep() ''''''''''''''''''''''''''''''''''''''Sleep for a moment and flush keys if needed
If uCapsLock = True Then KeyEvent(VK_CAPITAL) 'If caps lock was on toggle capslock
If rForeground = True Then ForceForeground(prvWnd)
If hKey <> 0 AndAlso apiUnhookWindowsHookEx(hKey) = 1 Then hKey = 0 'Unhook keyboard and free keyboard handle if unhooked 'If return foreground was specified then return it
KeyAbort = kSent '''''''''''''''''''''''''''''Set return value
fWnd = 0 '''''''''''''''''''''''''''''''''''''Free foregroundwindow handle
kSent = 0 ''''''''''''''''''''''''''''''''''''Free number of keys sent
End Function
Private Function Lift() As Boolean
KeyEvent(VK_CONTROL, False, True) ''''''''''''Lift control
KeyEvent(VK_RCONTROL, False, True) '''''''''''Lift right control
KeyEvent(VK_LCONTROL, False, True) '''''''''''Lift left control
KeyEvent(VK_SHIFT, False, True) ''''''''''''''Lift shift
KeyEvent(VK_RSHIFT, False, True) '''''''''''''Lift right shift
KeyEvent(VK_LSHIFT, False, True) '''''''''''''Lift left shift
KeyEvent(VK_MENU, False, True) '''''''''''''''Lift menu
KeyEvent(VK_RMENU, False, True) ''''''''''''''Lift right menu
KeyEvent(VK_LMENU, False, True) ''''''''''''''Lift left menu
Return True
End Function
#End Region
End Module
