Пример класса для работы с реестром

Статьи / .NET / VB.NET / Реестр и работа с ним /

Назад

**************************************************************

Код класса:

**************************************************************

Imports Microsoft.Win32

PublicClass clsRegistry

'класс для работы с реестром

 

PublicEnum ERegistryPossibleRoots

HKEY_CLASSES_ROOT = 0

HKEY_CURRENT_CONFIG = 1

HKEY_CURRENT_USER = 2

HKEY_DYNDATA = 3

HKEY_LOCALE_MACHINE = 4

HKEY_PERFORMANCE_DATA = 5

HKEY_USERS = 6

EndEnum

 

PrivateFunction GetRegKey(ByVal lngRoot As ERegistryPossibleRoots) As RegistryKey

OnErrorGoTo myErr

SelectCase lngRoot

Case ERegistryPossibleRoots.HKEY_CLASSES_ROOT

GetRegKey = Registry.ClassesRoot

Case ERegistryPossibleRoots.HKEY_CURRENT_CONFIG

GetRegKey = Registry.CurrentConfig

Case ERegistryPossibleRoots.HKEY_CURRENT_USER

GetRegKey = Registry.CurrentUser

Case ERegistryPossibleRoots.HKEY_DYNDATA

GetRegKey = Registry.DynData

Case ERegistryPossibleRoots.HKEY_LOCALE_MACHINE

GetRegKey = Registry.LocalMachine

Case ERegistryPossibleRoots.HKEY_PERFORMANCE_DATA

GetRegKey = Registry.PerformanceData

Case ERegistryPossibleRoots.HKEY_USERS

GetRegKey = Registry.Users

EndSelect

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

GetRegKey = Nothing

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

PublicFunction DoesKeyExist( _

ByVal lngRootKey As ERegistryPossibleRoots, _

ByVal strKey AsString) AsBoolean

Dim objRegKey As RegistryKey

Dim bOK AsBoolean

OnErrorGoTo myErr

objRegKey = GetRegKey(lngRootKey)

objRegKey = objRegKey.OpenSubKey(strKey, False)

If objRegKey IsNothingThen

bOK = False

Else

bOK = True

EndIf

IfNot objRegKey IsNothingThen

objRegKey.Close()

objRegKey = Nothing

EndIf

DoesKeyExist = bOK

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

objRegKey.Close()

objRegKey = Nothing

DoesKeyExist = bOK

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

PublicFunction CreateKey(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString) AsBoolean

Dim objRegKey As RegistryKey

OnErrorGoTo myErr

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.CreateSubKey(strKey)

If objRegKey IsNothingThen

CreateKey = False

Else

CreateKey = True

EndIf

objRegKey.Close()

objRegKey = Nothing

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

' if not objRegKey is nothing then

objRegKey.Close()

objRegKey = Nothing

' end if

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

PublicFunction DeleteKey(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

OptionalByVal bRecursive AsBoolean = False) AsBoolean

Dim objRegKey As RegistryKey

Dim bOK AsBoolean

OnErrorGoTo myErr

bOK = True

objRegKey = GetRegKey(lngrootkey)

If bRecursive Then

objRegKey.DeleteSubKeyTree(strKey)

Else

objRegKey.DeleteSubKey(strKey)

EndIf

objRegKey.Close()

objRegKey = Nothing

DeleteKey = bOK

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

objRegKey.Close()

objRegKey = Nothing

DeleteKey = bOK

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

' =====================================

PublicFunction QueryValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString, _

ByVal objDefault AsString) AsString

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim strRet AsString

OnErrorGoTo myErr

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey)

strRet = CStr(objRegKey.GetValue(strValName, objDefault))

QueryValue = strRet

strRet = ""

objRegKey.Close()

objRegKey = Nothing

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

strRet = Nothing

objRegKey.Close()

objRegKey = Nothing

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

' Byte-Array => Binary

PublicFunction QueryValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString, _

ByVal objDefault() AsByte) AsByte()

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim arrRet() AsByte

OnErrorGoTo myErr

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey)

arrRet = CType(objRegKey.GetValue(strValName, objDefault), Byte())

QueryValue = arrRet

arrRet = Nothing

objRegKey.Close()

objRegKey = Nothing

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

arrRet = Nothing

objRegKey.Close()

objRegKey = Nothing

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

' Integer => DWORD

PublicFunction QueryValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString, _

ByVal objDefault AsInteger) AsInteger

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim intRet AsInteger

OnErrorGoTo myErr

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey)

intRet = CInt(objRegKey.GetValue(strValName, objDefault))

QueryValue = intRet

objRegKey.Close()

objRegKey = Nothing

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

intRet = Nothing

objRegKey.Close()

objRegKey = Nothing

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

'  => String

PublicFunction CreateValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString, _

ByVal objVal AsString) AsBoolean

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim objRet AsObject

Dim bOK AsBoolean

OnErrorGoTo myErr

bOK = False

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey, True)

IfNot objRegKey IsNothingThen

objRegKey.SetValue(strValName, objVal)

objRegKey.Flush()

bOK = True

