Fonction pour écrire un DWORD dans la base de registre avec VB6

Fonction pour écrire un DWORD dans la base de registre avec VB6 - VB/VBA/VBS - Programmation

Marsh Posté le 25-03-2007 à 11:27:55    

Après avoir pas mal galéré j'ai finalement trouvé comment écrire un numérique DWORD dans une clef de la base de registre en n'utilisant que les fonctions API.
Si l'écriture d'un string ne m'avait jamais posé de problème, en revanche l'écriture de numérique était problématique et quand je vérifiais avec Regedit, je ne retrouvais jamais "mes petits".  
Mes recherches sur le Web ne m'ayant jamais complètement satisfait, j'ai mis au point la fonction ci-dessous qui intéressera peut-être certains d'entre-vous ?
 
'Déclarations :
Declare Function RegCreateKey& Lib "advapi32.dll" Alias "RegCreateKeyA" _
 (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long)
Declare Function RegSetValueEx& Lib "advapi32.dll" Alias "RegSetValueExA" _
 (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
 ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long)
Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey As Long)
 
'Constante :
Const REG_DWORD = 4  
 
Sub RegSetNum(RacineClef&, ByVal CheminClef$, ByVal Nom$, ByVal Donnee& )
    'écrit la valeur numérique Donnee& dans la base de registre
    Dim HandleCle&, X&
    Dim DonneeHexa$, Dword$, I%
     
    'création et/ou ouverture de la clef :
    X& = RegCreateKey&(RacineClef&, CheminClef$, HandleCle& )
     
    'Convertit Donnee& en hexadécimal :
    DonneeHexa$ = Hex(Donnee& )
    'Formate DonneeHexa$ sur 4 octets :
    DonneeHexa$ = Right$("0000000" & DonneeHexa$, 8)
    'Fabrique la chaine DWORD de 4 octets :
    For I% = 1 To 7 Step 2
        Dword$ = Chr$("&H" & Mid$(DonneeHexa$, I%, 2)) & Dword$
    Next I%
    'écrit le DWORD dans la clef :
    X& = RegSetValueEx&(HandleCle&, Nom$, 0&, REG_DWORD, Dword$, 4)
     
    'fermeture de la clef :
    X& = RegCloseKey&(HandleCle& )
 
End Sub


Message édité par vieuxloup le 25-03-2007 à 13:01:54
Reply

Marsh Posté le 25-03-2007 à 11:27:55   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed