[VB6] Leggere Regedit

[raffaeu]

Ciao come faccio a leggere questa

HKEY_CURRENT_USER\Software\IBM\Client Access Express\CurrentVersion\Environments\Collegamenti\A S400\Communication

Chiave User ID

COn getSetting non funziona lui legge solo quello dentro VB and VBA applications ....

Grazie

[diegocoz]

Dovresti usare le API, del tipo la RegOpenKeyEx e la RegQueryValueEx che trovi definite nel modulo bas sottostante (ti conviene incollarlo nel editor vb per capirci qualcosa) e che penso di aver trovato sui sample del cd di installazione o direttamente nella guida in linea.

Ciao
Buon lavoro

Option Explicit

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_RESOURCE_LIST = 8
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
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))
Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Boolean
End Type
Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult 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, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) _
    As Long
    Declare Function RegEnumKeyEx Lib "advapi32" Alias "RegEnumKeyA" _
   (ByVal hKey As Long, _
   ByVal iSubKey As Long, _
    ByVal lpszName As String, _
    ByVal cchName As Long) _
    As Long
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
   (ByVal hKey As Long, _
   ByVal lpszSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) _
    As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
   (ByVal hKey As Long, _
   ByVal lpszValueName As String, _
    ByVal dwReserved As Long, _
    lpdwType As Long, _
    lpbData As Any, _
    cbData As Long) _
    As Long
Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
   (ByVal hKey As Long, _
   ByVal lpszValueName As String, _
    ByVal dwReserved As Long, _
    ByVal fdwType As Long, _
    lpbData As Any, _
    ByVal cbData As Long) _
    As Long
Declare Function RegSetStringEx Lib "advapi32" Alias "RegSetValueExA" _
   (ByVal hKey As Long, _
   ByVal lpszValueName As String, _
    ByVal dwReserved As Long, _
    ByVal fdwType As Long, _
    lpbData As String, _
    ByVal cbData As Long) _
    As Long
Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Function CreateRegEntry(PrimaryKey As Long, Key As String, KeyToAdd As Variant, pDatatype As Long, ValueToAdd As Variant) As Boolean
   On Local Error GoTo CreateRegEntry_Err
   Dim lResult As Long, i As Integer, msg As String
   Dim strMyKeyFull As String, MyKeyName As String
   Dim MyKeyValueLng As Long, MyKeyValueStr As String
   Dim MyDataType As Long, phkResult As Long, IsNewKey As Long
   lResult = RegCreateKeyEx(PrimaryKey, Key, 0&, _
                            REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
                            ByVal 0&, phkResult, IsNewKey)
   If Not (lResult = ERROR_SUCCESS) Then
   CreateRegEntry = False
      msg = "Error Creating Registry Key Entry:" & vbCrLf
      msg = msg & "Key=" & strMyKeyFull & vbCrLf
      msg = msg & "DLL Returned=" & Format$(lResult)
      MsgBox msg, vbOKOnly Or vbExclamation, App.Title
      GoTo CreateRegEntry_End
    End If
    Select Case pDatatype
       Case REG_DWORD
       MyKeyValueLng = ValueToAdd
          lResult = RegSetValueEx(phkResult, KeyToAdd, ByVal 0&, pDatatype, MyKeyValueLng, Len(MyKeyValueLng))
       Case REG_SZ
       MyKeyValueStr = ValueToAdd
          lResult = RegSetValueEx(phkResult, KeyToAdd, ByVal 0&, pDatatype, ByVal MyKeyValueStr, Len(MyKeyValueStr))
    End Select
    If Not (lResult = ERROR_SUCCESS) Then
       CreateRegEntry = False
       msg = "Error Creating Registry Key Entry:" & vbCrLf
       msg = msg & "Key=" & KeyToAdd & vbCrLf
       msg = msg & "DLL Returned=" & Format$(lResult)
       MsgBox msg, vbOKOnly Or vbExclamation, App.Title
       GoTo CreateRegEntry_End
       End If
       CreateRegEntry = True
CreateRegEntry_End:
Exit Function
CreateRegEntry_Err:
   MsgBox Error.Description, vbOKOnly Or vbExclamation, App.Title
   Resume CreateRegEntry_End
   End Function

