Newsgroup: it.comp.lang.visual-basic
Titolo: Scrivere nel registro

Salve a tutti......
non mi riconoscerete, ma sto scrivendo da casa, con un PC diverso da quello
che uso x lavoro....comunque arriviamo al sodo!!!!
ho bisogno di un modulo .bas per scrivere nel registry di windows. Io ne ho
già uno, ma mi permette di scrivere soltanto valori di tipo stringa, mentre
io devo scrivere Double o comunque numerici......
mi sapete consigliare?!?
Grazie 1000!!!!!
Igor Damiani
ico...@simcity.it

mi sapete consigliare?!?
Non so chi sia l'autore, non so deve l'ho trovato, ma salvati quello che segue in un file .bas:
------------------------------------
Option Explicit
 
    'Dio ringrazi gli How-To!!!! Anche quelli della M$
    'Ale Riolo, 24/2/1999
    ' quelli con * li ho trovati in WINREG.H
 
    Global Const REG_SZ As Long = 1
    Global Const REG_DWORD As Long = 4
 
    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 HKEY_CURRENT_CONFIG = &H80000005 '*
    Global Const HKEY_DYN_DATA = &H80000006 '*
    Global Const HKEY_PERFORMANCE_DATA = &H80000004 '*
 
    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 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 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
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
                            lType As Long, vValue As Variant) As Long
 
    'wrapper della API win32 per impostare valori nel registro di configurazione
 
    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
 
 
 
Public Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
                                String, vValue As Variant) As Long
 
    'wrapper della API win32 per ottenere valori dal registro di configurazione
 
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
 
    On Error GoTo QueryValueExError
        ' Determina la dimensione ed il tipo dei dati da leggere
        lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
        If lrc <> ERROR_NONE Then Error 5
        Select Case lType
            ' In caso di stringhe
            Case REG_SZ:
                sValue = String(cch, 0)
                lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
                                                sValue, cch)
                If lrc = ERROR_NONE Then
                    vValue = Left$(sValue, cch - 1)
                Else
                    vValue = Empty
                End If
            ' In caso di DWORDS
            Case REG_DWORD:
                lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
                                            lValue, cch)
                If lrc = ERROR_NONE Then vValue = lValue
            Case Else
               'Tutti gli altri tipi di dati non supportati
                lrc = -1
       End Select
'A quanto pare M$ vuole che dalle routine si esca così... mah!!!!
QueryValueExExit:
    QueryValueEx = lrc
    Exit Function
QueryValueExError:
    Resume QueryValueExExit
End Function
Public Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
 
    'M$ dice che si usa così: CreateNewKey "LaMiaChiave",HKEY_CURRENT_USER
    'oppure anche così: CreateNewKey "LaMiaChiave\Sottochiave", HKEY_LOCAL_MACHINE
 
    Dim hNewKey As Long      'handle che identifica la nuova chiave
    Dim lRetVal As Long      'risultato della funzione RegCreateKeyEx
 
 
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
              vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
                 0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
End Sub
Public Sub SetKeyValue(PK As Long, sKeyName As String, sValueName As String, _
                        vValueSetting As Variant, lValueType As Long)
 
    'serve per modificare le chiavi nel registro di configurazione
    'da usare così: SetKeyValue HKEY_CURRENT_USER,"MiaChiave\Sottochiave", "StringValue", "Hello",
REG_SZ
    'lValueType può assumere i valori REG_SZ e REG_DWORD
 
    Dim lRetVal As Long      'risulatato della funzione SetValueEx
    Dim hKey As Long         'handle che identifica la chiave aperta
 
    'i valori ammessi da PK sono:
    'HKEY_CLASSES_ROOT
    'HKEY_CURRENT_USER
    'HKEY_LOCAL_MACHINE
    'HKEY_USERS
    'HKEY_CURRENT_CONFIG
    'HKEY_DYN_DATA
    'HKEY_PERFORMANCE_DATA
 
    'apre la chiave specificata
    lRetVal = RegOpenKeyEx(PK, sKeyName, 0, _
                            KEY_ALL_ACCESS, hKey)
    'imposta il nuovo valore della chiave
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)
End Sub
Public Function QueryValue(PK As Long, sKeyName As String, sValueName As String) As Variant
 
    'ritorna il valore nella chiave indicata
    'da usare così: QueryValue "MiaChiave\Sottochiave", "StringValue"
 
 
    Dim lRetVal As Long      'risultato delle funzioni API
    Dim hKey As Long         'handle che identifica la chiave aperta
    Dim vValue As Variant    'impostazioni del chiave cercata
 
    'i valori ammessi da PK sono:
    'HKEY_CLASSES_ROOT
    'HKEY_CURRENT_USER
    'HKEY_LOCAL_MACHINE
    'HKEY_USERS
    'HKEY_CURRENT_CONFIG
    'HKEY_DYN_DATA
    'HKEY_PERFORMANCE_DATA
 
    lRetVal = RegOpenKeyEx(PK, sKeyName, 0, _
                                KEY_ALL_ACCESS, hKey)
    '
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    'MsgBox vValue           'per ogni evenienza ;-)
    RegCloseKey (hKey)
    QueryValue = vValue
End Function
---------------------------
Ciao,
Moreno
#sirri#@#morenosoft#.com
(togliete "#" dall'indirizzo)
Moreno Sirri VB Site - 
http://www.morenosoft.com/MSVBSite/
---------------------------------------------------------------------------
Le risposte alle tue domande le trovi sul Sito Comune di questo NewsGroup:
 
http://www.murialdo.it/it_lang_vb
---------------------------------------------------------------------------

ciao e grazie!!!!
sei un Dio!!!!!

 sei un Dio!!!!!
MORENO GO ON !!
VOTE 4 MORENO !!
non ci bastano piu' santi e beati !
avere un dio come prossimo wm non e' da tutti i ng :))



ehi, ehi... torniamo sulla terra: cambiate spacciatore, please.... ;-P