objRegKey.Close()

objRegKey = Nothing

Else

bOK = False

EndIf

CreateValue = bOK

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

objRegKey.Close()

objRegKey = Nothing

CreateValue = bOK

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

' => Byte-Array => Binary

PublicFunction CreateValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString, _

ByVal objVal() AsByte) AsBoolean

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim objRet AsObject

Dim bOK AsBoolean

OnErrorGoTo myErr

bOK = False

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey, True)

IfNot objRegKey IsNothingThen

objRegKey.SetValue(strValName, objVal)

objRegKey.Flush()

bOK = True

objRegKey.Close()

objRegKey = Nothing

Else

bOK = False

EndIf

CreateValue = bOK

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

objRegKey.Close()

objRegKey = Nothing

CreateValue = bOK

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

'  => Integer => DWORD

PublicFunction CreateValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString, _

ByVal objVal AsInteger) AsBoolean

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim objRet AsObject

Dim bOK AsBoolean

OnErrorGoTo myErr

bOK = False

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey, True)

IfNot objRegKey IsNothingThen

objRegKey.SetValue(strValName, objVal)

objRegKey.Flush()

bOK = True

objRegKey.Close()

objRegKey = Nothing

Else

bOK = False

EndIf

CreateValue = bOK

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

objRegKey.Close()

objRegKey = Nothing

CreateValue = bOK

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

 

PublicFunction DeleteValue(ByVal lngrootkey As ERegistryPossibleRoots, _

ByVal strKey AsString, _

ByVal strValName AsString) AsBoolean

Dim objRegKey As RegistryKey

Dim strType AsLong

Dim objRet AsObject

Dim bOK AsBoolean

OnErrorGoTo myErr

bOK = False

objRegKey = GetRegKey(lngrootkey)

objRegKey = objRegKey.OpenSubKey(strKey, True)

IfNot objRegKey IsNothingThen

objRegKey.DeleteValue(strValName)

objRegKey.Flush()

bOK = True

objRegKey.Close()

objRegKey = Nothing

Else

bOK = False

EndIf

DeleteValue = bOK

ExitFunction

myErr:

Dim lngErrNr AsInteger

Dim strErrSrc AsString

Dim strErrDesc AsString

lngErrNr = Err.Number

strErrSrc = Err.Source

strErrDesc = Err.Description

OnErrorResumeNext

objRegKey.Close()

objRegKey = Nothing

DeleteValue = bOK

Err.Clear()

Err.Raise(lngErrNr, strErrSrc, strErrDesc)

EndFunction

EndClass

 

*********************************************************

Пример использования класса

*********************************************************

 

Module modNGSRegistryTest

Public Sub Test()

Dim arrByte() As Byte

On Error GoTo err

Dim objNGSRegistry As New NGSRegistry.clsNGSRegistry()

 

If Not objNGSRegistry.DoesKeyExist( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3") Then

 

Debug.WriteLine(objNGSRegistry.CreateKey( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3"))

End If

 

Debug.WriteLine(objNGSRegistry.CreateValue( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3", _

"StrVal", _

"Jochen"))

 

ReDim arrByte(3)

arrByte(0) = 1

arrByte(1) = 2

arrByte(2) = 3

arrByte(3) = 4

Debug.WriteLine(objNGSRegistry.CreateValue( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3", _

"BinVal", _

arrByte))

 

Debug.WriteLine(objNGSRegistry.CreateValue( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3", _

"DWordVal", _

CInt(1234)))

Debug.WriteLine(objNGSRegistry.QueryValue( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3", _

"StrVal", _

""))

 

ReDim arrByte(3)

arrByte(0) = 1

arrByte(1) = 1

arrByte(2) = 1

arrByte(3) = 1

arrByte = objNGSRegistry.QueryValue( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3", _

"BinVal", _

arrByte)

Dim i As Integer

For i = arrByte.GetLowerBound(0) To arrByte.GetUpperBound(0)

Debug.WriteLine("arrByte[" & i & "]: " & arrByte(i))

Next i

 

Debug.WriteLine(objNGSRegistry.QueryValue( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3", _

"DWordVal", _

CInt(0)))

 

Debug.WriteLine(objNGSRegistry.DeleteKey( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1\key2\key3"))

 

Debug.WriteLine(objNGSRegistry.DeleteKey( _

objNGSRegistry.ERegistryPossibleRoots.HKEY_LOCALE_MACHINE, _

"Software\NGS\key1", True))

 

objNGSRegistry = Nothing

MsgBox("Test finish!", MsgBoxStyle.ApplicationModal + MsgBoxStyle.Information + MsgBoxStyle.OKOnly, Application.ProductName)

Exit Sub

err:

Dim s As String

s = "----------------------------------------" & vbCrLf

s = s & Err.Number & " - " & Err.Source & vbCrLf

s = s & Err.Description & vbCrLf

s = s & "----------------------------------------"

MsgBox(s, MsgBoxStyle.ApplicationModal + MsgBoxStyle.Critical + MsgBoxStyle.OKOnly, Application.ProductName)

End Sub

End Module