clsreg.cls

优盘 锁定监视器

     CopyMemory ByVal resString, resBinary(0), Length - 1
     Length = ExpandEnvironmentStrings(resString, resString, Len(resString))
     valueInfo(1) = TrimNull(resString)
    Else
     valueInfo(1) = ""
    End If
   Case REG_BINARY
    If Length < UBound(resBinary) + 1 Then ReDim Preserve resBinary(0 To Length - 1) As Byte
    For i = 0 To UBound(resBinary)
     resString = resString & " " & Format(Trim(Hex(resBinary(i))), "0#")
    Next i
    valueInfo(1) = LTrim(resString)
   Case REG_MULTI_SZ
    resString = Space$(Length - 2)
    CopyMemory ByVal resString, resBinary(0), Length - 2
    resString = Replace(resString, vbNullChar, ",", , , vbBinaryCompare)
    valueInfo(1) = resString
   Case Else
  End Select
  EnumRegistryValues.Add valueInfo, valueInfo(0)
  Index = Index + 1
 Loop
 If handle Then RegCloseKey handle
End Function

Public Function GetRegistryValue(ByVal ValueName As String, Optional DefaultValue As Variant) As Variant
Dim handle As Long
Dim resLong As Long
Dim resString As String
Dim TestString As String
Dim resBinary() As Byte
Dim Length As Long
Dim retVal As Long
Dim valueType As Long
 GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
 If RegOpenKeyEx(mvarhKeySet, mvarKeyRoot & "\" & mvarSubKey, REG_OPTION_NON_VOLATILE, KEY_READ, handle) Then Exit Function
 Length = 1024
 ReDim resBinary(0 To Length - 1) As Byte
 retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), Length)
 If retVal = ERROR_MORE_DATA Then
  ReDim resBinary(0 To Length - 1) As Byte
  retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), Length)
 End If
 If retVal = ERROR_KEY_NOT_FOUND Then
  RegCloseKey (handle)
  Exit Function
 End If
 Select Case valueType
  Case REG_DWORD
   CopyMemory resLong, resBinary(0), 4
   GetRegistryValue = resLong
  Case REG_SZ
   If Length <> 0 Then
    resString = Space$(Length - 1)
    CopyMemory ByVal resString, resBinary(0), Length - 1
    GetRegistryValue = resString
   End If
  Case REG_EXPAND_SZ
   If Length <> 0 Then
    resString = Space$(Length - 1)
    CopyMemory ByVal resString, resBinary(0), Length - 1
    'frmIceCreamParlor.txtExpandActual.Text = resString
    Length = ExpandEnvironmentStrings(resString, resString, Len(resString))
    GetRegistryValue = Left$(resString, Length)
   End If
  Case REG_BINARY
   If Length <> UBound(resBinary) + 1 Then ReDim Preserve resBinary(0 To Length - 1) As Byte
   GetRegistryValue = resBinary()
  Case REG_MULTI_SZ
   resString = Space$(Length - 2)
   CopyMemory ByVal resString, resBinary(0), Length - 2
   TestString = resString
   If Len(TrimNull(TestString)) > 0 Then GetRegistryValue = resString
  Case Else
 End Select
 RegCloseKey (handle)
End Function

Public Function SetRegistryValue(ByVal ValueName As String, Value As Variant, DType As DataType) As Boolean
Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim Length As Long
Dim retVal As Long
 If RegOpenKeyEx(hKey, mvarKeyRoot & "\" & mvarSubKey, REG_OPTION_NON_VOLATILE, KEY_WRITE, handle) Then
  SetRegistryValue = False
  Exit Function
 End If
 Select Case DType
  Case REG_DWORD
   lngValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD, lngValue, 4)
  Case REG_SZ
   strValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, Len(strValue))
  Case REG_BINARY
   binValue = Value
   Length = UBound(binValue) - LBound(binValue) + 1
   retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, binValue(LBound(binValue)), Length)
  Case REG_EXPAND_SZ
   strValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_EXPAND_SZ, ByVal strValue, Len(strValue))
  Case REG_MULTI_SZ
   strValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_MULTI_SZ, ByVal strValue, Len(strValue))
  Case Else
 End Select
 RegCloseKey (handle)
 SetRegistryValue = (retVal = 0)
End Function

Public Function ReadRemoteRegistryValue(ByVal sRemoteComputer As String, ByVal hKey As hKey, ByVal ValueName As String, Optional KeyPath As String) As Variant
Dim handle As Long
Dim lReturnCode, lHive, lhRemoteRegistry As Long
Dim valueType As Long
Dim resLong As Long
Dim resString As String
Dim TestString As String
Dim resBinary() As Byte
Dim Length As Long
Dim retVal As Long
Dim RegPath As String
 RegPath = IIf(IsMissing(KeyPath), mvarKeyRoot & "\" & mvarSubKey, KeyPath)
 If RegConnectRegistry(sRemoteComputer, hKey, lhRemoteRegistry) Then
  ReadRemoteRegistryValue = CVar("Error!")
  Exit Function
 End If
 lReturnCode = RegOpenKeyEx(lhRemoteRegistry, RegPath, 0, KEY_ALL_ACCESS, handle)
 Length = 1024
 ReDim resBinary(0 To Length - 1) As Byte
 retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), Length)
 If retVal = ERROR_MORE_DATA Then
  ReDim resBinary(0 To Length - 1) As Byte
  retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), Length)
 End If
 If retVal = ERROR_KEY_NOT_FOUND Then
  RegCloseKey (handle)
  Exit Function
 End If
 Select Case valueType
  Case REG_DWORD
   CopyMemory resLong, resBinary(0), 4
   ReadRemoteRegistryValue = resLong
  Case REG_SZ
   If Length <> 0 Then
    resString = Space$(Length - 1)
    CopyMemory ByVal resString, resBinary(0), Length - 1
    ReadRemoteRegistryValue = resString
   End If
  Case REG_EXPAND_SZ
   If Length <> 0 Then
    resString = Space$(Length - 1)
    CopyMemory ByVal resString, resBinary(0), Length - 1
    'frmIceCreamParlor.txtExpandActual.Text = resString
    Length = ExpandEnvironmentStrings(resString, resString, Len(resString))
    ReadRemoteRegistryValue = Left$(resString, Length)
   End If
  Case REG_BINARY
   If Length <> UBound(resBinary) + 1 Then ReDim Preserve resBinary(0 To Length - 1) As Byte
   ReadRemoteRegistryValue = resBinary()
  Case REG_MULTI_SZ
   resString = Space$(Length - 2)
   CopyMemory ByVal resString, resBinary(0), Length - 2
   TestString = resString
   If Len(TrimNull(TestString)) > 0 Then ReadRemoteRegistryValue = resString
  Case Else
 End Select
 RegCloseKey (handle)
End Function

Public Function WriteRemoteRegistryValue(ByVal sRemoteComputer As String, ByVal hKey As hKey, ByVal ValueName As String, Value As Variant, DType As DataType, Optional KeyPath As String) As Boolean
Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim Length As Long
Dim retVal As Long
Dim RegPath As String
Dim lhRemoteRegistry As Long
Dim lReturnCode     As Long
 RegPath = IIf(IsMissing(KeyPath), mvarKeyRoot & "\" & mvarSubKey, KeyPath)
 If RegConnectRegistry(sRemoteComputer, hKey, lhRemoteRegistry) Then
  WriteRemoteRegistryValue = CVar("Error!")
  Exit Function
 End If
 lReturnCode = RegOpenKeyEx(lhRemoteRegistry, RegPath, 0, KEY_ALL_ACCESS, handle)
 Select Case DType
  Case REG_DWORD
   lngValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD, lngValue, 4)
  Case REG_SZ
   strValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, Len(strValue))
  Case REG_BINARY
   binValue = Value
   Length = UBound(binValue) - LBound(binValue) + 1
   retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, binValue(LBound(binValue)), Length)
  Case REG_EXPAND_SZ
   strValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_EXPAND_SZ, ByVal strValue, Len(strValue))
  Case REG_MULTI_SZ
   strValue = Value
   retVal = RegSetValueEx(handle, ValueName, 0, REG_MULTI_SZ, ByVal strValue, Len(strValue))
  Case Else
 End Select
 RegCloseKey (handle)
 WriteRemoteRegistryValue = (retVal = 0)
End Function

Public Function TrimNull(item As String) As String
Dim pos As Integer
 pos = InStr(item, Chr$(0))
 If pos Then item = Left$(item, pos - 1)
 TrimNull = item
End Function