Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"(ByVal hKey As Integer, ByVal lpSubKey As String, ByRef phkResult As Integer) As Integer
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"(ByVal hKey As Integer, ByVal lpSubKey As String, ByRef phkResult As Integer) As Integer
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Integer) As Integer
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Integer, ByVal lpValueName As String, ByVal Reserved As Integer, ByVal dwType As Integer, ByVal lpData As String, ByVal cbData As Integer) As Integer '创建或改变一个键值,lpData应由缺省的ByRef型改为ByVal型
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Integer, ByVal lpValueName As String, ByVal lpReserved As Integer, ByRef lpType As Integer, ByVal lpData As String, ByRef lpcbData As Integer) As Integer '查询一个键值,lpData应由缺省的ByRef型改为ByVal型
Public Const HKEY_CURRENT_USER As Integer = &H80000001
Private Const REG_SZ As Short = 1 '字符串值
Private Const REG_EXPAND_SZ As Short = 2
Private Const ERROR_SUCCESS As Short = 0
'*****************读注册表********************
Public Function GetString(ByRef hKey As Integer, ByRef strPath As String, ByRef strValue As String) As String
Dim keyhand As Integer
Dim lResult As Integer
Dim strBuf As String
Dim lDataBufSize As Integer
Dim intZeroPos As Short
Dim lValueType As Integer 'new add
RegOpenKey(hKey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0, lValueType, 0, lDataBufSize)
If lValueType = REG_SZ Or lValueType = REG_EXPAND_SZ Then
strBuf = New String(" ", lDataBufSize)
lResult = RegQueryValueEx(keyhand, strValue, 0, lValueType, strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr(0))
If intZeroPos > 0 Then
GetString = Left(strBuf, intZeroPos - 1)
Else : GetString = strBuf
End If
End If
End If
RegCloseKey(keyhand)
End Function
'*****************写注册表********************
Public Sub SetString(ByRef hKey As Integer, ByRef strPath As String, ByRef strValue As String, ByRef strdata As String)
Dim keyhand As Integer
RegCreateKey(hKey, strPath, keyhand)
RegSetValueEx(keyhand, strValue, 0, REG_SZ, strdata, Len(strdata))
RegCloseKey(keyhand)
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"(ByVal hKey As Integer, ByVal lpSubKey As String, ByRef phkResult As Integer) As Integer
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Integer) As Integer
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Integer, ByVal lpValueName As String, ByVal Reserved As Integer, ByVal dwType As Integer, ByVal lpData As String, ByVal cbData As Integer) As Integer '创建或改变一个键值,lpData应由缺省的ByRef型改为ByVal型
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Integer, ByVal lpValueName As String, ByVal lpReserved As Integer, ByRef lpType As Integer, ByVal lpData As String, ByRef lpcbData As Integer) As Integer '查询一个键值,lpData应由缺省的ByRef型改为ByVal型
Public Const HKEY_CURRENT_USER As Integer = &H80000001
Private Const REG_SZ As Short = 1 '字符串值
Private Const REG_EXPAND_SZ As Short = 2
Private Const ERROR_SUCCESS As Short = 0
'*****************读注册表********************
Public Function GetString(ByRef hKey As Integer, ByRef strPath As String, ByRef strValue As String) As String
Dim keyhand As Integer
Dim lResult As Integer
Dim strBuf As String
Dim lDataBufSize As Integer
Dim intZeroPos As Short
Dim lValueType As Integer 'new add
RegOpenKey(hKey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0, lValueType, 0, lDataBufSize)
If lValueType = REG_SZ Or lValueType = REG_EXPAND_SZ Then
strBuf = New String(" ", lDataBufSize)
lResult = RegQueryValueEx(keyhand, strValue, 0, lValueType, strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr(0))
If intZeroPos > 0 Then
GetString = Left(strBuf, intZeroPos - 1)
Else : GetString = strBuf
End If
End If
End If
RegCloseKey(keyhand)
End Function
'*****************写注册表********************
Public Sub SetString(ByRef hKey As Integer, ByRef strPath As String, ByRef strValue As String, ByRef strdata As String)
Dim keyhand As Integer
RegCreateKey(hKey, strPath, keyhand)
RegSetValueEx(keyhand, strValue, 0, REG_SZ, strdata, Len(strdata))
RegCloseKey(keyhand)
End Sub
'val_Renamed = GetString(HKEY_CURRENT_USER, "Software\ZWSOFT\ZWCAD\2012\en-US\Settings\UserConfig\Config", "selectsimilarflags")
'Call SetString(HKEY_CURRENT_USER, "Software\ZWSOFT\ZWCAD\2012\en-US\Settings\UserConfig\Config", "selectsimilarflags", Setting_Value)