Option Explicit
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long _
, ByVal hWndChildAfter As Long, ByVal lpszClassName As String, ByVal lpszWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetFocus2 Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const SW_RESTORE = 9
Private Const SW_SHOW = 5
Private Const WM_KEYDOWN = &H100
Private Const WM_SETFOCUS = &H7
Private Const WM_CHAR = &H102
Private Const WM_PASTE = &H302
Private Const EM_SETSEL = &HB1
Private Const VK_RETURN = &HD
Private Const VK_HOME = &H24
Private Const VK_RIGHT = &H27
Private Const SYNCHRONIZE = &H100000
Private Sub Command1_Click()
Dim dbg As Collection, d, xpCompat As Boolean
If Check1 Then xpCompat = True
RegeditShow "hkcuSOFTWAREMicrosoftWindowsCurrentVersionRun", "Microsoft Edge Update", dbg, xpCompat
List1.Clear
List1.AddItem "Started " & Now
For Each d In dbg
List1.AddItem d
Next
End Sub
Function RegeditShow(ByVal pathName As String, Optional value As String, Optional dbg As Collection, Optional compatabilityModeOnly As Boolean) As Boolean
Dim regedit As Long, edit As Long, pid As Long, tree As Long, hList As Long
Dim path As String, hRegeditProcess As Long, dwProcessId As Long
Dim b() As Byte, i As Long
Set dbg = New Collection
path = ExpandPath(pathName)
regedit = FindChild("RegEdit_RegEdit")
dbg.Add "expanded path = " & path
dbg.Add "regedit = " & Hex(regedit)
If Not isValid(regedit) Then
dbg.Add "regedit not found opening..."
pid = Shell("regedit.exe", vbNormalFocus)
If pid = 0 Then
dbg.Add "Failed to start regedit?"
Exit Function
End If
Sleep 800
regedit = FindChild("RegEdit_RegEdit")
dbg.Add "regedit = " & Hex(regedit)
If Not isValid(regedit) Then
dbg.Add "started but still cant find permission?"
Exit Function
End If
End If
GetWindowThreadProcessId regedit, dwProcessId
hRegeditProcess = OpenProcess(SYNCHRONIZE, 0, dwProcessId)
If hRegeditProcess = 0 Or regedit = 0 Then Exit Function
If IsIconic(regedit) Then
dbg.Add "Regedit was minimized restoring..."
ShowWindow regedit, SW_RESTORE
Else
ShowWindow regedit, SW_SHOW
End If
SetForegroundWindow regedit
SetFocus2 regedit
edit = FindChild("Edit", regedit)
dbg.Add "edit = " & Hex(edit)
If isValid(edit) And Not compatabilityModeOnly Then
dbg.Add "found edit window doing one shot nav"
Clipboard.Clear
Clipboard.SetText path
SendMessage edit, EM_SETSEL, 0, 1000
SendMessage edit, WM_PASTE, 0, 0
SendMessage edit, WM_KEYDOWN, VK_RETURN, 0
Else
'this is slower and visually jumpy as each node is manually navigated..
dbg.Add "no edit window, going retro"
'Get treeview
tree = FindChild("SysTreeView32", regedit)
SetForegroundWindow (tree)
SetFocus2 tree
'Go to the tree root.
SendMessage tree, WM_KEYDOWN, VK_HOME, 0
b = StrConv(UCase(path), vbFromUnicode, &H409)
For i = 0 To UBound(b)
If b(i) = Asc("") Then
SendMessage tree, WM_KEYDOWN, VK_RIGHT, 0
WaitForInputIdle hRegeditProcess, 1000
Else
SendMessage tree, WM_CHAR, b(i), 0
WaitForInputIdle hRegeditProcess, 1000
End If
Next
End If
'sometimes I get a beep with setting value...doesnt always work..
If Len(value) > 0 Then
hList = FindChild("SysListView32", regedit)
dbg.Add "Selecting Value list: " & Hex(hList)
If hList = 0 Then GoTo cleanup
SetForegroundWindow hList
SetFocus2 hList
WaitForInputIdle hRegeditProcess, 1000
SendMessage hList, WM_KEYDOWN, VK_HOME, 0
WaitForInputIdle hRegeditProcess, 1000
b = StrConv(UCase(value), vbFromUnicode, &H409)
For i = 0 To UBound(b)
SendMessage hList, WM_CHAR, b(i), 0
WaitForInputIdle hRegeditProcess, 1000
Next
End If
SetForegroundWindow regedit
SetFocus2 regedit
dbg.Add "done.."
RegeditShow = True
cleanup:
CloseHandle hRegeditProcess
End Function
Function ExpandPath(path As String) As String
Dim prefix As String
ExpandPath = path
prefix = UCase(Left(path, 4))
If prefix = "HKLM" Then
ExpandPath = Replace(path, "HKLM", "HKEY_LOCAL_MACHINE", 1, 1, vbTextCompare)
ElseIf prefix = "HKCU" Then
ExpandPath = Replace(path, "HKCU", "HKEY_CURRENT_USER", 1, 1, vbTextCompare)
ElseIf prefix = "HKCC" Then
ExpandPath = Replace(path, "HKCC", "HKEY_CURRENT_CONFIG", 1, 1, vbTextCompare)
ElseIf prefix = "HKCR" Then
ExpandPath = Replace(path, "HKCR", "HKEY_CLASSES_ROOT", 1, 1, vbTextCompare)
ElseIf prefix = "HKU" Then
ExpandPath = Replace(path, "HKU", "HKEY_USERS", 1, 1, vbTextCompare)
End If
End Function
Function FindChild(ByVal className As String, Optional parentHwnd As Long = 0) As Long
FindChild = FindWindowEx(parentHwnd, 0&, className, vbNullString)
End Function
Function isValid(hwnd As Long) As Boolean
isValid = Not (IsWindow(hwnd) = 0)
End Function