regeit.bas

这是学生做的一个游戏系统 大家参考一下

Attribute VB_Name = "RegEit"
Option Explicit
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) 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) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Const HKEY_CURRENT_USER = &H80000001
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1&
Public Const STANDARD_RIGHTS_READ = &H20000
Public Const STANDARD_RIGHTS_WRITE = &H20000
Public Const KEY_QUERY_VALUE = &H1&
Public Const KEY_SET_VALUE = &H2&
Public Const KEY_CREATE_SUB_KEY = &H4&
Public Const KEY_ENUMERATE_SUB_KEYS = &H8&
Public Const KEY_NOTIFY = &H10&
Public Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Public Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY

Public Function GetStringValue(ByVal SubKey As String, ByVal Entry As String)
  Dim rtn As Long
  Dim hKey As Long
  Dim sBuffer As String
  Dim lBufferSize As Long
  
   rtn = InStr(SubKey, "\")
   SubKey = Right(SubKey, Len(SubKey) - rtn)
   
   rtn = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey, 0, KEY_READ, hKey)
   If rtn = ERROR_SUCCESS Then
      sBuffer = Space(255)
      lBufferSize = Len(sBuffer)
      rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, lBufferSize)
      If rtn = ERROR_SUCCESS Then
         rtn = RegCloseKey(hKey)
         sBuffer = Trim(sBuffer)
         GetStringValue = Left(sBuffer, Len(sBuffer) - 1)
      End If
   End If
End Function
Public Function SetStringValue(ByVal SubKey As String, ByVal Entry As String, ByVal value As String)
  Dim rtn As Long
  Dim hKey As Long
  
   rtn = InStr(SubKey, "\")
   SubKey = Right(SubKey, Len(SubKey) - rtn)
   
    rtn = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey, 0, KEY_WRITE, hKey)
   If rtn = ERROR_SUCCESS Then
      value = Trim(value)
      rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal value, Len(value))
      rtn = RegCloseKey(hKey)
   End If
End Function
Public Function CreateKey(ByVal SubKey As String)
  Dim rtn As Long
  Dim hKey As Long
 
  
   rtn = InStr(SubKey, "\")
   SubKey = Right(SubKey, Len(SubKey) - rtn)

   rtn = RegCreateKey(HKEY_CURRENT_USER, SubKey, hKey)
    If rtn = ERROR_SUCCESS Then
      rtn = RegCloseKey(hKey)
   End If
End Function