[vb] registry uitlezen

[Verwijderd]

Ik moet in vb een aplicatie schrijven waarin ik het register uit moet lezen en dan de uitgelezen waarde als variabele wegschrijven, zodat ik ermee kan rekenen.

Nu lukt het niet om iets uit het register uit te lezen. Ik heb ook al gezocht op alle mogelijke internet en help bestanden (zoals google.com en msdn)

[Woudloper]

Eigenlijk moet je dat gewoon kunnen vinden bij pscode.com of bij vbnet

Maar omdat ik in een goede bui ben, hier wat ik gebruik...

PHP:

<?
Option Explicit

'******************************************************************************************
' Declarations
'******************************************************************************************

Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegQueryValueEx 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
Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long

'******************************************************************************************
' Enums
'******************************************************************************************
Const cHKEY_CLASSES_ROOT = &amp;amp;H80000000
Const cHKEY_CURRENT_USER = &amp;amp;H80000001
Const cHKEY_LOCAL_MACHINE = &amp;amp;H80000002
Const cHKEY_USERS = &amp;amp;H80000003
Const cHKEY_PERFORMANCE_DATA = &amp;amp;H80000004
Const cHKEY_CURRENT_CONFIG = &amp;amp;H80000005
Const cHKEY_DYN_DATA = &amp;amp;H80000006

Public Enum RegistryClassConstants
    HKEY_CLASSES_ROOT = cHKEY_CLASSES_ROOT
    HKEY_CURRENT_USER = cHKEY_CURRENT_USER
    HKEY_LOCAL_MACHINE = cHKEY_LOCAL_MACHINE
    HKEY_USERS = cHKEY_USERS
    HKEY_PERFORMANCE_DATA = cHKEY_PERFORMANCE_DATA
    HKEY_CURRENT_CONFIG = cHKEY_CURRENT_CONFIG
    HKEY_DYN_DATA = cHKEY_DYN_DATA
End Enum


'******************************************************************************************
' Constants
'******************************************************************************************

'------------------------------------------------------------------------------------------
' Reg Key Errors
'------------------------------------------------------------------------------------------

Private Const ERROR_SUCCESS = 0&amp;amp;
Private Const ERROR_BADDB = 1009&amp;amp;
Private Const ERROR_BADKEY = 1010&amp;amp;
Private Const ERROR_CANTOPEN = 1011&amp;amp;
Private Const ERROR_CANTREAD = 1012&amp;amp;
Private Const ERROR_CANTWRITE = 1013&amp;amp;
Private Const ERROR_OUTOFMEMORY = 14&amp;amp;
Private Const ERROR_INVALID_PARAMETER = 87&amp;amp;
Private Const ERROR_ACCESS_DENIED = 5&amp;amp;
Private Const ERROR_NO_MORE_ITEMS = 259&amp;amp;
Private Const ERROR_MORE_DATA = 234&amp;amp;

'------------------------------------------------------------------------------------------
' Reg Key Types
'------------------------------------------------------------------------------------------

Private Const REG_NONE = 0&amp;amp;
Private Const REG_SZ = 1&amp;amp;
Private Const REG_EXPAND_SZ = 2&amp;amp;
Private Const REG_BINARY = 3&amp;amp;
Private Const REG_DWORD = 4&amp;amp;
Private Const REG_DWORD_LITTLE_ENDIAN = 4&amp;amp;
Private Const REG_DWORD_BIG_ENDIAN = 5&amp;amp;
Private Const REG_LINK = 6&amp;amp;
Private Const REG_MULTI_SZ = 7&amp;amp;
Private Const REG_RESOURCE_LIST = 8&amp;amp;
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9&amp;amp;
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10&amp;amp;

'------------------------------------------------------------------------------------------
' Reg Key Security Options
'------------------------------------------------------------------------------------------

Private Const KEY_QUERY_VALUE = &amp;amp;H1&amp;amp;
Private Const KEY_SET_VALUE = &amp;amp;H2&amp;amp;
Private Const KEY_CREATE_SUB_KEY = &amp;amp;H4&amp;amp;
Private Const KEY_ENUMERATE_SUB_KEYS = &amp;amp;H8&amp;amp;
Private Const KEY_NOTIFY = &amp;amp;H10&amp;amp;
Private Const KEY_CREATE_LINK = &amp;amp;H20&amp;amp;
Private Const READ_CONTROL = &amp;amp;H20000
Private Const WRITE_DAC = &amp;amp;H40000
Private Const WRITE_OWNER = &amp;amp;H80000
Private Const SYNCHRONIZE = &amp;amp;H100000
Private Const STANDARD_RIGHTS_REQUIRED = &amp;amp;HF0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const STANDARD_RIGHTS_ALL = &amp;amp;H1F0000
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private 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))
Private Const KEY_EXECUTE = KEY_READ

