в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:48:32Z

1 версия

Новая страница

==Reads a value from the Windows Registry==



<source lang="vb">

Private Declare Function RegOpenKeyA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
Private Declare Function RegCloseKey Lib "ADVAPI32.DLL" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueExA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByVal dwType As Long, ByVal sValue As String, ByVal dwSize As Long) As Long
Private Declare Function RegCreateKeyA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
Private Declare Function RegQueryValueExA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long
Function GetRegistry(Key, Path, ByVal ValueName As String)
Dim hKey As Long
Dim lValueType As Long
Dim sResult As String
Dim lResultLen As Long
Dim ResultLen As Long
Dim x, TheKey As Long
Select Case UCase(Key)
Case "HKEY_CLASSES_ROOT": TheKey = &H80000000
Case "HKEY_CURRENT_USER": TheKey = &H80000001
Case "HKEY_LOCAL_MACHINE": TheKey = &H80000002
Case "HKEY_USERS": TheKey = &H80000003
Case "HKEY_CURRENT_CONFIG": TheKey = &H80000004
Case "HKEY_DYN_DATA": TheKey = &H80000005
End Select

If RegOpenKeyA(TheKey, Path, hKey) <> 0 Then _
x = RegCreateKeyA(TheKey, Path, hKey)

sResult = Space(100)
lResultLen = 100

x = RegQueryValueExA(hKey, ValueName, 0, lValueType, _
sResult, lResultLen)

Select Case x
Case 0: GetRegistry = Left(sResult, lResultLen - 1)
Case Else: GetRegistry = "Not Found"
End Select

RegCloseKey hKey
End Function
Sub TestIt()
RootKey = "hkey_current_user"
Path = "software\microsoft\office\9.0\common\autocorrect"
RegEntry = "path"
MsgBox GetRegistry(RootKey, Path, RegEntry), vbInformation, _
Path & "\RegEntry"
End Sub
</source>

==Using RegQueryValueEx to Read Registry Information==



<source lang="vb">

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 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Sub cmdRead()
Dim strValue As String * 256
Dim lngRetval As Long
Dim lngLength As Long
Dim lngKey As Long
If RegOpenKeyEx(HKEY_CURRENT_USER, "Your_Key_Name", 0, KEY_QUERY_VALUE, lngKey) Then
End If
lngLength = 256
"Retrieve the value of the key
lngRetval = RegQueryValueEx( _
lngKey, "YourValueName", 0, 0, ByVal strValue, lngLength)
MsgBox Left(strValue, lngLength)
"Close the key
RegCloseKey (lngKey)
End Sub
</source>

==Using RegSetValueEx to Write Information to the Registry==



<source lang="vb">

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
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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Sub cmdWrite_Click()
Dim strValue As String
Dim strKeyName As String
Dim lngRetval As Long
Dim lngLength As Long
Dim lngKey As Long
strKeyName = "KeyName" & vbNullString
If RegOpenKeyEx(HKEY_CURRENT_USER, strKeyName, 0, KEY_WRITE, lngKey) Then
End If
strValue = "YourValue" & vbNullString
lngLength = Len("YourValue") + 1
lngRetval = RegSetValueEx( lngKey, "YourValue", 0, REG_SZ, ByVal strValue, lngLength)
"Close the key
RegCloseKey (lngKey)
End Sub
</source>

==Working with the Registry Using the VBA Registry Functions==



<source lang="vb">

