home *** CD-ROM | disk | FTP | other *** search
/ Troubleshooting Netware Systems / CSTRIAL0196.BIN / attach / msj / v10n10 / vb40.exe / WCIMR.EXE / WCGETREG.CLS < prev    next >
Text File  |  1995-10-01  |  5KB  |  161 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "WCIMGetReg"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. ' public class to get and set registry values
  11.  
  12. ' key to open
  13. Public strKey As String
  14. ' current toplevel key
  15. Public hKey As Long
  16. ' error message to pass back
  17. Public ErrorMessage As String
  18.  
  19. Public Function GetRegValue(RegEntry As WCIMReg) As Boolean
  20.    Dim lpszData As String
  21.    Dim lpnData As Long
  22.    Dim lpcbData As Long
  23.    Dim hkResult As Long
  24.  
  25.    ' function to get a value from the registry
  26.    
  27.    On Error GoTo GetRegValueError
  28.  
  29.    ErrorMessage = ""
  30.    
  31.    ' open the key
  32.    If RegOpenKey(hKey, strKey, hkResult) = ERROR_SUCCESS Then
  33.    
  34.       ' figure out if we are looking for strings or DWORDs
  35.       Select Case RegEntry.DataType
  36.          ' string
  37.          Case REG_SZ
  38.             ' initialize
  39.             lpszData = Space$(255)
  40.             lpcbData = Len(lpszData)
  41.             ' get the value
  42.             If RegQueryValueEx(hkResult, RegEntry.Entry, ByVal 0, REG_SZ, ByVal lpszData, lpcbData) = ERROR_SUCCESS Then
  43.                If lpcbData > 1 Then
  44.                   RegEntry.Value = Left$(lpszData, lpcbData - 1)
  45.                Else
  46.                   RegEntry.Value = ""
  47.                End If
  48.                GetRegValue = True
  49.             Else
  50.                RegEntry.Value = Null
  51.                GetRegValue = False
  52.             End If
  53.          ' DWORD
  54.          Case REG_DWORD
  55.             ' initialize
  56.             lpnData = 0
  57.             lpcbData = Len(lpnData)
  58.             ' get the data
  59.             If RegQueryValueEx(hkResult, RegEntry.Entry, ByVal 0, REG_DWORD, lpnData, lpcbData) = ERROR_SUCCESS Then
  60.                RegEntry.Value = CLng(lpnData)
  61.                GetRegValue = True
  62.             Else
  63.                RegEntry.Value = Null
  64.                GetRegValue = False
  65.             End If
  66.       End Select
  67.  
  68.       ' clean up
  69.       If RegCloseKey(hkResult) <> ERROR_SUCCESS Then
  70.          ErrorMessage = "RegCloseKey Failed: " & strKey
  71.          GoTo GetRegValueError
  72.       End If
  73.  
  74.    Else
  75.       ' clean up
  76.       RegEntry.Value = Null
  77.       ErrorMessage = "RegOpenKey Failed: " & strKey
  78.       GoTo GetRegValueError
  79.    End If
  80.  
  81.    GetRegValue = True
  82.    Exit Function
  83.  
  84. GetRegValueError:
  85.  
  86.    GetRegValue = False
  87.    Exit Function
  88.  
  89. End Function
  90. Public Function SetRegValue(RegEntry As WCIMReg) As Boolean
  91.    Dim lpStrData As String
  92.    Dim lpNumData  As Long
  93.    Dim lpValueName As String
  94.    Dim hkResult As Long
  95.    Dim cbData  As Long
  96.  
  97.    ' this function sets an entry in the registry
  98.    
  99.    On Error GoTo SetRegValueError
  100.  
  101.    ErrorMessage = ""
  102.  
  103.    ' if the value we are setting is null, remove it from the registry
  104.    If IsNull(RegEntry.Value) Then
  105.       If RegOpenKey(hKey, strKey, hkResult) <> ERROR_SUCCESS Then
  106.          ErrorMessage = "RegOpenKey Failed: " & strKey
  107.          GoTo SetRegValueError
  108.       Else
  109.          If RegDeleteValue(hkResult, RegEntry.Entry) <> ERROR_SUCCESS Then
  110.             ErrorMessage = "RegDeleteValue Failed: " & CStr(RegEntry.Entry)
  111.             GoTo SetRegValueError
  112.          End If
  113.       End If
  114.    Else
  115.       ' value has content, open or create the key
  116.       If RegOpenKey(hKey, strKey, hkResult) <> ERROR_SUCCESS Then
  117.          'try to create the key
  118.          If RegCreateKey(hKey, strKey, hkResult) <> ERROR_SUCCESS Then
  119.             ErrorMessage = "RegCreateKey Failed: " & strKey
  120.             GoTo SetRegValueError
  121.          End If
  122.       End If
  123.  
  124.       lpValueName = RegEntry.Entry
  125.       Select Case RegEntry.DataType
  126.          Case REG_SZ
  127.             lpStrData = CStr(RegEntry.Value)
  128.             cbData = Len(lpStrData) + 1
  129.             If RegSetValueEx(hkResult, lpValueName, 0, REG_SZ, ByVal lpStrData, cbData) <> ERROR_SUCCESS Then
  130.                ErrorMessage = "RegSetValueEx Failed: " & lpValueName
  131.                GoTo SetRegValueError
  132.             End If
  133.          Case REG_DWORD
  134.             lpNumData = CLng(RegEntry.Value)
  135.             cbData = 4
  136.             If RegSetValueEx(hkResult, lpValueName, 0, REG_DWORD, lpNumData, cbData) <> ERROR_SUCCESS Then
  137.                ErrorMessage = "RegSetValueEx Failed: " & lpValueName
  138.                GoTo SetRegValueError
  139.             End If
  140.       End Select
  141.    End If
  142.  
  143.    SetRegValue = True
  144.    If RegCloseKey(hkResult) <> ERROR_SUCCESS Then
  145.       ErrorMessage = "RegCloseKey Failed: " & strKey
  146.       GoTo SetRegValueError
  147.    End If
  148.    Exit Function
  149.  
  150. SetRegValueError:
  151.  
  152.    RC = RegCloseKey(hkResult)
  153.    SetRegValue = False
  154.    Exit Function
  155.  
  156. End Function
  157.  
  158.  
  159.  
  160.  
  161.