Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 02 12 04:52:36

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

Base de registre

> LIRE ET ECRIRE DES CLÉS DANS LA BASE DE REGISTRE

LIRE ET ECRIRE DES CLÉS DANS LA BASE DE REGISTRE

Information sur la source

Note :

4,70 / 10

Catégorie :Base de registre Niveau :Expert Date de création :02/05/2002 Date de mise à jour :02/05/2002 15:51:56 Vu :11 203

Auteur : Tatar

Ecrire un message privé

Commentaire sur cette source (14)

Ajouter un commentaire et/ou une note

Description

Et voila mon deuxième code :-)

Décidemment aujourd'hui je suis en forme ;-)

Tous est dans le titre et le code. Je précide que le type de clé c'est par exemple HKeyCurrentUser, que l'adresse c'est ce qui vient derrière dans la base de registre et le nom....ben cela parle tous seul !

Source

Option Explicit
Dim lng As Long
Dim Buff As Long
'-------------------------------------------------------'
'ATTENTION : NE PAS METTRE DE \ AU DEBUT DU CHEMIN !!!!!'
'-------------------------------------------------------'
'-------------------------------------------------------'
'LAISSER VALEUR VIDE POUR LA CHAINE PAR DEFAUT '
'-------------------------------------------------------'
'Constantes correspondant aux cinq clés
'à 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
Public Const SW_SHOW = 1
Public Enum HCle
HKeyLocalMachine = 0
HKeyCurrentUser = 1
HKeyClassesRoot = 2
HKeyUsers = 3
HKeyDynamicData = 4
End Enum
'API nécessaires
'pour créer ou ouvrir une clé
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long
'pour supprimer une clé
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
'pour supprimer une valeur
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
'pour lire une valeur
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long
'pour fixer ou cré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, _
ByVal lpData As Any, _
ByVal cbData As Long) As Long
Public Function CreerCle(HK As HCle, Chemin As String) As Long
RegCreateKey HKConvert(HK), Chemin, lng
CreerCle = lng
End Function
Private Function HKConvert(HK As HCle) As Long
If HK = 2 Then HKConvert = HKEY_CLASSES_ROOT
If HK = 1 Then HKConvert = HKEY_CURRENT_USER
If HK = 0 Then HKConvert = HKEY_LOCAL_MACHINE
If HK = 3 Then HKConvert = HKEY_USERS
If HK = 4 Then HKConvert = HKEY_DYN_DATA
End Function
Public Function SupprCle(HK As HCle, Chemin As String)
RegDeleteKey HKConvert(HK), Chemin
End Function
Public Function DonnerValeur(HK As HCle, Chemin As String, Valeur As String, Donnee As String)
RegCreateKey HKConvert(HK), Chemin, lng
RegSetValueEx lng, Valeur, 0&, 1, Donnee, Len(Donnee) + 1
End Function
Public Function LireValeur(HK As HCle, Chemin As String, Valeur As String) As String
On Error GoTo erreur
Buff = 0
Buff = RegCreateKey(HKConvert(HK), Chemin, lng)
If Buff = 0 Then RegQueryValueEx lng, Valeur, 0&, 1, 0&, Buff
If Buff < 2 Then
LireValeur = ""
Exit Function
End If
LireValeur = String(Buff + 1, " ")
RegQueryValueEx lng, Valeur, 0&, 1, ByVal LireValeur, Buff
LireValeur = Left(LireValeur, Buff - 1)
'mettre a la place de form1.tag l'emplacement où vous voulez écrire la valeur de la clé lu
form1.Tag = LireValeur
Exit Function
erreur:
MsgBox "Configuration du port incorrect, impossible de lancer l'acquisition"
End Function
Public Function SupprValeur(HK As HCle, Chemin As String, Valeur As String)
Buff = 0
Buff = RegCreateKey(HKConvert(HK), Chemin, lng)
If Buff = 0 Then RegDeleteValue lng, ByVal Valeur
End Function
Public Sub Run(Parametre As String)
DonnerValeur type clé, "adresse clé", "nom clé", App.Path & "\" & App.EXEName & ".exe " & Parametre
End Sub
Public Function IsRun() As Boolean
If LireValeur(type clé, "adresse clé", "nom clé") <> "" Then IsRun = True Else IsRun = False
End Function
Public Sub DelRun()
SupprValeur Type clé, "adresse", "nom clé"
End Sub

Option Explicit

Dim lng As Long
Dim Buff As Long

'-------------------------------------------------------'
'ATTENTION : NE PAS METTRE DE \ AU DEBUT DU CHEMIN !!!!!'
'-------------------------------------------------------'

'-------------------------------------------------------'
'LAISSER VALEUR VIDE POUR LA CHAINE PAR DEFAUT            '
'-------------------------------------------------------'


'Constantes correspondant aux cinq clés
'à 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
Public Const SW_SHOW = 1
Public Enum HCle
    HKeyLocalMachine = 0
    HKeyCurrentUser = 1
    HKeyClassesRoot = 2
    HKeyUsers = 3
    HKeyDynamicData = 4
End Enum

'API nécessaires

'pour créer ou ouvrir une clé
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     phkResult As Long) As Long
     
'pour supprimer une clé
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String) As Long
     
'pour supprimer une valeur
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String) As Long
     
'pour lire une valeur
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     lpType As Long, _
     lpData As Any, _
     lpcbData As Long) As Long
     
'pour fixer ou cré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, _
     ByVal lpData As Any, _
     ByVal cbData As Long) As Long

Public Function CreerCle(HK As HCle, Chemin As String) As Long
RegCreateKey HKConvert(HK), Chemin, lng
CreerCle = lng
End Function

Private Function HKConvert(HK As HCle) As Long
If HK = 2 Then HKConvert = HKEY_CLASSES_ROOT
If HK = 1 Then HKConvert = HKEY_CURRENT_USER
If HK = 0 Then HKConvert = HKEY_LOCAL_MACHINE
If HK = 3 Then HKConvert = HKEY_USERS
If HK = 4 Then HKConvert = HKEY_DYN_DATA
End Function

Public Function SupprCle(HK As HCle, Chemin As String)
RegDeleteKey HKConvert(HK), Chemin
End Function

Public Function DonnerValeur(HK As HCle, Chemin As String, Valeur As String, Donnee As String)
RegCreateKey HKConvert(HK), Chemin, lng
RegSetValueEx lng, Valeur, 0&, 1, Donnee, Len(Donnee) + 1
End Function

Public Function LireValeur(HK As HCle, Chemin As String, Valeur As String) As String
On Error GoTo erreur
Buff = 0
Buff = RegCreateKey(HKConvert(HK), Chemin, lng)
If Buff = 0 Then RegQueryValueEx lng, Valeur, 0&, 1, 0&, Buff
If Buff < 2 Then
    LireValeur = ""
    Exit Function
End If
LireValeur = String(Buff + 1, " ")
RegQueryValueEx lng, Valeur, 0&, 1, ByVal LireValeur, Buff
LireValeur = Left(LireValeur, Buff - 1)
'mettre a la place de form1.tag l'emplacement où vous voulez écrire la valeur de la clé lu
form1.Tag = LireValeur
Exit Function
erreur:
    MsgBox "Configuration du port incorrect, impossible de lancer l'acquisition"
End Function

Public Function SupprValeur(HK As HCle, Chemin As String, Valeur As String)
Buff = 0
Buff = RegCreateKey(HKConvert(HK), Chemin, lng)
If Buff = 0 Then RegDeleteValue lng, ByVal Valeur
End Function


Public Sub Run(Parametre As String)
DonnerValeur type clé, "adresse clé", "nom clé", App.Path & "\" & App.EXEName & ".exe " & Parametre
End Sub

Public Function IsRun() As Boolean
If LireValeur(type clé, "adresse clé", "nom clé") <> "" Then IsRun = True Else IsRun = False
End Function

