activex can't create object / wshom.ocx
hi gurus!
i'm using a WshShell object to write a registry setting. therefore, i added a reference to wshom.ocx to my project.
Code:
'strAvEnv was defined, etc.
Dim regObj As New WshShell
regObj.RegWrite "HKEY_CURRENT_USER\Software\Marcam\Asset Management Client\database\ENVIRONMENT", strAvEnv
Set regObj = Nothing
i packed all stuff into a setup routine (using the setup tool provided with the VB 6.0 IDE).
if i set up a pc with Windows 2000 and all the latest updates and patches (SP 4), and afterwards install my program using the setup routine, i keep getting the error "activex component can't create object" on the above code. on a plain win2k without updates, everything works fine.
can anyone give me a hint what is the reason for this?
i would also appreciate if anyone knows another way (w/o wshom.ocx) to write this single registry setting from VB.
thanx.
Re: activex can't create object / wshom.ocx
Copy the code below and paste it in a module and add it to your project. This came from allapi.net. It's what I use for all of my registry needs.
Code:
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ = 1 'Unicode null terminated string
Public Const REG_BINARY = 3 'Free form binary
Public Const REG_DWORD = 4 '32-bit number
Public Const ERROR_SUCCESS = 0&
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'The RegOpenKey API function takes a handle to a key, and the path that you want to select, and returns a handle to the new key. As was mentioned earlier, a handle to a key is a reference to a key. You must have a key to start with, so the six constants for the six root keys are fixed, and are provided as constants. The handles to these keys are the same on every Win32 system in every session. The other handles that you receive for the sub-keys will be variable, and will change each time you select the key. However, the handle will remain valid until you use the RegCloseKey function. If you don't close the handle to the key when you are finished with it, it will continue using up resources, so you must remember to close it when you are done.
'Unusually, the Registry API functions will return 0 on success, and another number for failure. There is the constant ERROR_SUCCESS, which is defined to make code more readable when debugging.
'This wrapper function takes a handle to a key, a path to a key, and the name of the value to delete. The handle to the key for most purposes will be one of the constant handles to a root key, and the path will be the path to the key. The path, as with the intrinsic VB functions can include the "" sign to signify sub keys. If you want to delete a value in the root of the key specified pass strPath as vbNullString. If you want to erase the default value, pass strValue as vbNullString.
Public Sub DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegDeleteValue(hCurKey, strValue)
lRegResult = RegCloseKey(hCurKey)
End Sub
'This function, as above, takes a handle to a key and a path to a key. It will find the key specified, and will delete all sub-keys and values, and using the 'drive' model would be equivalent to the 'deltree' DOS command - only without confirmation. Use this carefully, as it can have disastrous effects!
Public Sub DeleteKey(ByVal hKey As Long, ByVal strPath As String)
Dim lRegResult As Long
lRegResult = RegDeleteKey(hKey, strPath)
End Sub
'Now that we are getting going, this does not need too much explaining. Pass a handle to a key and a path, and it will create all necessary keys to create the specified key. If you want to write an error handler into these functions, the function provides a space for checking whether the function has been a success.
Public Sub CreateKey(hKey As Long, strPath As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Sub
'These Registry functions for strings are quite complicated because of the need to initialise buffers. The function to retrieve strings first sets up the default value. This will be used if the specified key is not valid. The first call to RegQueryValueEx determines the data type in the key and the length if it is a string. The second call retrieves the string. Then the string is processed, removing any trailing nulls.
Public Function GetSettingstring(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
Dim hCurKey As Long
Dim lResult As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long
'Set up default value
If Not IsEmpty(Default) Then
GetSettingstring = Default
Else
GetSettingstring = ""
End If
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_SZ Then
strBuffer = String$(lDataBufferSize, " ")
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
GetSettingstring = Left$(strBuffer, intZeroPos - 1)
Else
GetSettingstring = strBuffer
End If
End If
Else
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function
Public Sub SaveSettingstring(hKey As Long, strPath As String, strValue As String, strData As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Sub
'These two functions are probably the simplest of the three data types. We know the length of data that we want to retrieve so we don't need any extra calls.
Public Function GetSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long
Dim lRegResult As Long
Dim lValueType As Long
Dim lBuffer As Long
Dim lDataBufferSize As Long
Dim hCurKey As Long
'Set up default value
If Not IsEmpty(Default) Then
GetSettingLong = Default
Else
GetSettingLong = 0
End If
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lDataBufferSize = 4 '4 bytes = 32 bits = long
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
GetSettingLong = lBuffer
End If
Else
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function
Public Sub SaveSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Sub
Public Function GetSettingByte(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant
Dim lValueType As Long
Dim byBuffer() As Byte
Dim lDataBufferSize As Long
Dim lRegResult As Long
Dim hCurKey As Long
If Not IsEmpty(Default) Then
If VarType(Default) = vbArray + vbByte Then
GetSettingByte = Default
Else
GetSettingByte = 0
End If
Else
GetSettingByte = 0
End If
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_BINARY Then
ReDim byBuffer(lDataBufferSize - 1) As Byte
lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, byBuffer(0), lDataBufferSize)
GetSettingByte = byBuffer
End If
Else
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function
Public Sub SaveSettingByte(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, byData() As Byte)
Dim lRegResult As Long
Dim hCurKey As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValueName, 0&, REG_BINARY, byData(0), UBound(byData()) + 1)
lRegResult = RegCloseKey(hCurKey)
End Sub