Private Const defCompany As String = "Woudloper development"   'The default name...

'******************************************************************************************
' Variables
'******************************************************************************************

Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Dim lDataSize As Long
Dim ByteArray() As Byte

Private m_Company        As String
Private m_AppName        As String

'******************************************************************************************
'  Initialize and Terminate
'******************************************************************************************

Private Sub Class_Initialize()
   m_Company = defCompany
   m_AppName = App.ProductName
End Sub

'******************************************************************************************
' Properties
'******************************************************************************************

Public Property Let Company(ByVal NewVal As String)
   If Len(NewVal) Then
      m_Company = Trim(NewVal)
   Else
      m_Company = defCompany
   End If
End Property
Public Property Get Company() As String
   Company = m_Company
End Property

Public Property Let ApplicationName(ByVal NewVal As String)
   If Len(NewVal) Then
      m_AppName = Trim(NewVal)
   Else
      m_AppName = App.ProductName
   End If
End Property
Public Property Get ApplicationName() As String
   ApplicationName = m_AppName
End Property

'******************************************************************************************
' Public Functions
'******************************************************************************************

Public Function GetStringValue(Location As RegistryClassConstants, Section As String, Entry As String, Optional ByVal Default As String = "") As String

    GetStringValue = Default                                    'Before a failure happens give the
                                                                'default value to the function.
    If Location Then
        rtn = RegOpenKeyEx(Location, SubKey(Section), 0, KEY_READ, hKey)        'open the key
        If rtn = ERROR_SUCCESS Then                              'if the key could be opened then
            sBuffer = Space(255)                                 'make a buffer
            lBufferSize = Len(sBuffer)
            rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
            If rtn = ERROR_SUCCESS Then                          'if the value could be retreived then
                rtn = RegCloseKey(hKey)                          'close the key
                sBuffer = Trim(sBuffer)
                GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user
            End If
        End If
    End If

End Function

Public Function SetStringValue(Location As RegistryClassConstants, Section As String, Entry As String, Value As String)

    If Location Then
        rtn = RegOpenKeyEx(Location, SubKey(Section), 0, KEY_WRITE, hKey)     'Open the key
        If rtn = ERROR_SUCCESS Then                              'If the key was open successfully then
            Value = Value &amp;amp; vbNullChar                           'Null-terminate setting, in case it's empty.
            rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value)) 'write the value
            rtn = RegCloseKey(hKey)                              'close the key
        End If
    End If

End Function

Public Function GetDWORDValue(Location As RegistryClassConstants, Section As String, Entry As String, Optional ByVal Default As Long = 0) As Long

    GetDWORDValue = Default

    If Location Then
        rtn = RegOpenKeyEx(Location, SubKey(Section), 0, KEY_READ, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key could be opened then
            rtn = RegQueryValueExA(hKey, Entry, 0, REG_DWORD, lBuffer, 4) 'get the value from the registry
            If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
                rtn = RegCloseKey(hKey)  'close the key
                GetDWORDValue = lBuffer  'return the value
            End If
        End If
    End If

End Function

Public Function SetDWORDValue(Location As RegistryClassConstants, Section As String, Entry As String, Value As Long)
'------------------------------------------------------------------------------------------
' Description:  This function writes a DWORD value to the users registry.
' Input params: Location;   In which part you want to write the key.
'               Section;    What would the section name be?
'               Entry;      The entry name..
'               Value;      The value you want to write...
' Syntax:       SetDWORDValue HKEY_CURRENT_USER, "General", "The DWORD Value", 6
'------------------------------------------------------------------------------------------

    If Location Then
        rtn = RegOpenKeyEx(Location, SubKey(Section), 0, KEY_WRITE, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
            rtn = RegSetValueExA(hKey, Entry, 0, REG_DWORD, Value, 4) 'write the value
            rtn = RegCloseKey(hKey) 'close the key
        End If
    End If

End Function

Function GetBinaryValue(Location As RegistryClassConstants, Section As String, Entry As String, Optional ByVal Default As String)

    GetBinaryValue = Default
    
    If Location Then
        rtn = RegOpenKeyEx(Location, SubKey(Section), 0, KEY_READ, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key could be opened
            lBufferSize = 1
            rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, 0, lBufferSize) 'get the value from the registry
            sBuffer = Space(lBufferSize)
            rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, sBuffer, lBufferSize) 'get the value from the registry
            If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
               rtn = RegCloseKey(hKey)  'close the key
              GetBinaryValue = sBuffer 'return the value to the user
            End If
        End If
    End If

End Function

Function SetBinaryValue(Location As RegistryClassConstants, Section As String, Entry As String, Value As String)
Dim lngCounter      As Long

    If Location Then
        rtn = RegOpenKeyEx(Location, SubKey(Section), 0, KEY_WRITE, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
            lDataSize = Len(Value)
            ReDim ByteArray(lDataSize)
            For lngCounter = 1 To lDataSize
                ByteArray(lngCounter) = Asc(Mid$(Value, lngCounter, 1))
            Next
            rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value
        End If
        rtn = RegCloseKey(hKey) 'close the key
    End If

End Function

Public Function DeleteSetting(Location As RegistryClassConstants, Section As String, Optional ByVal Entry As String = "") As Boolean
'------------------------------------------------------------------------------------------
' Section   Required. String expression containing the name of the section where the key setting
'           is being deleted. If only section is provided, the specified section is deleted along
'           with all related key settings.
' Key       Optional. String expression containing the name of the key setting being deleted.
'------------------------------------------------------------------------------------------
Dim nRet    As Long
Dim hKey    As Long

   If Len(Entry) Then
      ' Open key
      nRet = RegOpenKeyEx(Location, SubKey(Section), 0&amp;amp;, KEY_ALL_ACCESS, hKey)
      If nRet = ERROR_SUCCESS Then
         ' Set appropriate value for default query
         If Entry = "*" Then Entry = vbNullString
         ' Delete the requested value
         nRet = RegDeleteValue(hKey, Entry)
         Call RegCloseKey(hKey)
      End If
   Else
      ' Open parent key
      nRet = RegOpenKeyEx(Location, SubKey(), 0&amp;amp;, KEY_ALL_ACCESS, hKey)
      If nRet = ERROR_SUCCESS Then
         ' Attempt to delete whole section
         nRet = RegDeleteKey(hKey, Section)
         Call RegCloseKey(hKey)
      End If
   End If
   
   DeleteSetting = (nRet = ERROR_SUCCESS)

End Function

'******************************************************************************************
'  Private Functions/Subs
'******************************************************************************************

Private Function SubKey(Optional ByVal Section As String = "") As String
'------------------------------------------------------------------------------------------
' Description:  Build SubKey from known values.
' Syntax:       SubKey("General") = SoftwareWoudloper DevelopmentRegistry Test ApplicationGeneral
'------------------------------------------------------------------------------------------

   SubKey = "Software\" &amp;amp; m_Company &amp;amp; "\" &amp;amp; m_AppName
   If Len(Section) Then
      SubKey = SubKey &amp;amp; "\" &amp;amp; Section
   End If

End Function
?>

_{php voor de kleurtjes (en omdat het kleiner is)}

/edit: pssst, het is een class module...

[ Voor 0% gewijzigd door Woudloper op 09-04-2015 13:53 . Reden: naamaanpassing ]

[Verwijderd]

Ik heb dit onderstaande 2 dagen geleden gevonend (hier op GOT). Ik heb geen idee hoe en of het werkte, ik heb het zelf nog niet geprobeerd.

Dim objWSH As Object
Set objWSH = CreateObject("WScript.Shell")

objWSH.RegRead....
objWSH.RegWrite....
objWSH.RegDelete....

[Verwijderd]

Op dinsdag 29 januari 2002 18:01 schreef Hompie het volgende:
Ik heb dit onderstaande 2 dagen geleden gevonend (hier op GOT). Ik heb geen idee hoe en of het werkte, ik heb het zelf nog niet geprobeerd.

Dim objWSH As Object
Set objWSH = CreateObject("WScript.Shell")

objWSH.RegRead....
objWSH.RegWrite....
objWSH.RegDelete....

Je moet dan wel Windows Script Host meeleveren.

[Verwijderd]

Het kan ook simpeler dmv GetSetting en SaveSetting. Hierbij hoef je alleen je app. name, een folder en een key op te geven, en je hoeft niks mee te leveren! Bovendien kan het in één regel code, dus voor simpele dingen zal ik deze functies gebruiken, als je meer ingewikkeldere dingen wilt moet je de code van rwoudstra gebruiken

[D2k]

al op de MSDN gekeken?