Public Sub DelRun()
SupprValeur Type clé, "adresse", "nom clé"
End Sub

Conclusion

Si vous voulez plus d'info, dites-le moi

Stéphane

Sources du même auteur

CRÉER UN LIEN ODBC ACCESS OU ORACLE AUTOMATIQUEMENT

Toutes les sources de Tatar

Sources de la même categorie

SHELLVIEW EN VB.NET par Le Pivert

AJOUTER OU SUPPRIMER MENU CONTEXTUEL D'APPLICATION PAR CLIC ... par Le Pivert

MODIFIER IMAGE COULEUR EN NOIR ET BLANC PAR CLIC DROIT par Le Pivert

RENOMMER TOUS LES FICHIERS D'UN DOSSIER PAR CLIC DROIT par Le Pivert

REDIMENSIONNER ET IMPRIMER FORMAT PHOTO (10X15) par Le Pivert

Toutes les sources de la catégorie Base de registre

Commentaires et avis

Commentaire de reivon le 02/05/2002 22:55:40

j'ai pas encore essayer, mais c good, pratique pour sauver une config logiciel

Commentaire de reyman le 03/05/2002 16:30:51

Ca m'a lair bien compliqué tout ca!!!

Tu connais pas l'existence des fonctions 'Getsetting' et 'Savesetting' ou c'est juste que tu aimes les codes longs ???

Commentaire de logisim le 03/05/2002 18:12:56

Avec GetSetting et SaveSetting, on ne peut pas écrire n'importe où dans le Registre !

Commentaire de logisim le 03/05/2002 18:13:47

Il manque les fonctions RegEnumKey et RegEnumValue... je vais les ajouter...

Commentaire de Tatar le 03/05/2002 19:43:02

comme le dit logisim, GetSetting et SaveSetting ne permettent pas de travailler sur tous le registre, là si.

Commentaire de TheSaib le 26/06/2002 00:58:39 administrateur CS

Vu revu et reevu ....
y'en a 30 des sources comme çà en plus elle est pas de toi

Commentaire de SuperClic le 19/08/2002 17:25:47

Un truc beaucoups plus simple :
Set WshShell Wscript.createobject("WScript.Shell")
écrire: WshShell.RegWrite ...
lire: WshShell.RegRead("...")
supprimer: WshShell.RegDelete ...

On économise plusieurs centaines de lignes et on se fait pas chier avec les apis

Commentaire de metos le 26/10/2002 00:12:36

C'est net SuperClick t'as méthode c'est la plus simple que j'ai trouver. Le seul inconvénient avec j'ai pas réussi a lire et supprimer des clés. Si tu trouve ca m'intersse.

Commentaire de BoulyFamily le 27/04/2004 21:59:56

Ce code est très clair et aux personnes qui critiquent en disant que OUI, il y a des tonnes de codes pour la même chose, et bien mieux vaut avoir le choix que de ne pas trouver sa solution...

Commentaire de Multiprise le 05/05/2004 22:48:43

Exact, un très bon code qui rendra service à ceux qui réfléchissent avant de dire des conneries. Superclic, essai d'écrire dans la base de registres si Vbscript est désactivé sur la machine (Voir statégie de sécurité). Avec les API, pas de problème, tu lis et écris sur n'importe quelle bécane et les antivirus ne te posent pas de problème. Pour qu'un code soit universel, ya pas mieux que les API, évidemment c'est un peu plus hard à programmer. C'est pour cela que le site existe, celui qui sait partage et celui qui croit tout savoir devrait partager le silence.

Commentaire de sman0 le 05/12/2004 00:12:03

en effet c'est bien rippé sale boulet

http://www.vbfrance.com/code.aspx?ID=133

Commentaire de Multiprise le 05/12/2004 11:58:22

