Je vous propose un code pour gérer les lectures/écritures/suppressions dans le registre. (jusqu'à là rien de bien nouveau).
Mais ce code permet de directement entrer les valeurs de la sorte :
CreateRegKey("HKEY_CLASSES_ROOT\*\Test\") au lieu de passer par CreateRegKey(#HKEY_CLASSES_ROOT, "*\Test\", ...).
Voici la librairie : (nom : Registre.pb)
Code : Tout sélectionner
; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=1378&highlight=
; Author: Manne
; Date: 16. June 2003 (updated on 26. July 2003)
; Modified By: lionel_om, alias b!g b@$s
Structure Reg
TopKey.l
KeyName.s
KeyValue.s
EndStructure
; -------------------------
;- Gestion des TopKey
; -------------------------
Procedure TopKeyToLong(s.s)
s = UCase(s)
Select s
Case "HKEY_CLASSES_ROOT"
ProcedureReturn #HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
ProcedureReturn #HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
ProcedureReturn #HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
ProcedureReturn #HKEY_USERS
Case "HKEY_CURRENT_CONFIG"
ProcedureReturn #HKEY_CURRENT_CONFIG
Default
ProcedureReturn 0
EndSelect
EndProcedure
Procedure.s TopKeyToStr(s.l)
Select s
Case #HKEY_CLASSES_ROOT
ProcedureReturn "HKEY_CLASSES_ROOT"
Case #HKEY_CURRENT_USER
ProcedureReturn "HKEY_CURRENT_USER"
Case #HKEY_LOCAL_MACHINE
ProcedureReturn "HKEY_LOCAL_MACHINE"
Case #HKEY_USERS
ProcedureReturn "HKEY_USERS"
Case #HKEY_CURRENT_CONFIG
ProcedureReturn "HKEY_CURRENT_CONFIG"
Default
ProcedureReturn ""
EndSelect
EndProcedure
; -----------------------------
;- Test si le type est bon
; -----------------------------
;Renvoi 'Vrai' si la valeur passée est bien un type de KeyValue
Procedure.l IsKeyValueType(type.l)
Select type
Case #REG_SZ
Case #REG_DWORD
Case #REG_BINARY
Case #REG_MULTI_SZ
Case #REG_EXPAND_SZ
Default
ProcedureReturn #False
EndSelect
ProcedureReturn #True
EndProcedure
; -------------------------
;- Ini d une Key
; -------------------------
Procedure IniRegKey(*reg.Reg)
If *reg
*reg\TopKey = 0
*reg\KeyName = ""
*reg\KeyValue = ""
EndIf
EndProcedure
; -------------------------
;- Convertion Str <--> Reg
; -------------------------
Procedure SplitRegKey(key$, *reg.Reg)
Protected tmp$
IniRegKey(*reg)
key$ = Trim(key$)
If Right(key$, 1) = "@"
key$ = Left(key$, Len(key$)-1)
EndIf
tmp$ = StringField(key$, 1, "\")
*reg\TopKey = TopKeyToLong(tmp$)
If *reg\TopKey
tmp$ = ReplaceString(key$, tmp$ +"\", "")
*reg\KeyValue = StringField(tmp$, CountString(tmp$, "\")+1, "\")
If Len(*reg\KeyValue)
tmp$ = ReplaceString(tmp$, *reg\KeyValue, "")
EndIf
If Right(tmp$,1)="\"
tmp$ = Left(tmp$, Len(tmp$)-1)
EndIf
*reg\KeyName = tmp$
EndIf
EndProcedure
Procedure.s UnSplitRegKey(*reg.Reg)
Protected key$
If *reg
key$ = TopKeyToStr(*reg\TopKey)
If key$
key$ + "\" + *reg\KeyName + *reg\KeyValue
ProcedureReturn key$
EndIf
EndIf
ProcedureReturn ""
EndProcedure
; -------------------------
;- Les GET pour un obj Reg
; -------------------------
Procedure.l GetTopKey(*reg.Reg)
If *reg
ProcedureReturn *reg\TopKey
EndIf
EndProcedure
Procedure.s GetKeyName(*reg.Reg)
If *reg
ProcedureReturn *reg\KeyName
EndIf
EndProcedure
Procedure.s GetKeyValue(*reg.Reg)
If *reg
ProcedureReturn *reg\KeyValue
EndIf
EndProcedure
Procedure DebugRegKey(*reg.Reg)
If *reg
Debug *reg\TopKey
Debug *reg\KeyName
Debug *reg\KeyValue
Else
Debug "Adresse incorrecte"
EndIf
EndProcedure
; -------------------------------------
;- Initialise le GetHandle et le hKey
; -------------------------------------
Procedure.l IniForQueryToRegKey(*reg.Reg, ComputerName.l, hKey.l, lhRemoteRegistry.l)
If Left(*reg\KeyName, 1) = "\"
*reg\KeyName = Right(*reg\KeyName, Len(*reg\KeyName) - 1)
EndIf
If PeekS(ComputerName) = ""
ProcedureReturn RegOpenKeyEx_(*reg\TopKey, *reg\KeyName, 0, #KEY_ALL_ACCESS, hKey)
Else
lReturnCode = RegConnectRegistry_(PeekS(ComputerName), *reg\TopKey, lhRemoteRegistry)
ProcedureReturn RegOpenKeyEx_(PeekL(lhRemoteRegistry), *reg\KeyName, 0, #KEY_ALL_ACCESS, hKey)
EndIf
EndProcedure
; -------------------------------------
;- Recuperation de la valeur d une cle
; -------------------------------------
Procedure.s GetRegKeyStrValue(regKey.s, ComputerName.s)
Protected reg.Reg
Protected GetHandle.l, hKey.l, lpData.s, lpcbData.l
Protected lType.l, lReturnCode.l, lhRemoteRegistry.l, GetValue.s
SplitRegKey(regKey, reg.Reg)
GetHandle = IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry)
GetValue = ""
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
lpData = Space(255)
GetHandle = RegQueryValueEx_(hKey, reg\KeyValue, 0, @lType, @lpData, @lpcbData)
Select lType
; <-- String -->
Case #REG_SZ
If GetHandle = #ERROR_SUCCESS
GetValue = Left(lpData, lpcbData - 1)
EndIf
; <-- Long -->
Case #REG_DWORD
If GetHandle = #ERROR_SUCCESS
GetValue = Str(PeekL(lpData))
EndIf
EndSelect
EndIf
RegCloseKey_(hKey)
ProcedureReturn GetValue
EndProcedure
Procedure.l GetRegKeyIntValue(regKey.s, ComputerName.s)
ProcedureReturn Val(GetRegKeyStrValue(regKey, ComputerName))
EndProcedure
; -----------------------------------
;- Changement de la valeur d'une clé
; -----------------------------------
; Crée une valeur si la clé n'existe pas
; Renvoi #True en cas de succès,
; faux si la clé spécifiée est incorrecte ou que le "dossier" n'existe pas
Procedure.l SetRegKeyValue(regKey.s, vValue.s, ComputerName.s)
Protected reg.Reg
Protected GetHandle.l, hKey.l, lpcbData.l, ReturnValue.l
Protected lpData.s, lReturnCode.l, lhRemoteRegistry.l
SplitRegKey(regKey, reg.Reg)
GetHandle = IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry)
ReturnValue = #False
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
lpData = Space(255)
GetHandle = RegQueryValueEx_(hKey, reg\KeyValue, 0, @lType, @lpData, @lpcbData)
;lpcbData = 255: lpData = Space(255) ; <-- Ci Bug enlever ce commentaire
If IsKeyValueType(lType)=#False ; La clé n'existe pas
If Str(Val(vValue)) = Trim(vValue)
lType = #REG_DWORD
Else
lType = #REG_SZ
EndIf
EndIf
ReturnValue = #True
Select lType
; <-- Long -->
Case #REG_DWORD
lValue = Val(vValue)
RegSetValueEx_(hKey, reg\KeyValue, 0, #REG_DWORD, @lValue, 4)
; <-- String -->
Case #REG_SZ
RegSetValueEx_(hkey, reg\KeyValue, 0, #REG_SZ, @vValue, Len(vValue) + 1)
Default
ReturnValue = #False
EndSelect
EndIf
RegCloseKey_(hKey)
ProcedureReturn ReturnValue
EndProcedure
; ----------------------------------------
;- Renvoi la sous-cle a l indice specifie
; ----------------------------------------
; Les indices commences à 0
Procedure.s ListRegSubKey(regKey.s, Index.l, ComputerName.s)
Protected GetHandle.l, hKey.l, lpName.s, lpcbName.l, ListSubKey.s
Protected lpftLastWriteTime.FILETIME, lReturnCode.l, lhRemoteRegistry.l
Protected reg.Reg
PathAddBackslash_(regKey)
SplitRegKey(regKey, reg.Reg)
GetHandle = IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry)
If GetHandle = #ERROR_SUCCESS
lpcbName = 255
lpName = Space(255)
GetHandle = RegEnumKeyEx_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, @lpftLastWriteTime)
If GetHandle = #ERROR_SUCCESS
ListSubKey = Left(lpName, lpcbName)
Else
ListSubKey = ""
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn ListSubKey
EndProcedure
Procedure.l CountRegSubKey(regKey.s, ComputerName.s)
Protected i.l
i = 0
While ListRegSubKey(regKey, i, ComputerName)
i + 1
Wend
ProcedureReturn i
EndProcedure
; ------------------
;- Supprime une cle
; ------------------
Procedure.b DeleteRegKeyValue(regKey.s, ComputerName.s)
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, DeleteValue.b
Protected reg.Reg
SplitRegKey(regKey, reg.Reg)
GetHandle = IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry)
If GetHandle = #ERROR_SUCCESS
GetHandle = RegDeleteValue_(hKey, @reg\KeyValue)
If GetHandle = #ERROR_SUCCESS
DeleteValue = #True
Else
DeleteValue = #False
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn DeleteValue
EndProcedure
; --------------------
;- Creation d une cle
; --------------------
Procedure.b CreateRegKey(regKey.s, ComputerName.s)
Protected hNewKey.l, lpSecurityAttributes.SECURITY_ATTRIBUTES
Protected GetHandle.l, lReturnCode.l, lhRemoteRegistry.l, CreateKey.b
Protected reg.Reg
PathAddBackslash_(regKey)
SplitRegKey(regKey, reg.Reg)
If Left(reg\KeyName, 1) = "\"
reg\KeyName = Right(reg\KeyName, Len(reg\KeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegCreateKeyEx_(reg\TopKey, reg\KeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle)
Else
lReturnCode = RegConnectRegistry_(ComputerName, reg\TopKey, @lhRemoteRegistry)
GetHandle = RegCreateKeyEx_(lhRemoteRegistry, reg\KeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle)
EndIf
If GetHandle = #ERROR_SUCCESS
GetHandle = RegCloseKey_(hNewKey)
CreateKey = #True
Else
CreateKey = #False
EndIf
ProcedureReturn CreateKey
EndProcedure
; ------------------
;- Supprime une cle
; ------------------
Procedure.b DeleteRegKey(regKey.s, ComputerName.s)
Protected GetHandle.l, lReturnCode.l, lhRemoteRegistry.l, DeleteKey.b
Protected reg.Reg
PathAddBackslash_(regKey)
SplitRegKey(regKey, reg.Reg)
If Left(reg\KeyName, 1) = "\"
reg\KeyName = Right(reg\KeyName, Len(reg\KeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegDeleteKey_(reg\TopKey, reg\KeyName)
Else
lReturnCode = RegConnectRegistry_(ComputerName, reg\TopKey, @lhRemoteRegistry)
GetHandle = RegDeleteKey_(lhRemoteRegistry, reg\KeyName)
EndIf
If GetHandle = #ERROR_SUCCESS
DeleteKey = #True
Else
DeleteKey = #False
EndIf
ProcedureReturn DeleteKey
EndProcedure
; -------------------------------------------------
;- Renvoi les valeurs des cles a l indice specifie
; -------------------------------------------------
; Les indices commences à 0
Procedure.s ListRegSubValue(regKey.s, Index.l, ComputerName.s)
Protected GetHandle.l, hKey.l, dwIndex.l, lpName.s, lpcbName.l, ListSubValue.s
Protected lhRemoteRegistry.l, lReturnCode.l, lpftLastWriteTime.FILETIME
Protected reg.Reg
PathAddBackslash_(regKey)
SplitRegKey(regKey, reg.Reg)
GetHandle = IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry)
If GetHandle = #ERROR_SUCCESS
lpcbName = 255
lpName = Space(255)
GetHandle = RegEnumValue_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, 0)
If GetHandle = #ERROR_SUCCESS
ListSubValue = Left(lpName, lpcbName)
Else
ListSubValue = ""
EndIf
RegCloseKey_(hKey)
EndIf
ProcedureReturn ListSubValue
EndProcedure
Procedure.l CountRegSubValue(regKey.s, ComputerName.s)
Protected i.l
i = 0
While ListRegSubValue(regKey, i, ComputerName)
i + 1
Wend
ProcedureReturn i
EndProcedure
; --------------------------------------------
;- Test l existance d une cle ou d une valeur
; --------------------------------------------
Procedure.l IsRegKey(regKey.s, ComputerName.s)
Protected hKey.l, lhRemoteRegistry.l, lReturnCode.l, KeyExists.b
Protected reg.Reg
PathAddBackslash_(regKey)
SplitRegKey(regKey, reg.Reg)
If IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry) = #ERROR_SUCCESS
KeyExists = #True
Else
KeyExists = #False
EndIf
RegCloseKey_(hKey)
ProcedureReturn KeyExists
EndProcedure
Procedure.l IsSubValue(regKey.s, ComputerName.s)
Protected hKey.l, lhRemoteRegistry.l, lReturnCode.l, KeyExists.b
Protected GetHandle.l, lpcbData.l, lpData.s
Protected reg.Reg
SplitRegKey(regKey, reg.Reg)
GetHandle = IniForQueryToRegKey(reg, @ComputerName, @hKey, @lhRemoteRegistry)
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
lpData = Space(255)
GetHandle = RegQueryValueEx_(hKey, reg\KeyValue, 0, @lType, @lpData, @lpcbData)
If IsKeyValueType(lType) = #False
lType = #False
EndIf
Else
lType = #False
EndIf
RegCloseKey_(hKey)
ProcedureReturn lType
EndProcedure
Et voic un fichier de test :
Code : Tout sélectionner
IncludeFile "Registre.pb"
Procedure Test_IsRegKey(key$)
Debug key$
If IsRegKey(key$, "")
Debug " > Clé existante"
Else
Debug " >> Clé non existante <<"
EndIf
EndProcedure
Procedure Test_IsSubValue(key$)
Debug key$
If IsSubValue(key$, "")
Debug " > Valeur existante"
Else
Debug " >> Valeur non existante <<"
EndIf
EndProcedure
Procedure Test_RegSubKey(key$)
Debug "Liste des sous-clés de : " + key$
Debug "**********************"
i.l
For i = 0 To CountRegSubKey(key$, "")-1
Debug ListRegSubKey(key$, i, "")
Next i
EndProcedure
Procedure Test_RegSubValue(key$)
PathAddBackslash_(key$)
Debug "Liste des valeurs de : " + key$
Debug "********************"
i.l
For i = 0 To CountRegSubValue(key$, "")-1
sVal$ = ListRegSubValue(key$, i, "")
Debug sVal$
Select IsSubValue(key$+sVal$, "")
Case #REG_SZ
Debug " > " + GetRegKeyStrValue(key$+sVal$, "") + " (type chaîne)"
Case #REG_DWORD
Debug " > " + Str(GetRegKeyIntValue(key$+sVal$, "")) + " (type long)"
Default
Debug " > Type non génré ou valeur inexistante"
EndSelect
Next i
EndProcedure
; Test si une clé existe
Test_IsRegKey("HKEY_CLASSES_ROOT\*\aa2\")
Test_IsRegKey("HKEY_CLASSES_ROOT\.mp3\")
Debug " "
; Test si une valeur existe (DWORD ou SZ)
Test_IsSubValue("HKEY_CLASSES_ROOT\mp3\aa2\")
Test_IsSubValue("HKEY_CLASSES_ROOT\*\aa2")
Test_IsSubValue("HKEY_CLASSES_ROOT\*\InfoTip")
Debug " "
; Affiche toutes les sous-clés d'une clé
Test_RegSubKey("HKEY_CLASSES_ROOT\*\")
Debug " "
; Affiche toutes les valeurs d'une clé
Test_RegSubValue("HKEY_CLASSES_ROOT\*\")
Debug " "
; Création d'une valeur DWORD
val1$ = Str(777)
sVal1$ = "HKEY_CLASSES_ROOT\*\aa1"
Debug "Ajout d'une valeur DWORD :"
Debug "************************"
Debug val1$ + " -> " + sVal1$
Debug SetRegKeyValue(sVal1$, val1$, "")
Debug " "
; Création d'une valeur SZ
val2$ = "Une Chaine"
sVal2$ = "HKEY_CLASSES_ROOT\*\aa2"
Debug "Ajout d'une valeur SZ :"
Debug "*********************"
Debug val2$ + " -> " + sVal2$
Debug SetRegKeyValue(sVal2$, val2$, "")
Debug " "
; Ré-Affiche toutes les sous-clés d'une clé
; (pour prouver que l'ajout à marché)
Test_RegSubValue("HKEY_CLASSES_ROOT\*\")
Debug " "
; Création d'une clé
sKey$ = "HKEY_CLASSES_ROOT\*\Test\"
Debug "Ajout d'une clé :"
Debug "***************"
Debug "Création de : " + sKey$
Debug CreateRegKey(sKey$, "")
Debug " "
; Suppression de clé et de valeurs
Debug "Suppression :"
Debug "***********"
Debug DeleteRegKeyValue(sVal1$, "")
Debug DeleteRegKeyValue(sVal2$, "")
Debug DeleteRegKey(sKey$, "")
