Modification Valeur Base registre XP à partir de VB

Question

Salut &#224; vous 

je n'arrive pas &#224; modifier des Valeurs de la Base de registre sous Windows XP  [HKEY_CURRENT_USER\Software\....] alors que cela fonctionne parfaitement sous Windows 98 .... 

Je crois que XP bloque les acc&#233;s VB / changement des Donn&#233;es dans les Valeurs de la Base de registre....

Pouvez-vous m'aider ?

Phil_M

Voici la s&#233;quence d'instructions que j'utilise sous Windows 98

'Option Explicit


'Constantes correspondant aux cinq cl&#233;s
'&#224; la base de la base de registres


Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_DYN_DATA = &H80000004


'API n&#233;cessaires


'pour cr&#233;er ou ouvrir une cl&#233;
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal HKEY As Long, _
     ByVal lpSubKey As String, _
     phkResult As Long) As Long
       
'pour fixer ou cr&#233;er une valeur
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, _
     lpData As Any, _
     ByVal cbData As Long) As Long

'Prm d'appel
textValeur = "SavePath"
TextDonnee = Worksheets("Dieu").Range("Directory_Pdf")
Call register_data(textcle, textValeur, TextDonnee)

Sub register_data(textcle As String, textValeur As String, TextDonnee As String)
'**************************************************
Dim var1 As Long
Dim Resultat As Long
Dim Ident As Long
  
  '***** cr&#233;er ou fixer une valeur *****
    Resultat = 0
    
    'on ouvre la cl&#233; (en faisant comme si on la cr&#233;ait),
    'et on obtient ainsi un identificateur stock&#233; dans Ident
    'qui nous permettra d'acc&#233;der &#224; la cl&#233;
   
    Resultat = RegCreateKey(HKEY_CURRENT_USER, textcle, Ident)
    
    If Resultat = 0 Then
        'Fixe la valeur avec la donn&#233;e qui correspond
        'Si la valeur n'existe pas, elle sera automatiquement cr&#233;e.
        Resultat = RegSetValueEx(Ident, textValeur, 0&, 1, ByVal TextDonnee, Len(TextDonnee) + 1)
    End If


End Sub

Gobillot · Answer

essayes plut&#244;t &#231;a:


Private 
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

Daniel

philippeMerklen · Answer

Un grand merci, mais cela coince quand je fais

Resultat = RegCreateKeyEx (HKEY_CURRENT_USER, textcle, Ident)
 -> argument attendu ou mal d&#233;clar&#233;

Peux tu m'&#233;claire sur l'utlisation de RegCreateKeyEx ?

Salutations Philippe M

Gobillot · Answer

Const HKEY_CURRENT_USER = &H80000001

Const REG_OPTION_BACKUP_RESTORE = 4 
Const REG_OPTION_VOLATILE = 1 
Const REG_OPTION_NON_VOLATILE = 0 
Const STANDARD_RIGHTS_ALL = &H1F0000

Const SYNCHRONIZE = &H100000

Const READ_CONTROL = &H20000

Const STANDARD_RIGHTS_READ = (READ_CONTROL)

Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Const KEY_CREATE_LINK = &H20

Const KEY_CREATE_SUB_KEY = &H4

Const KEY_ENUMERATE_SUB_KEYS = &H8

Const KEY_NOTIFY = &H10

Const KEY_QUERY_VALUE = &H1