Sub ExperimentWithRegistry()
Dim vaKeys As Variant
" create new registry entries
SaveSetting "XLTest", "General", "App_Name", "XLTest"
SaveSetting "XLTest", "General", "App_Version", "1.0.0"
SaveSetting "XLTest", "General", "App_Date", "10/11/2003"
PrintRegistrySettings
SaveSetting "XLTest", "General", "App_Version", "1.0.1"
PrintRegistrySettings
vaKeys = GetAllSettings("XLTest", "General")
PrintAllSettings vaKeys
DeleteSetting "XLTest", "General", "App_Name"
DeleteSetting "XLTest", "General", "App_Version"
DeleteSetting "XLTest", "General", "App_Date"
PrintRegistrySettings
End Sub
Sub PrintRegistrySettings()
On Error Resume Next
Debug.Print "Application Name: " & GetSetting("XLTest", "General", "App_Name")
Debug.Print "Application Version: " & GetSetting("XLTest", "General", "App_Version")
Debug.Print "Application Date: " & GetSetting("XLTest", "General", "App_Date")
End Sub
Sub PrintAllSettings(vaSettings As Variant)
Dim nItem As Integer
If IsArray(vaSettings) Then
For nItem = 0 To UBound(vaSettings)
Debug.Print vaSettings(nItem, 0) & ": " & _
vaSettings(nItem, 1)
Next
End If
End Sub
</source>

==Write a value from the Windows Registry==



<source lang="vb">

Private Declare Function RegOpenKeyA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
Private Declare Function RegCloseKey Lib "ADVAPI32.DLL" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueExA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByVal dwType As Long, ByVal sValue As String, ByVal dwSize As Long) As Long
Private Declare Function RegCreateKeyA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
Private Declare Function RegQueryValueExA Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long
Function GetRegistry(Key, Path, ByVal ValueName As String)
Dim hKey As Long
Dim lValueType As Long
Dim sResult As String
Dim lResultLen As Long
Dim ResultLen As Long
Dim x, TheKey As Long
TheKey = -99
Select Case UCase(Key)
Case "HKEY_CLASSES_ROOT": TheKey = &H80000000
Case "HKEY_CURRENT_USER": TheKey = &H80000001
Case "HKEY_LOCAL_MACHINE": TheKey = &H80000002
Case "HKEY_USERS": TheKey = &H80000003
Case "HKEY_CURRENT_CONFIG": TheKey = &H80000004
Case "HKEY_DYN_DATA": TheKey = &H80000005
End Select

If TheKey = -99 Then
GetRegistry = "Not Found"
Exit Function
End If
If RegOpenKeyA(TheKey, Path, hKey) <> 0 Then _
x = RegCreateKeyA(TheKey, Path, hKey)

sResult = Space(100)
lResultLen = 100

x = RegQueryValueExA(hKey, ValueName, 0, lValueType, _
sResult, lResultLen)

Select Case x
Case 0: GetRegistry = Left(sResult, lResultLen - 1)
Case Else: GetRegistry = "Not Found"
End Select

RegCloseKey hKey
End Function
Private Function WriteRegistry(ByVal Key As String, _
ByVal Path As String, ByVal entry As String, _
ByVal value As String)

Dim hKey As Long
Dim lValueType As Long
Dim sResult As String
Dim lResultLen As Long

TheKey = -99
Select Case UCase(Key)
Case "HKEY_CLASSES_ROOT": TheKey = &H80000000
Case "HKEY_CURRENT_USER": TheKey = &H80000001
Case "HKEY_LOCAL_MACHINE": TheKey = &H80000002
Case "HKEY_USERS": TheKey = &H80000003
Case "HKEY_CURRENT_CONFIG": TheKey = &H80000004
Case "HKEY_DYN_DATA": TheKey = &H80000005
End Select

If TheKey = -99 Then
WriteRegistry = False
Exit Function
End If
If RegOpenKeyA(TheKey, Path, hKey) <> 0 Then
x = RegCreateKeyA(TheKey, Path, hKey)
End If
x = RegSetValueExA(hKey, entry, 0, 1, value, Len(value) + 1)
If x = 0 Then WriteRegistry = True Else WriteRegistry = False
End Function

Sub UpdateRegistryWithTime()
RootKey = "hkey_current_user"
Path = "software\microsoft\office\9.0\excel\LastStarted"
RegEntry = "DateTime"
RegVal = Now()
LastTime = GetRegistry(RootKey, Path, RegEntry)
Debug.Print LastTime

Call WriteRegistry(RootKey, Path, RegEntry, RegVal)
End Sub
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Windows API/Registry - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия