Gestion du registre

Partagez votre expérience de PureBasic avec les autres utilisateurs.
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Gestion du registre

Message par lionel_om »

Je poste ici car je ne trouve pas le code qui j'ai modifié.
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$, "")
Si vous avez des suggestions pour de nouvelles fonctions/ ou des bugs, n'hésitez pas à me le faire remarquer... :lol:
Dernière modification par lionel_om le mer. 17/août/2005 6:25, modifié 1 fois.
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

sympa comme code ^^
pour la fonctrion unsplitbidule, tu peux prendre modèle sur le php, split/glue au lieu de split/unsplit

Dri ;)
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Message par lionel_om »

Oki, j'arrangerai ça.
Par contre j'ai un problème.

J'essaye de créer ma première UserLib avec ce code (via TailBite). J'ai donc remplacé tous les Procedure en ProcedureDLL. Mais les fonctions :
* CountRegSubKey()
* CountRegSubValue()
font planter le programme sans aucun message d'erreur ou d'avertissement (le code suivant ces appels est annulé :?: )

Si qq1 peu m'aider ! :cry:


EDIT :
J'ai trouvé le pb : ListRegSubKey() retourne un caractère bizarre depuis la procedure CountRegSubKey(), donc la procedure tourne infiniment... :cry: :cry: A l'aide SVP !!!
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

J'ai trouvé le pb : ListRegSubKey() retourne un caractère bizarre depuis la procedure CountRegSubKey(), donc la procedure tourne infiniment... Crying or Very sad Crying or Very sad A l'aide SVP !!!
si le code est toujour s le meme tu peut pas rajouter un "If"
pour le filtrer ce code ? ; enfin je dit ça , mais faut avouer que je sais meme
pas ce qu'est "CountRegSubKey()"

mais bon si c'est un code renvoyé qui correspond pas , ben fait le correspondre avec un "if" :?
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

2 choses

ListSubKey.s est une chaîne locale, elle n'existe qu'à partir du moment ou une valeur lui a été attribuée, que cette valeur soit nulle ou n'importe qu'elle chaîne < 64 Ko

avec le code suivant

Code : Tout sélectionner

  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
si GetHandle est différent de ERROR_SUCCESS la 1ere fois, tu retournes la chaîne ListSubKey qui n'existe pas.

Voici le code corrigé

Code : Tout sélectionner

    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)
  Else
      ListSubValue = ""
  EndIf
  ProcedureReturn ListSubValue
qui permet de définir la variable car PB va allouer de la place seulement si c'est necessaire donc seulement si on attribue une chaîne à la variable; c'est comme ça que travaille PB aujourd'hui, cela a déjà été longuement débattu sur le forum anglais et peut-être même sur le forum fr.

Autre chose, pour avoir un code qui marche sur toutes les OS WINDOWS, voici ce que dit la doc MS sur la taille des éléments du registre. A regarder de près pour adapter le code
Registry Element Size Limits

The following are the size limits for the various registry elements.

The maximum size of a key name is 255 characters.
The maximum size of a value name is as follows:
Windows XP, Windows .NET Server 2003 family: 16383 characters
Windows 2000: 260 ANSI characters or 16383 Unicode characters.
Windows 95/98/Me: 255 characters
Long values (more than 2048 bytes) should be stored as files with the file names stored in the registry. This helps the registry perform efficiently. The maximum size of a value is as follows:
Windows NT/2000/XP: Available memory.
Windows 95/98/Me: 16,300 bytes. There is a 64K limit for the total size of all values of a key.
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Message par lionel_om »

En fait ListRegSubKey() et CountRegSubKey(() vont ensemble (tout comme
ListRegSubValue() et CountRegSubValue()).
La fonction List...() renvoi la valeur d'une sous-clé (réciproquement valeur) d'une clé passée ne paramètre et la fonction Count..() renvoi leur nombre.
(C'est un peu comme les StringField() et les CountString()).

Pour les 'If', je ne voit pas ce que tu veux dire... Tu peux tester le code ci-dessus, il marche, mais il plante juste en Lib. Rassurez-vous, il ne vas aps dégrader votre registre.

Le problème vient d'ici :
lors de l'appel de Count...(), la fonction List...() renvoi un caractère ASCII bizarre. Pourtant en rajoutant un "Debug ListSubKey" (ou "Debug ListSubValue"), la valeur affichée est la bonne. Mais elle n'est plus la même dans le fonction Count..() (J'espère me faire comprendre...)

J'ai essayé en déclarant une globale : Reg_ListVal, puis rajouté "Reg_ListVal = ListSubKey", avant le "ProcedureReturn ListSubKey"
Puis j'ai remplacé la procédure CountRegSubKey() par :

Code : Tout sélectionner

Procedure.l CountRegSubKey(regKey.s, ComputerName.s) 
  Protected i.l
  i = 0
  ListRegSubKey(regKey, i, ComputerName)
  While Reg_ListVal <> ""
    i + 1
    ListRegSubKey(regKey, i, ComputerName)
  Wend
  ProcedureReturn i
EndProcedure
Et cette fois ci ca marche. Mais j'ai pas envie de passer par des Global (le moins c'est le mieux)...

Merci d'avance pour votre aide :?:

PS: j'ai modifié mon code (ptt Bug trouvé)
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Fait un test avec la ligne suivante

While ListRegSubValue(regKey, i, ComputerName) <> ""

ou passe par une variable locale

var$ = ListRegSubValue(regKey, i, ComputerName) <> ""
while var$


Je que j'ai corrigé dans le post précédant reste valable
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Message par lionel_om »

Non, j'ai déjà essayé ça.
J'ai fais un

Code : Tout sélectionner

Debug ListRegSubValue(regKey, i, ComputerName)
et il me renvoi un caractère ASCII bizarre.
Je n'y comprend rien.

De plus que le bug n'apparait que dans les procedure Count...()
Quand on utilise cette fonction dans le programme principal, aucune erreur ne se produit... :? :?:
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

lionel_om a écrit :Non, j'ai déjà essayé ça.
J'ai fais un

Code : Tout sélectionner

Debug ListRegSubValue(regKey, i, ComputerName)
et il me renvoi un caractère ASCII bizarre.
Je n'y comprend rien.

De plus que le bug n'apparait que dans les procedure Count...()
Quand on utilise cette fonction dans le programme principal, aucune erreur ne se produit... :? :?:
Je ne sais pas si on se comprend car ta réponse est évasive (ton débug ne correspond pas au code suivant )

Code : Tout sélectionner

 While ListRegSubValue(regKey, i, ComputerName) <> ""

ou passe par une variable locale

var$ = ListRegSubValue(regKey, i, ComputerName) <> ""
while var$ 
tu as essayé ou non le code ci-dessus ?

Il y a certaines commandes (je n'ai plus en tête) qui retournent une string, et si on ne passe pas par une variable pour récupérer le résultat, ça ne fonctionne pas correctement, c'est pour ça que je te demande d'essayer avec une variable.
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Message par lionel_om »

J'ai bien essayé le code ci dessus, mais il ne marche pas...

EDIT : Le code ASCII renvoyé est 8
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Répondre