Create a module and add this code:
Query the value with NewPath=Getpath()
Set it with SetPath("New Value")
==========================
Option Explicit
Public Const sSoftwareKey = "Software\programme\settin
Private Declare Function RegSetValueEx Lib "advapi32" 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
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
' Reg Create Type Values...
Private Const REG_OPTION_RESERVED = 0 ' Parameter is reserved
Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Private Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted
Private Const REG_OPTION_CREATE_LINK = 2 ' Created key is a symbolic link
Private Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore
' Reg Key Security Options...
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' Reg Key ROOT Types...
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const ERROR_SUCCESS = 0 ' Return Value...
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_DWORD = 4 ' 32-bit number
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Public iReturn As Integer
Public sExportPath As String
'-------------------------
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As Variant, Optional ByVal vDefault As Variant) As Boolean
'-------------------------
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'-------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'-------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...
tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size
'-------------------------
' Retrieve Registry Key Value...
'-------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String...
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'-------------------------
' Determine Key Value Type For Conversion...
'-------------------------
Select Case KeyValType ' Search Data Types...
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
'For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
' KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
'Next
'KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
KeyVal = tmpVal
End Select
GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit
'-------------------------
GetKeyError: ' Cleanup After An Error Has Occured...
'-------------------------
Select Case VarType(KeyVal)
Case vbInteger, vbSingle, vbDouble, vbLong, vbCurrency
If IsMissing(vDefault) Then
KeyVal = 0 ' Set Return Val To Empty String
Else
KeyVal = vDefault
End If
Case vbDate
KeyVal = vbNull
Case vbString
If IsMissing(vDefault) Then
KeyVal = "" ' Set Return Val To Empty String
Else
KeyVal = vDefault
End If
Case vbBoolean
If IsMissing(vDefault) Then
KeyVal = 0 ' Set Return Val To Empty String
Else
KeyVal = vDefault
End If
Case Else
KeyVal = vbNull
End Select
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
'-------------------------
End Function
'-------------------------
'-------------------------
Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
'-------------------------
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To A Registry Key
Dim hDepth As Long '
Dim lpAttr As SECURITY_ATTRIBUTES ' Registry Security Type
'-------------------------
lpAttr.nLength = 50 ' Set Security Attributes To Defaults...
lpAttr.lpSecurityDescripto
lpAttr.bInheritHandle = True ' ...
'-------------------------
'- Create/Open Registry Key...
'-------------------------
rc = RegCreateKeyEx(KeyRoot, KeyName, _
0, REG_SZ, _
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
hKey, hDepth) ' Create/Open //KeyRoot//KeyName
If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Handle Errors...
'-------------------------
'- Create/Modify Key Value...
'-------------------------
If (SubKeyValue = "") Then SubKeyValue = " " ' A Space Is Needed For RegSetValueEx() To Work...
rc = RegSetValueEx(hKey, SubKeyName, _
0, REG_SZ, _
SubKeyValue, Len(SubKeyValue)) ' Create/Modify Key Value
If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Handle Error
'-------------------------
'- Close Registry Key...
'-------------------------
rc = RegCloseKey(hKey) ' Close Key
UpdateKey = True ' Return Success
Exit Function ' Exit
'-------------------------
CreateKeyError:
'-------------------------
UpdateKey = False ' Set Error Return Code
rc = RegCloseKey(hKey) ' Attempt To Close Key
'-------------------------
End Function
'-------------------------
Public Function GetPath() As String
iReturn = GetKeyValue(HKEY_CURRENT_U
End Function
Public Sub SetPath(sNewPath As String)
iReturn = UpdateKey(HKEY_CURRENT_USE
End Sub
Main Topics
Browse All Topics
by: thuanncPosted on 2001-12-03 at 02:26:52ID: 6663881
'Create new mudule registry.bas with following code
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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, lpData As Any, 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, lpData As Any, ByVal cbData As Long) As Long
Const KEY_ALL_ACCESS = &HF003F
Const HKEY_DYN_DATA = &H80000006
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_EXPAND_SZ = 2
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_NONE = 0
Const REG_RESOURCE_LIST = 8
Const REG_SZ = 1
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String)
Dim lresult As Long
Dim lValueType As Long
Dim strBuf As String
Dim lDataBufSize As Long
'On Error GoTo 0
lresult = RegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
If lresult = 0 Then
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lresult = RegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
If lresult = 0 Then
RegQueryStringValue = Left(strBuf, lDataBufSize - 1)
End If
End If
End If
End Function
Public Function GetString(hKey As Long, strPath As String, strValue As String)
Dim keyhand&
Call RegOpenKey(hKey, strPath, keyhand&)
GetString = RegQueryStringValue(keyhan
Call RegCloseKey(keyhand&)
End Function
Public Sub SaveString(hKey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand&
Call RegCreateKey(hKey, strPath, keyhand&)
Call RegSetValueEx(keyhand&, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
Call RegCloseKey(keyhand&)
End Sub
Public Sub DelString(hKey As Long, strPath As String, sKey As String)
Dim keyhand&
Call RegOpenKey(hKey, strPath, keyhand&)
Call RegDeleteValue(keyhand&, sKey)
Call RegCloseKey(keyhand&)
End Sub
'**********************
'in your procedure you can put following line to save 'registry value
' pth="D:\limjax\ticker_priv
'**********************
public sub SavePathtoReg(pth as string)
call SaveString(HKEY_CURRENT_US
end sub