hello everyone. i am working on a project that requires me to reproduce something very similar to the startup portion of the msconfig.exe program in microsoft windows. i need to fill a list box with all of the string names and values that exist at the following keys in the registry:
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\Run
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\Run-
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunOnce
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunOnce-
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunServices
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunServices-
I need the style of the listbbox to be checkbox so that a checkbox is in front of each item.
So far i have been able to create a listbox with the style set to checkbox, i have been able to list all of the items in only 1 of the above locations, but i need to list string names and values from all of the above locations. I also am having difficulty in getting the list box to check or uncheck the item depending on which subkey the item exists in. for example:
if the key exists in either of the following,
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\Run
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunOnce
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunServices
It should be created with the checkbox checked, but if it exists in the folowing three,
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\Run-
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunOnce-
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\RunServices-
it should be created without a check in it.
The second part of this is as follows:
when the program is run, you will see a list of items, some with checkboxes, some without. items with checkmarks represent items that will automatically startup everytime windows boots up. you should be able to uncheck items, press an apply command button and any changed items will have their string names and values written from the registry subkey they exist in, to a subkey with the same name but with a dash after it. for example
an item in
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\Run would have a checked checkbox in front of it
and if you unchecked it it would be moved to
HKEY_LOCAL_MACHINE\Software\Microsft\Windows\CurrentVersion\Run- after you pressed the apply button at the bottom of the form.
so on and so forth.
so far i have only been able to have everything in 1 subkey listed in a checkbox listbox without any items checked. i have included my code below. could someone help me with it. I have been trying for weeks and have gotten no where.
on a form create a listbox, set the type to checkbox. create a coomand button called apply. Insert the following code.
--------------------------------code-----------------------------------------
'tis is the bas or module file.
Option Explicit
' Reg Data Types...
Global Const REG_NONE = 0 ' No value type
Global Const REG_SZ = 1 ' Unicode nul terminated string
Global Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Global Const REG_BINARY = 3 ' Free form binary
Global Const REG_DWORD = 4 ' 32-bit number
Global Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)
Global Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number
Global Const REG_LINK = 6 ' Symbolic Link (unicode)
Global Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Global Const REG_RESOURCE_LIST = 8 ' Resource list in the resource map
Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9 ' Resource list in the hardware description
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const SYNCHRONIZE = &H100000
Global Const STANDARD_RIGHTS_ALL = &H1F0000
' Reg Key Security Options
Global Const KEY_QUERY_VALUE = &H1
Global Const KEY_SET_VALUE = &H2
Global Const KEY_CREATE_SUB_KEY = &H4
Global Const KEY_ENUMERATE_SUB_KEYS = &H8
Global Const KEY_NOTIFY = &H10
Global Const KEY_CREATE_LINK = &H20
'Global Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Global Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx function
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Sub
Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim Zero As Long, IRetVal As Long, hKey As Long, OrigKeyNam As String
' OrigKeyNam = Left$(sKeyName, InStr(sKeyName + "\", "\") - 1)
'open the specified key
IRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, Zero, KEY_ALL_ACCESS, hKey)
If IRetVal Then MsgBox "RegOpenKey error - " & IRetVal
IRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
If IRetVal Then MsgBox "SetValue error - " & IRetVal
RegCloseKey (hKey)
End Sub
Sub QueryValue(sKeyName As String, sValueName As String)
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
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
MsgBox vValue
RegCloseKey (hKey)
End Sub
Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
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
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
vValue = Left$(sValue, cch)
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
End Function
-----------------------------------code ends here------------------------------------------
below is the code for the form
-----------------------------------code begins here--------------------------------------
Option Explicit
' Registry Sample by Matt Hart - [email protected]
' http://ourworld.compuserve.com/homepages/matthart
' http://www.webczar.com/defcon
' http://www.webczar.com/defcon/mh/vbhelp.html
'
' The commented portion of this sample creates a key, sets a value,
' and retrieves a value.
'
' This sample has been updated to enumerate all the Values of
' the HKEY_USERS\.Default\RemoteAccess key.
'
' Note that I have CHANGED the declaration for RegEnumValue.
' It had one error in the Win32API file:
' lpReserved As Long
' is supposed to be NULL according to the SDK. However, declaring
' it like this will cause a POINTER to the value (0) to be passed
' rather than NULL. I changed it to:
' ByVal lpReserved As Long
' That will force a value of 0 to be passed rather than a non-zero
' POINTER to the value of 0.
' Also, I changed this:
' lpData As Any
' to:
' ByVal lpData As String
' I could have left it As Any. However, I would then have needed to
' use a fixed length string or a numeric variable. By passing a
' variable length string buffer, I can easily extract a non-string
' value. (See the Select Case lType).
'
' See Win32api file for several more Reg???? API calls.
' This is the Microsoft KB article, but I fixed the bugs in it.
Private Type a4
a As String * 4
End Type
Private Type l4
l As Long
End Type
Private Sub Form_Load()
' CreateNewKey "TestKey\SubKey1\SubKey2", HKEY_LOCAL_MACHINE
' SetKeyValue "TestKey\SubKey1", "StringValue", "Hello", REG_SZ
' QueryValue "TestKey\SubKey1", "StringValue"
Dim lRet As Long, hKey As Long
lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_ALL_ACCESS, hKey)
If lRet Then MsgBox "Error accessing HKEY_USERS\.Default\RemoteAccess": Exit Sub
Dim lIndex As Long, aVName$, lVName As Long, lType As Long, aData$, lData As Long
Dim aAdd$, l As Long, a4 As a4, l4 As l4, a$
lVName = 100 ' Name buffer length
aVName$ = Space$(lVName) ' Name buffer
lData = 100 ' Data buffer length
aData$ = Space$(lData) ' Data buffer
lRet = RegEnumValue(hKey, lIndex, aVName$, lVName, 0, lType, aData$, lData)
Do Until lRet = ERROR_NO_MORE_ITEMS
aAdd$ = Left$(aVName$, lVName) & vbTab ' Note that lVName returns the # of bytes copied
Do Until TextWidth(aAdd$) > List1.Width \ 4: aAdd$ = aAdd$ & " ": Loop
aAdd$ = aAdd$ & vbTab
Select Case lType
Case REG_BINARY
For l = 1 To lData
a$ = Hex$(Asc(Mid$(aData$, l, 1)))
If Len(a$) = 1 Then a$ = "0" & a$
aAdd$ = aAdd$ & a$ & " "
Next
Case REG_DWORD
a4.a = Left$(aData$, lData)
LSet l4 = a4
aAdd$ = aAdd$ & l4.l
Case Else ' String or other
aAdd$ = aAdd$ & Left$(aData$, lData) ' Note that lData returns the # of bytes copied
End Select
List1.AddItem aAdd$
lVName = 100 ' You MUST reset these buffer lengths, because the RegEnumValue call
lData = 100 ' changed them to = # of bytes copied
lIndex = lIndex + 1
lRet = RegEnumValue(hKey, lIndex, aVName$, lVName, 0, lType, aData$, lData)
Loop
lRet = RegCloseKey(hKey)
End Sub
------------------------------Code ends here---------------------------------------------
please help me if you can
please email me at [email protected]