Function DeleteAllAppRegEntries() As Boolean
   On Local Error GoTo DeleteAllAppRegEntries_Err
   Dim lResult As Long, msg As String
   Dim hKey As Long
   lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                          REG_APP_KEYS_PATH, _
                          ByVal 0&, KEY_ALL_ACCESS, hKey)
   If Not (lResult = ERROR_SUCCESS) Then
   DeleteAllAppRegEntries = False
      msg = "Error Opening Registry Key Entry:" & vbCrLf
      msg = msg & "Key/Path=" & REG_APP_KEYS_PATH & vbCrLf
      msg = msg & "DLL Returned=" & Format$(lResult)
      MsgBox msg, vbOKOnly Or vbExclamation, App.Title
      GoTo DeleteAllAppRegEntries_End
    End If
   lResult = RegDeleteKey(hKey, "")
   If Not (lResult = ERROR_SUCCESS) Then
      DeleteAllAppRegEntries = False
      msg = "Error Deleting Registry Key Entry:" & vbCrLf
      msg = msg & "Key=" & REG_APP_KEYS_PATH & vbCrLf
      msg = msg & "DLL Returned=" & Format$(lResult)
      MsgBox msg, vbOKOnly Or vbExclamation, App.Title
      GoTo DeleteAllAppRegEntries_End
      End If
      lResult = RegCloseKey(hKey)
   DeleteAllAppRegEntries = True
DeleteAllAppRegEntries_End:      Exit Function
DeleteAllAppRegEntries_Err:
   MsgBox Error.Description, vbOKOnly Or vbExclamation, App.Title
   Resume DeleteAllAppRegEntries_End
   End Function