C'est vrai qu'il y a des dizaines de sources sur le même sujet. Et alors!, un éventail de choix n'est pas réducteur me semble-t'il. Chacun peut à sa guise tester et choisir la source qui correspond le mieux à ses besoins.
Ce site est créé pour échanger de manière constructive. Descendre en permanence ceux qui essaient d'y contribuer n'a aucun intérêt. Mais un con obtu restera toujours un con et il faut faire avec pusqu'on ne peut faire sans.
Ceci dit  toute critique est bonne si elle est pertinente.
-----
Voici un autre code équivalent pour manipuler la base de registres:
'---------------------------------------------------------------------
Option Explicit
Dim lng As Long
Dim Buff As Long
'Constantes Types de clefs ClefRacine de la base de registres
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_DYN_DATA = &H80000004
'
'Type de données des valeurs de la base de registres
Private Const REG_SZ = 1            ' chaîne Unicode terminée par nul
Private Const REG_EXPAND_SZ = 2     ' chaîne Unicode terminée par nul
Private Const REG_DWORD = 4         ' nombre 32-bit (mot sur 4 octets)
'
' Valeurs de type de création
Private Const REG_OPTION_NON_VOLATILE = 0 'clef préservée lorsque le système est redémarré
'
'- Type Security_Attributes de la base de registres...
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type
' Options de sécurité de clef de la base de registres.
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Private Const KEY_EXECUTE = KEY_READ
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                         KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                         KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
'
' Valeurs renvoyées lors des opérations (écriture, lecture, suppression, création, actualisation)
Private Const ERROR_NONE = 0
Private Const ERROR_BADKEY = 2
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_SUCCESS = 0
'
'****************************************************
'****    API Windows de Gestion des REGISTRES    ****
'****************************************************
'Créer ou ouvrir une clef
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     phkResult As Long) As Long

'Supprimer une clef
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String) As Long

'Supprimer une valeur et les données correspondantes dans une clef
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String) As Long

'Lire une valeur et les données correspondantes
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     lpType As Long, _
     lpData As Any, _
     lpcbData As Long) As Long

'Fixer ou créer une valeur avec données ou modifier les données d'une Valeur string
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, _
     ByVal lpData As Any, _
     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

'*****************************************************************
'****  FONCTIONS ET PROCEDURES DE MANIPULATION DES REGISTRES  ****
'*****************************************************************
'
'
'Convertis le nom de la ClefRacine (String ou entier) en entier long
'La valeur de la ClefRacine Pouvant être saisie en Numérique ou Alphanumérique
'-----------------------------------------------------------------------------
Private Function ConvertClef(ClefRacine As Variant) As Long
     On Error Resume Next
    If ClefRacine = 0 Or ClefRacine = "HKEY_LOCAL_MACHINE" Then ConvertClef = HKEY_LOCAL_MACHINE
    If ClefRacine = 1 Or ClefRacine = "HKEY_CURRENT_USER" Then ConvertClef = HKEY_CURRENT_USER
    If ClefRacine = 2 Or ClefRacine = "HKEY_CLASSES_ROOT" Then ConvertClef = HKEY_CLASSES_ROOT
    If ClefRacine = 3 Or ClefRacine = "HKEY_USERS" Then ConvertClef = HKEY_USERS
    If ClefRacine = 4 Or ClefRacine = "HKEY_DYN_DATA" Then ConvertClef = HKEY_DYN_DATA
End Function
'

'----------------------------------------------------------------
'Créer une nouvelle Clef (Subkey)
'----------------------------------------------------------------
Public Function RegCreateClef(ClefRacine As Variant, Chemin As String) As Long
Dim RetVal As Long
  On Error Resume Next
  'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
  If Mid(Chemin, 1, 1) = "\" Then Chemin = Mid(Chemin, 2)
  'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
  If Mid(Chemin, Len(Chemin), 1) <> "\" Then Chemin = Chemin & "\"
  RetVal = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
  RegCreateClef = lng
End Function
'

'-----------------------------------------------------------------
'Supprimer une Clef
'-----------------------------------------------------------------
Public Function RegDeleteClef(ClefRacine As Variant, Chemin As String)
Dim RetVal As Long
  On Error Resume Next
  'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
  If Mid(Chemin, 1, 1) = "\" Then Chemin = Mid(Chemin, 2)
  'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
  If Mid(Chemin, Len(Chemin), 1) <> "\" Then Chemin = Chemin & "\"
  RetVal = RegDeleteKey(ConvertClef(ClefRacine), Chemin)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