Const KEY_SET_VALUE = &H2

Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Const KEY_EXECUTE = (KEY_READ)

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 
Declare 
Function RegCloseKey 
Lib 
"advapi32.dll" (
ByVal hKey 
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 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


Private 
Declare 
Function RegOpenKeyEx 
Lib 
"advapi32.dll" 
Alias 
"RegOpenKeyExA" (
ByVal hKey 
As 
Long, 
ByVal lpSubKey 
As 
String, 
ByVal Reserved 
As 
Long, 
ByVal samDesired 
As 
Long, phkResult 
As 
Long) 
As 
Long



<HR>

Dim Result As Long


RegCreateKeyEx HKEY_CURRENT_USER, textcle, 0, 
"REG_SZ", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 
ByVal 0&, Result, Ret



If Result = 0 
Then
    MsgBox 
"Error while creating the Key!!"
    Exit 
Sub

RegCloseKey Result

Daniel

philippeMerklen · Answer

Merci Daniel

C'est effecrivment plus clair 
mais je n'arrive pas avec cette fonction &#224; isoler
HKEY_CURRENT_USER 
Textclef = "Softaware..."
TextValue = "Subject"

je ne le trouve pas sous RegCreateKeyEx

ce sont les donn&#233;es de "Subject" que j'essaye de modifier 

Philippe M

Gobillot · Answer

'API de cr&#233;ation ou de modification de valeur CHAINE
Private 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


'API de cr&#233;ation ou de modification de valeur ENTIERE
Private 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

Private Const registre = HKEY_CURRENT_USER 
Private Const RegistreCle = "SOFTWARE"
Private Const Chaine As Long = 1
Private Const Entier As Long = 4

'Fonction d'ecriture d'une chaine dans la base de registre
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub WriteString(Cle As String, NomValeur As String, Valeur As String)
Dim Pointeur As Long 'pointe sur la cl&#233;
Dim Resultat As Long 'r&#233;sultat

Cle = RegistreCle + "" + Cle

Resultat = RegCreateKeyEx(registre, Cle, _
0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, Pointeur, Resultat)
Resultat = RegSetValueExString(Pointeur, NomValeur, 0&, Chaine, Valeur, Len(Valeur))
Resultat = RegCloseKey(Pointeur)
End Sub

'Fonction d'ecriture d'un entier dans la base de registre
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub WriteDouble(Cle As String, NomValeur As String, Valeur As Long)
Dim Pointeur As Long 'pointe sur la cl&#233;
Dim Resultat As Long 'r&#233;sultat

Cle = RegistreCle + "" + Cle

Resultat = RegCreateKeyEx(registre, Cle, _
0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, Pointeur, Resultat)
Resultat = RegSetValueExLong(Pointeur, NomValeur, 0&, Entier, Valeur, 4)
Resultat = RegCloseKey(Pointeur)
End Sub

'Fonction d'ecriture d'un Boolean dans la base de registre
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub WriteBoolean(Cle As String, NomValeur As String, Valeur As Boolean)
Dim Pointeur As Long 'pointe sur la cl&#233;
Dim Resultat As Long 'r&#233;sultat
Dim eValeur As String

Cle = RegistreCle + "" + Cle

Select Case Valeur
Case True: eValeur = "True"
Case False: eValeur = "False"
End Select

Resultat = RegCreateKeyEx(registre, Cle, _
0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, Pointeur, Resultat)
Resultat = RegSetValueExString(Pointeur, NomValeur, 0&, Chaine, eValeur, Len(Valeur))
Resultat = RegCloseKey(Pointeur)
End Sub

Bon j'ai rien test&#233; et je r&#233;cup&#232;re les renseignements au fur et &#224; mesure, alors il est possible qu'il manque des choses.

Daniel

philippeMerklen · Answer

'
' Merci bcp Daniel ne fonctionne pas Erreur = 87
' Voici du code qui fonctionne !! Test r&#233;sussi !! 
'
' je l'ai trouv&#233; sur ce site
' http://vbnet.mvps.org/index.html?code/reg/ietoolbarextension.htm
'
'Merci infiniment, je vais pouvoir Piloter un Logiciel d'impr&#233;ssion 'PDF sous Win 98 et Win XP....

Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_ALL_ACCESS As Long = &H3F
Private Const KEY_CREATE_SUB_KEY  As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const KEY_CREATE_LINK As Long = &H20
Private Const READ_CONTROL As Long = &H20000
Private Const WRITE_DAC As Long = &H40000
Private Const WRITE_OWNER As Long = &H80000
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const STANDARD_RIGHTS_READ As Long = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE As Long = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE As Long = READ_CONTROL
Private Const KEY_READ As Long = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE As Long = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const KEY_EXECUTE As Long = KEY_READ
Private Const REG_OPTION_NON_VOLATILE As Long = 0


Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003


'Registration key types
Private Const REG_NONE As Long = 0                     'No value type
Private Const REG_SZ As Long = 1                       'Unicode nul terminated string
Private Const REG_EXPAND_SZ As Long = 2                'Unicode nul terminated string
Private Const REG_BINARY As Long = 3                   'Free form binary
Private Const REG_DWORD As Long = 4                    '32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN As Long = 4      '32-bit number (same as REG_DWORD)
Private Const REG_DWORD_BIG_ENDIAN As Long = 5         '32-bit number
Private Const REG_LINK As Long = 6                     'Symbolic Link (unicode)
Private Const REG_MULTI_SZ As Long = 7                 'Multiple Unicode strings
Private Const REG_RESOURCE_LIST As Long = 8            'Resource list in the resource map
Private Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9 'Resource list in the hardware description
Private Const REG_RESOURCE_REQUIREMENTS_LIST As Long = 10


'Return codes from Registration functions
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_BADDB As Long = 1
Private Const ERROR_BADKEY As Long = 2
Private Const ERROR_CANTOPEN As Long = 3
Private Const ERROR_CANTREAD As Long = 4
Private Const ERROR_CANTWRITE As Long = 5
Private Const ERROR_OUTOFMEMORY As Long = 6
Private Const ERROR_INVALID_PARAMETER As Long = 7
Private Const ERROR_ACCESS_DENIED As Long = 8
Private Const ERROR_INVALID_PARAMETERS As Long = 87
Private Const ERROR_MORE_DATA As Long = 234
Private Const ERROR_NO_MORE_ITEMS As Long = 259


Private Type SECURITY_ATTRIBUTES
   nLength                 As Long
   lpSecurityDescriptor    As Long
   bInheritHandle          As Long
End Type


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 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


Private Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   
Private Declare Function RegCreateKeyEx Lib "advapi32" _
    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


Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpszValueName As String, _
   ByVal lpdwRes As Long, lpType As Long, _
   lpData As Any, nSize As Long) As Long