Function GetAppRegValue(SubKey As String, WhatKey As String, KeyDataType As Variant, KeyValue As Variant, IsVerbose As Integer) As Boolean
   On Local Error GoTo GetAppRegValue_Err
   Dim lResult As Long, dwResult As Long
   Dim dwType As Long, cbData As Long
   Dim varStrData As String, varLngData As Long
   Dim msg As String
   lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                          REG_APP_KEYS_PATH + "\" + SubKey, _
                          ByVal 0&, KEY_ALL_ACCESS, dwResult)
   If Not (lResult = ERROR_SUCCESS) Then
    GetAppRegValue = False
      If IsVerbose Then
         msg = "Error Opening Registry Key Entry:" & vbCrLf
         msg = msg & "Key/Path=" & REG_APP_KEYS_PATH & vbCrLf
         msg = msg & "DLL Returned=" & Format$(lResult)
         MsgBox msg, vbOKOnly Or vbExclamation, App.Title
         End If
      GoTo GetAppRegValue_End
    End If
   ' ***********************************************
   ' Set up passed variables and retrieve value.
   ' ***********************************************
   Select Case KeyDataType
      Case REG_SZ
      varStrData = String$(255, 0)
         cbData = Len(varStrData)
         lResult = RegQueryValueEx(dwResult, WhatKey, ByVal 0&, _
                                   dwType, ByVal varStrData, cbData)
      Case REG_DWORD
      varLngData = False
      cbData = Len(varLngData)
         lResult = RegQueryValueEx(dwResult, WhatKey, ByVal 0&, _
                                   dwType, varLngData, cbData)
    End Select
   If Not (lResult = ERROR_SUCCESS) Then
   GetAppRegValue = False
      If IsVerbose Then
         msg = "Error Retrieving Registry Key Entry:" & vbCrLf
         msg = msg & "Key=" & WhatKey & vbCrLf
         msg = msg & "DLL Returned=" & Format$(lResult)
         MsgBox msg, vbOKOnly Or vbExclamation, App.Title
         End If
      lResult = RegCloseKey(dwResult)
      GoTo GetAppRegValue_End
      End If
   ' ***********************************************   ' Close key.
   ' ***********************************************
   lResult = RegCloseKey(dwResult)
   ' ***********************************************
   ' Select data type (for the needed types
   ' used in the values) and assign value.
   ' ***********************************************
   Select Case dwType
      Case REG_NONE
      KeyValue = vbNull
      Case REG_SZ
         KeyValue = Left$(varStrData, cbData)
         If cbData > 0 Then
            If (Asc(Mid(KeyValue, cbData, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
                KeyValue = Left(KeyValue, cbData - 1)               ' Null Found, Extract From String
         End If                                                  ' WinNT Does NOT Null Terminate String...
        End If
         Case REG_DWORD
         KeyValue = varLngData
         Case Else
         KeyValue = vbNull
   End Select
   GetAppRegValue = True
   Debug.Print KeyValue
GetAppRegValue_End:
   Exit Function
GetAppRegValue_Err:
   MsgBox Error.Description, vbExclamation, App.Title
   Resume GetAppRegValue_End
   End Function

Function SetAppRegValue(SubKey As String, WhatKey As String, KeyDataType As Variant, NewKeyValue As Variant) As Boolean
    On Local Error GoTo SetAppRegValue_Err
   ' ***********************************************
   ' Declare local usage variables.
   ' ***********************************************
   Dim lResult As Long, dwResult As Long
   Dim dwType As Long, cbData As Long
   Dim varStrData As String, varLngData As Long
   Dim msg As String
   ' ***********************************************
   ' Open the key for application's path.
   ' ***********************************************
   lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                          REG_APP_KEYS_PATH + "\" + SubKey, _
                          ByVal 0&, KEY_ALL_ACCESS, dwResult)
   If Not (lResult = ERROR_SUCCESS) Then
   SetAppRegValue = False
      msg = "Error Opening Registry Key Entry:" & vbCrLf
      msg = msg & "Key/Path=" & REG_APP_KEYS_PATH & vbCrLf
      msg = msg & "DLL Returned=" & Format$(lResult)
      MsgBox msg, vbOKOnly Or vbExclamation, App.Title
      GoTo SetAppRegValue_End
      End If
   ' ***********************************************
   ' Set up passed variables and retrieve value.
   ' ***********************************************
   Select Case KeyDataType
      Case REG_SZ
      varStrData = NewKeyValue
         lResult = RegSetValueEx(dwResult, WhatKey, _
                                 ByVal 0&, KeyDataType, _
                                 ByVal varStrData, Len(varStrData))
      Case REG_DWORD
      varLngData = CLng(NewKeyValue)
         lResult = RegSetValueEx(dwResult, WhatKey, _
                                 ByVal 0&, KeyDataType, _
                                 varLngData, Len(varLngData))
                                 End Select
   If Not (lResult = ERROR_SUCCESS) Then
   SetAppRegValue = False
      msg = "Error Setting Registry Key Entry:" & vbCrLf
      msg = msg & "Key=" & WhatKey & vbCrLf
      msg = msg & "DLL Returned=" & Format$(lResult)
      MsgBox msg, vbOKOnly Or vbExclamation, App.Title
      lResult = RegCloseKey(dwResult)
      GoTo SetAppRegValue_End
      End If
   ' ***********************************************   ' Close key.
   ' ***********************************************
   lResult = RegCloseKey(dwResult)
   SetAppRegValue = True
SetAppRegValue_End:
   Exit Function
SetAppRegValue_Err:
   MsgBox Error.Description, vbOKOnly Or vbExclamation, App.Title
   Resume SetAppRegValue_End
   End Function

[buba88]

be c'è un altro modo molto più semplice, usando l oggetto WSHshell

vai qui:
http://www.vbitalia.it/articoli/regi...?lez=registro1

ciao

[raffaeu]

Mama mia aveva preso un colpo !!

Provo con WSHShell che lo uso già in vbs

[xegallo]

Originariamente inviato da diegocoz
(ti conviene incollarlo nel editor vb per capirci qualcosa)

la prossima volta usi i tag per formattare il codice che così capisco anche io che devo leggerlo :rollo:

[*code] [*/code] senza gli asterischi

[raffaeu]

Comunque con WSHshell si puo' fare tutto quello che si riesce a fare con i file vbs ...

esempio per leggere 'qualsiasi cosa'

oggShell.RegRead(chiave/valore)
oggShell.RegWrite stringa, valore, [tipo]
oggShell.RegDelete stringa, valore, [tipo]

Molto molto bello ...