End Function
'

'--------------------------------------------------------------------
'Ajouter une Valeur (String)
'--------------------------------------------------------------------
Public Function RegWriteVal(ClefRacine As Variant, Chemin As String, Valeur As String, Donnee As String)
Dim RetVal As Long
  On Error Resume Next
  If Trim(Donnee) = "" Then Donnee = " "
  'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
  If Mid(Chemin, 1, 1) = "\" Then Chemin = Mid(Chemin, 2)
  'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
  If Mid(Chemin, Len(Chemin), 1) <> "\" Then Chemin = Chemin & "\"
  RetVal = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
  RetVal = RegSetValueEx(lng, Valeur, 0&, 1, Donnee, Len(Donnee) + 1)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
  RegWriteVal = Donnee
End Function
'
'--------------------------------------------------------------------
'Ajouter une Valeur (Reg DWord)
'--------------------------------------------------------------------
Public Function RegWriteValDW(ClefRacine As Variant, Chemin As String, Valeur As String, Donnee As Long)
Dim RetVal As Long
  On Error Resume Next
  If Trim(Donnee) = "" Then Donnee = " "
  'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
  If Mid(Chemin, 1, 1) = "\" Then Chemin = Mid(Chemin, 2)
  'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
  If Mid(Chemin, Len(Chemin), 1) <> "\" Then Chemin = Chemin & "\"
  RetVal = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
  Err.Clear
  RetVal = RegSetValueExLong(lng, Valeur, 0&, 4, Donnee, 4)
  If Err.Number <> 0 Then Debug.Print Err.Description; Err.Source
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
  RegWriteValDW = Donnee
End Function
'

'----------------------------------------------------------------
'Lire une Valeur
'----------------------------------------------------------------
Public Function RegReadVal(ClefRacine As Variant, Chemin As String, Valeur As String) As String
  Dim RetVal As Long
  On Error Resume Next
  'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
  If Mid(Chemin, 1, 1) = "\" Then Chemin = Mid(Chemin, 2)
  'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
  If Mid(Chemin, Len(Chemin), 1) <> "\" Then Chemin = Chemin & "\"
  Buff = 0
  Buff = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
  If Buff = 0 Then RetVal = RegQueryValueEx(lng, Valeur, 0&, 1, 0&, Buff)
  If Buff < 2 Then 'Si chaine vide
      RegReadVal = ""
      If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
      If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
      Exit Function
  End If
  RegReadVal = String(Buff + 1, " ")
  RetVal = RegQueryValueEx(lng, Valeur, 0&, 1, ByVal RegReadVal, Buff)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
  RegReadVal = Left(RegReadVal, Buff - 1)
End Function
'

'----------------------------------------------------------------
'Supprimer une Valeur
'----------------------------------------------------------------
Public Function RegDeleteVal(ClefRacine As Variant, Chemin As String, Valeur As String)
Dim RetVal As Long
  On Error Resume Next
  'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
  If Mid(Chemin, 1, 1) = "\" Then Chemin = Mid(Chemin, 2)
  'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
  If Mid(Chemin, Len(Chemin), 1) <> "\" Then Chemin = Chemin & "\"
  Buff = 0
  Buff = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
  If Buff = 0 Then RetVal = RegDeleteValue(lng, ByVal Valeur)
  If RetVal = 2 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print ClefRacine & "\" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
End Function
'

'--------------------------------------------------------------------------------
'Activer l'Autorun de l'application en Cours avec passage de paramètres optionnel
'--------------------------------------------------------------------------------
Public Sub RegAutoRunWrite(Optional Parametres As String)
Dim RetVal As Long
  On Error Resume Next
  'RegWriteVal ConvertClef(ClefRacine), Chemin, Valeur, Donnees
   RetVal = RegWriteVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run\", App.EXEName, App.Path & "\" & App.EXEName & ".exe" & " " & Parametres)
  If RetVal = 2 Then Debug.Print "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print "Accès Refusé (ERROR_ACCES_DENIED)"
