Hi,
I am trying to combine the function to search the registry with one I use to detect whether or not an app has crashed. Both the code work individually but if I combine them I receive a "File Not Found"
on this familiar line
Edit:
The code to search the registry is from the Find like RegEdit thread. While the code to detect if a process is responding or not is from the Detect if program is not responding! thread.
Thanks,
Nightwalker
I am trying to combine the function to search the registry with one I use to detect whether or not an app has crashed. Both the code work individually but if I combine them I receive a "File Not Found"
on this familiar line
Code:
Open sRegTmp For Input As #QQCode:
Option Explicit
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const SW_HIDE& = 0
Private Const STARTF_USESHOWWINDOW& = &H1
Private Const INFINITE = -1&
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
'API Constants
Const SMTO_BLOCK = &H1
Const SMTO_ABORTIFHUNG = &H2
Const WM_NULL = &H0
Const WM_CLOSE = &H10
Const PROCESS_ALL_ACCESS = &H1F0FFF
'API functions
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
lpdwProcessId 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 SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As _
Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim start As STARTUPINFO, proc As PROCESS_INFORMATION, ret As Long
Private Function GetShortName(ByVal sLongFileName As String) As String
Dim lRetval As Long, sShortPathName As String, iLen As Integer
'Set up buffer area for API function call return
sShortPathName = Space(255)
iLen = Len(sShortPathName)
'Call the function
lRetval = GetShortPathName(sLongFileName, sShortPathName, iLen)
'Strip away unwanted characters.
GetShortName = Left$(sShortPathName, lRetval)
End Function
Private Sub OpenProcessHide(cmdline$) 'OpenProcessHide ("cmd /c Regedit /S " & MyAppPath & "Tools\Appswitch_Assoc.reg")
Dim lngreturn As Long
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
start.dwFlags = STARTF_USESHOWWINDOW 'forces functn to use wShowWindow param below
start.wShowWindow = SW_HIDE 'shelled process is HIDDEN.'Use SW_SHOW etc to run visible
' Start the shelled application:
lngreturn = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
HIGH_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
lngreturn = WaitForSingleObject(proc.hProcess, INFINITE)
lngreturn = CloseHandle(proc.hProcess)
End Sub
Public Function ExecCmd(cmdline$)
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
Sub Main()
Dim retval As Long
Dim lngResult As Long
Dim lngReturnValue As Long
'Replace the path and app.name.type with that of the application you want to use
retval = ExecCmd("E:\Steam\Steam.exe")
lngReturnValue = SendMessageTimeout(0, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lngResult)
DoEvents
If lngReturnValue Then
MsgBox ("Responding")
Else
'Close the host and the client if the client does not respond
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
End If
'Based on
'RegSearch2013.vbs - Search All the Registry for input string and display results.
'© MaxXPsoft Nov 1 2013 based on Bill James RegSrch.vbs
' Was exporting and searching just 2 keys HKEY_LOCAL_MACHINE + HKEY_USERS. Added all others - MaxXPsoft
'Problems reply here http://www.msfn.org/board/topic/138899-se7en-ua-working-with-win-81/?p=1058726
'Nov 3 2013 Updated file to increment sRegTmp for Error: Permission denied
'Nov 5 2013 Updated variables for overflow
'Nov 5 2013 westconn1 updated for VB6
'Nov 7 2013 updated RegVersion for Windows XP Mode - MaxXPsoft
' Rewrite to create hive name.tmp
'Nov 8 2013 add a sleep function, Use App.Path, get short name on app.path
'Nov 10 2013 Add OpenProcess
Dim RegVersion As String
Dim sSearchFor As String
RegVersion = "REGEDIT4"
Dim System, SystemSet
Set SystemSet = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
For Each System In SystemSet
If System.Version > "6.0.0000" Then RegVersion = "Windows Registry Editor Version 5.00"
Next
sSearchFor = InputBox("This script will search your Registry and find all " & _
"instances of the search string you input." & vbCrLf & vbCrLf & _
"This search could take several minutes, so please be patient." & _
vbCrLf & vbCrLf & "Enter search string (case insensitive) and " & _
"click OK... Or Hit [ ENTER ]", "RegSearch2013 " & Chr(169) & " MaxXPsoft")
If sSearchFor = "" Then Exit Sub
Dim StartTime As Single: StartTime = Timer
Dim sRegTmp As String, sOutTmp As String, eRegLine As Variant, iCnt As Long, sRegKey As String, aRegFileLines() As String
sOutTmp = GetShortName(App.Path) & "\RegSearch2013" & _
Hour(Now) & Minute(Now) & Second(Now) & ".reg "
Dim RegHives(4) As String
RegHives(0) = "HKEY_CLASSES_ROOT"
RegHives(1) = "HKEY_CURRENT_USER"
RegHives(2) = "HKEY_LOCAL_MACHINE"
RegHives(3) = "HKEY_USERS"
RegHives(4) = "HKEY_CURRENT_CONFIG"
Dim Srch As Double
Dim FF
Dim QQ
FF = FreeFile
Open sOutTmp For Output As #FF
Print #FF, (RegVersion & vbCrLf & "; " & "RegSearch2013 " & _
Chr(169) & " MaxXPsoft" & vbCrLf & vbCrLf & "; Registry search " & _
"results for string " & Chr(34) & sSearchFor & Chr(34) & " " & Now & _
vbCrLf & vbCrLf & "; NOTE: This file will be deleted when you close " & _
"NotePad." & vbCrLf & "; You must manually save this file to a new " & _
"location if you want to refer to it again later." & vbCrLf & "; (If " & _
"you save the file with a .reg extension, you can use it to restore " & _
"any Registry changes you make to these values.)" & vbCrLf)
Dim j As Integer
For j = 0 To UBound(RegHives)
sRegTmp = GetShortName(App.Path) & "\"
sRegTmp = sRegTmp & RegHives(j) & ".tmp" 'hive name.tmp
If RegVersion = "REGEDIT4" Then
Srch = Shell("regedit /e /a " & sRegTmp & " " & RegHives(j), vbNormalFocus) '/a enables export as Ansi for WinXP
Else
OpenProcessHide ("cmd /c Regedit /e /a " & sRegTmp & " " & RegHives(j))
End If
'DoEvents
QQ = FreeFile
Open sRegTmp For Input As #QQ
aRegFileLines = Split(Input(LOF(QQ), QQ), vbCrLf)
Close #QQ
Kill (sRegTmp)
Call Sleep(1000)
For Each eRegLine In aRegFileLines
If InStr(1, eRegLine, "[", 1) > 0 Then sRegKey = eRegLine
If InStr(1, eRegLine, sSearchFor, 1) > 0 Then
If sRegKey <> eRegLine Then
Print #FF, (vbCrLf & sRegKey) & vbCrLf & eRegLine
Else
Print #FF, (vbCrLf & sRegKey)
End If
iCnt = iCnt + 1
End If
Next
Erase aRegFileLines
Next
Close FF
If iCnt < 1 Then
MsgBox "Search completed in " & FormatNumber(Timer - StartTime, 0) & " seconds." & _
vbCrLf & vbCrLf & "No instances of " & Chr(34) & sSearchFor & Chr(34) & _
" found."
Kill sOutTmp
End
End If
Select Case MsgBox("Search completed in " & FormatNumber(Timer - StartTime, 0) & " seconds." & _
vbCrLf & vbCrLf & iCnt & " instances of " & Chr(34) & sSearchFor & Chr(34) & _
" found." & vbCrLf & vbCrLf & "Click OK to open Results in Notepad.", vbOKCancel Or vbInformation Or vbDefaultButton1, "RegSearch2013")
Case vbOK
Shell "Notepad " & sOutTmp, vbNormalFocus
Case vbCancel
End Select
DoEvents
Kill sOutTmp
End SubThe code to search the registry is from the Find like RegEdit thread. While the code to detect if a process is responding or not is from the Detect if program is not responding! thread.
Thanks,
Nightwalker