pneau
Messages postés
258
Date d'inscription
mercredi 21 avril 2004
Statut
Membre
Dernière intervention
27 octobre 2010
5
8 nov. 2007 à 13:18
pour ce qui est de chercher dans Active Directory, encore faut il que ton appli soit publié dans ActiveDirectory.
Pour ma part, je te conseille plus d'aller chercher dans le registre Windows.
Trouves ci dessous une classe que j'utilise régulièrement pour lire / écrire dans le registre.
A+
Public Enum RegSection
HK_Class_Root
HK_Local_Machine
HK_Current_User
HK_Current_Config
HK_Users
End Enum
Public Enum TypeVal
TYPE_REG_SZ
TYPE_DWORD
TYPE_MULTI_SZ
End Enum
'Constantes pour la connection à la base de registre
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
' Registry Type Values...
Const REG_OPTION_RESERVED = 0 ' Parameter is reserved
Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted
Const REG_OPTION_CREATE_LINK = 2 ' Created key is a symbolic link
Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const REG_DWORD = 4 ' 32-bit number
Const REG_LINK = 6 ' Symbolic Link (unicode)
Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Const REG_RESOURCE_LIST = 8 ' Resource list in the resource map
Const REG_FULL_RESOURCE_DESCRIPTOR = 9 ' Resource list in the hardware description
Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Const REG_CREATED_NEW_KEY = &H1 ' New Registry Key created
Const REG_OPENED_EXISTING_KEY = &H2 ' Existing Key opened
Const REG_WHOLE_HIVE_VOLATILE = &H1 ' Restore whole hive volatile
Const REG_REFRESH_HIVE = &H2 ' Unwind changes to last flush
Const REG_NOTIFY_CHANGE_NAME = &H1 ' Create or delete (child)
Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Const REG_NOTIFY_CHANGE_LAST_SET = &H4 ' Time stamp
Const REG_NOTIFY_CHANGE_SECURITY = &H8
Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
' Reg Key Security Options
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
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_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))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
'Examples d'appel de chaque fonction:
'
'CreateNewKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"
'SetKeyValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test", "Testing, Testing", REG_SZ
'MsgBox QueryKeyValue(HKEY_CURRENT_USER, "TestKey\SubKey1", "Test")
'DeleteKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"
'DeleteKeyValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test"
'
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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, ByVal lpSecurityAttributes As Long, 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 ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private 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
Private 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
Private 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
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 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 Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Private 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, lpData As Any, lpcbData As Long) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (PtrDest As Any, ByteSrc As Any, ByVal length As Long)
Private RegErr As Long
Private Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
End Function
Private Function DeleteKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
Private 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
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
Private 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
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
Case REG_SZ, REG_MULTI_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
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
Private Sub CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
If lRetVal <> 0 Then
RegErr = Err.Number
End If
RegCloseKey (hNewKey)
End Sub
Private Sub SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Sub
Private Function QueryKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryKeyValue = vValue
RegCloseKey (hKey)
End Function
Public Sub EraseKey(Section As RegSection, Cle As String)
Dim SubKey As String
Dim hKey As Long
Select Case Section
Case HK_Class_Root
hKey = HKEY_CLASSES_ROOT
Case HK_Current_User
hKey = HKEY_CURRENT_USER
Case HK_Local_Machine
hKey = HKEY_LOCAL_MACHINE
Case HK_Users
hKey = HKEY_USERS
Case HK_Current_Config
hKey = HKEY_CURRENT_CONFIG
Case Else
'End
End Select
SubKey = Cle & Chr(0)
DeleteKey hKey, SubKey
End Sub
Public Sub EraseKeyValue(Section As RegSection, Cle As String, Entree As String)
Dim SubKey As String
Dim hKey As Long
Dim SubEntry As String
Select Case Section
Case HK_Class_Root
hKey = HKEY_CLASSES_ROOT
Case HK_Current_User
hKey = HKEY_CURRENT_USER
Case HK_Local_Machine
hKey = HKEY_LOCAL_MACHINE
Case HK_Users
hKey = HKEY_USERS
Case HK_Current_Config
hKey = HKEY_CURRENT_CONFIG
End Select
SubKey = Cle & Chr(0)
SubEntry = Entree & Chr(0)
DeleteKeyValue hKey, SubKey, SubEntry
End Sub
Public Property Get RegistryKeyValue(Section As RegSection, _
Cle As String, _
Entree As String, _
Optional TypeVal As TypeVal) As Variant
Dim retval As Variant
Dim SubKey As String
Dim hKey As Long
Dim SubEntry As String
Dim RegType As Long
Select Case Section
Case HK_Class_Root
hKey = HKEY_CLASSES_ROOT
Case HK_Current_User
hKey = HKEY_CURRENT_USER
Case HK_Local_Machine
hKey = HKEY_LOCAL_MACHINE
Case HK_Users
hKey = HKEY_USERS
Case HK_Current_Config
hKey = HKEY_CURRENT_CONFIG
End Select
SubKey = Cle & Chr(0)
SubEntry = Entree & Chr(0)
retval = QueryKeyValue(hKey, SubKey, SubEntry) If Right(retval, 1) Chr(0) Then retval Left(retval, Len(retval) - 1)
RegistryKeyValue = retval
End Property
Public Property Let RegistryKeyValue(Section As RegSection, _
Cle As String, _
Entree As String, _
Optional TypeVal As TypeVal = TYPE_REG_SZ, _
Valeur As Variant)
Dim retval As Variant
Dim SubKey As String
Dim hKey As Long
Dim SubEntry As String
Dim RegType As Long
Dim sValue As String
Dim WValue As Long
Select Case Section
Case HK_Class_Root
hKey = HKEY_CLASSES_ROOT
Case HK_Current_User
hKey = HKEY_CURRENT_USER
Case HK_Local_Machine
hKey = HKEY_LOCAL_MACHINE
Case HK_Users
hKey = HKEY_USERS
Case HK_Current_Config
hKey = HKEY_CURRENT_CONFIG
Case Else
'End
End Select
SubKey = Cle & Chr(0)
SubEntry = Entree & Chr(0)
Select Case TypeVal
Case TYPE_REG_SZ
RegType = REG_SZ
sValue = Valeur & Chr(0)
SetKeyValue hKey, SubKey, SubEntry, sValue, RegType
Case TYPE_DWORD
RegType = REG_DWORD
WValue = Val(Valeur)
SetKeyValue hKey, SubKey, SubEntry, WValue, RegType
Case TYPE_MULTI_SZ
RegType = REG_MULTI_SZ
sValue = Valeur & Chr(0)
SetKeyValue hKey, SubKey, SubEntry, sValue, RegType
End Select
End Property
Public Sub AddNewRegistryKey(Section As RegSection, Cle As String)
Dim retval As Variant
Dim SubKey As String
Dim hKey As Long
Select Case Section
Case HK_Class_Root
hKey = HKEY_CLASSES_ROOT
Case HK_Current_User
hKey = HKEY_CURRENT_USER
Case HK_Local_Machine
hKey = HKEY_LOCAL_MACHINE
Case HK_Users
hKey = HKEY_USERS
Case HK_Current_Config
hKey = HKEY_CURRENT_CONFIG
Case Else
'End
End Select
SubKey = Cle & Chr(0)
CreateNewKey hKey, SubKey
End Sub
Public Property Get RegistryError() As Long
RegistryError = RegErr
End Property
Public Function EnumKeyValue(Section As RegSection, _
Cle As String) As String
Dim hKey As Long
Dim lValueLength As Long
Dim lNameLength As Long
Dim sTampon As String
Dim sValue As String
Dim lType As Long
Dim ValueIndex As Long
Dim lpData(65535) As Byte
Dim sReturnValue As String
Dim sEnreg As String
Dim sCleEnreg As String
Dim I As Long
On Error GoTo errEnumKeyValue
Select Case Section
Case HK_Class_Root
hKey = HKEY_CLASSES_ROOT
Case HK_Current_User
hKey = HKEY_CURRENT_USER
Case HK_Local_Machine
hKey = HKEY_LOCAL_MACHINE
Case HK_Users
hKey = HKEY_USERS
Case HK_Current_Config
hKey = HKEY_CURRENT_CONFIG
Case Else
'End
End Select
RegOpenKeyEx hKey, Cle, 0, KEY_ALL_ACCESS, hKey
Do
lNameLength = 1024
lValueLength = 1024
sTampon = Space(lNameLength)
If RegEnumValue(hKey, ValueIndex, sTampon, lNameLength, 0, lType, lpData(0), lValueLength) Then
Exit Do
End If' If Trim(dumString) vbNullChar Then Default True
sValue = Space(lValueLength)
sCleEnreg = Trim(sTampon)
Debug.Print sCleEnreg
RtlMoveMemory ByVal sValue, lpData(0), lValueLength
ValueIndex = ValueIndex + 1
If sReturnValue <> "" Then
sReturnValue = sReturnValue & ";;" & sCleEnreg & sValue
Else
sReturnValue = sCleEnreg & sValue
End If
Loop
EnumKeyValue = sReturnValue
Exit Function
errEnumKeyValue:
MsgBox "Erreur pendant la lecture du registre" & vbCrLf & _
Err.Number & " - " & Err.Description, vbCritical, "Erreur"
End Function
Pat