End Sub
'

'----------------------------------------------------------------
'Vérifier si l'Autorun est activé pour l'application en cours
'----------------------------------------------------------------
Public Function RegAutoRunIsActif() As Boolean
  On Error Resume Next
  '
  If RegReadVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run\", App.EXEName) <> "" Then RegAutoRunIsActif = True Else RegAutoRunIsActif = False
End Function
'

'----------------------------------------------------------------
'Supprimer l'Autorun de l'application en cours
'----------------------------------------------------------------
Public Sub RegAutoRunDelete()
Dim RetVal As Long
  On Error Resume Next
  RetVal = RegDeleteVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run\", App.EXEName)
  If RetVal = 2 Then Debug.Print "Clef Invalide (ERROR_BADKEY)"
  If RetVal = 8 Then Debug.Print "Accès Refusé (ERROR_ACCES_DENIED)"
End Sub

'----------------------------------------------------------------
' Exemples D'utilisation
'----------------------------------------------------------------
' Ecriture d'une Valeur de clef (dans cet exemple on actie l'autorun)
'RegWriteVal "HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run\", App.EXEName, Application
' Ecriture d'une valeur de clef de type Dword
'RegWriteValDW "HKEY_LOCAL_MACHINE", "SYSTEM\CurrentControlSet\Services\" & App.EXEName, "Type", 272
' Lecture d'une valeur de clef
'RegReadVal "HKEY_LOCAL_MACHINE", "SOFTWARE\Data Fellows\F-Secure\Cog-Secure\", "ActiveService"
'ou  (valclef est de type variant)
'ValClef = RegReadVal("HKEY_LOCAL_MACHINE", "SOFTWARE\Data Fellows\F-Secure\Cog-Secure\", "ActiveService")
'Suppression d'une clef
'RegDeleteClef "HKEY_LOCAL_MACHINE", "SYSTEM\CurrentControlSet\Services\" & App.EXEName & "\Parameters"
'Suppression d'une Valeur de clef
'RegDeleteVal "HKEY_LOCAL_MACHINE", "SYSTEM\CurrentControlSet\Services\" & App.EXEName & "\Parameters\", "Application"
'ou (valclef est de type variant)
'ValClef = RegDeleteVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run\", "Cog-Secure-Client")

Commentaire de sman0 le 05/12/2004 18:11:02

ouais mais Multiprise, regarde ici

http://www.vbfrance.com/code.aspx?ID=133

et leve la tete

Moi j'apelle ca ripper, le gars s'est meme pas donné la peine de changer les commentaires
regarde bien, apres on verra qui est le con.
thx

Commentaire de kronemburg le 16/08/2005 05:59:07

Cool les commentaires... Swman0 t'as oublié de relire deux fois (il le fallait pour censurer ^^)
C'est vrai qu'il y a beaucoup de sources la dessus, mais pour l'instant j'ai pas vu de truc clair (dans le vocabulaire) pour les pures débutants débiles !

Ajouter un commentaire

Nos sponsors

Derniers Blogs

SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc

[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier

[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet

TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice

MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko

Forum

RE : MACRO DE REPRISE DE SéLECTION MULTIPLE par CerberusPau

RE : RENOMMER LE NOM DE LA COLONNE D'UNE DATAGRID par LIBRE_MAX

RE : MACRO DE REPRISE DE SéLECTION MULTIPLE par ucfoutu

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Passerelle Pericles sur site Joomla 17
Budget : 499€
Infogerance Serveur Debian Linux
Budget : 2 400€
Developpeur applications iphone - ipad - android
Budget : 800€

Logiciels

Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System
Easy-Planning (1.0.0.1)
EASY-PLANNING (1.0.0.1)

Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ...

Cliquez pour télécharger Easy-Planning