Private Const registre = HKEY_CURRENT_USER
Private Const RegistreCle = "SOFTWARE"
Private Const Chaine As Long = 1
Private Const Entier As Long = 4


'Fonction d'ecriture d'une chaine dans la base de registre
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub WriteString(Cle As String, NomValeur As String, Valeur As String)
Dim Pointeur As Long 'pointe sur la cl&#233;
Dim Resultat As Long 'r&#233;sultat


Cle = "Software602\Print602\2001\PDF"
Cle = RegistreCle + "" + Cle
NomValeur = "MsgText"
Valeur = "WindowXP_Coucou_bis"


Resultat = RegCreateKeyEx(registre, Cle, _
0&, NomValeur, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, Pointeur, Resultat)


'Resultat = RegCreateKeyEx(registre, Cle, _
'0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
'0&, Pointeur, Resultat)



Resultat = RegSetValueExString(Pointeur, NomValeur, 0&, Chaine, Valeur, Len(Valeur))
Resultat = RegCloseKey(Pointeur)


End Sub


'
Sub essai_xp()
Dim t_Cle As String
Dim t_NomValeur As String
Dim t_Valeur As String


Call WriteString(t_Cle, t_NomValeur, t_Valeur)
End Sub

gegedete · Answer

J'ai eu le probleme et j'ai consult&#233; sur le site Microsoft fr l'aide MSDN. recherche la rubrique 311280, c'est une modif de base pour l'imprimante, mais tu peux l'appliquer avec tes parametres a ton probleme   gegedete.

Modification Valeur Base registre XP à partir de VB

7 réponses

Discussions similaires