I want to change the file association for VBS files so that they are opened with Notepad.exe rather than WScript.exe. A user decided to run one of these files that turned out to be a virus, wiping out his laptop. I know how to do this manually but would like to incorporate a startup procedure to continually reset its association, in case a future program installation decides to correct the key.
Here is what I need to do:
1. If this key exists, I need to read and possibly modify its current value.
2. If it does not exist, I need to create it and set its value.
I used the FAQ from MikeLacey ( faq222-92 ) to get started, but ran into troubles.
I used this code to call the QueryValue function from the FAQ:
I get ERROR_OUTOFMEMORY in the QueryValueEX function, where lrc = 6.
Can anyone help me? I could sure use it, and, of course, would greatly appreciate it.
Here is what I need to do:
1. If this key exists, I need to read and possibly modify its current value.
2. If it does not exist, I need to create it and set its value.
I used the FAQ from MikeLacey ( faq222-92 ) to get started, but ran into troubles.
I used this code to call the QueryValue function from the FAQ:
Code:
Sub Main()
Dim sKey As String
Dim sValue As String
Dim vSetting As Variant
'Call QueryValue function - read current Key value
sKey = "VBSFile\Shell\Open\Command"
sValue = "(Default)"
vSetting = QueryValue(HKEY_CLASSES_ROOT, sKey, sValue)
Debug.Print "Current Setting is " & vSetting
End Sub
'(Functions from FAQ)
Public Function QueryValue(ByVal lpParentKey As Long, sKeyName As String, sValueName As String) As Variant
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
' open the key
lRetVal = RegOpenKeyEx(lpParentKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
' get the value
lRetVal = QueryValueEx(hKey, sValueName, vValue)
' close the key
RegCloseKey (hKey)
QueryValue = vValue
End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
' If lrc <> ERROR_NONE Then Error 5 (error handling procedure in FAQ)
If lrc <> ERROR_NONE Then
Debug.Print "Error No: " & CStr(lrc)
'******* Here is where I get Error lrc = 6 - ERROR_OUTOFMEMORY ******
Error 5
End If
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
If Mid(sValue, cch, 1) = Chr(0) Then
vValue = Left$(sValue, cch - 1) ' get rid of trailing AsciiZ
Else
vValue = Left$(sValue, cch)
End If
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit ' Hmmmm
End FunctionCan anyone help me? I could sure use it, and, of course, would greatly appreciate it.
