RegPasswordCache



'Registry Password Cache ON

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 REG_NONE = (0) 'No value Type
Public Const REG_SZ = (1) 'Unicode nul terminated String
Public Const REG_EXPAND_SZ = (2)
'Unicode nul terminated String w/enviornment var

Public Const REG_BINARY = (3) 'Free form binary
Public Const REG_DWORD = (4) '32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = (4)
'32-bit number (same as REG_DWORD)

Public Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
Public Const REG_LINK = (6) 'Symbolic Link (unicode)
Public Const REG_MULTI_SZ = (7) 'Multiple Unicode strings
Public Const REG_RESOURCE_LIST = (8) 'Resource list In the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR = (9)
'Resource list In the hardware description

Public Const REG_RESOURCE_REQUIREMENTS_LIST = (10)

Public Const REG_OPTION_NON_VOLATILE = 0
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_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And _
(Not SYNCHRONIZE))

Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal _
lpSubKey As String, phkResult As Long) As Long

'The above code creates new registry key - Short Form


Declare Function RegCreateKeyEx Lib "advapi32.dll" _
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, _
lpSecurityAttributes As Any, _
phkResult As Long, lpdwDisposition As Long) As Long

'The above code creates new registry key - Long Form


Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

'The above code closes registry key


Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpszSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long

'The above code opens registry key


Declare Function RegQueryValueEx Lib "advapi32" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpszValueName As String, _
ByVal dwReserved As Long, _
lpdwType As Long, _
lpbData As Any, _
cbData As Long) As Long

'The above code queries registry key for value


Declare Function RegSetValueEx Lib "advapi32" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpszValueName As String, _
ByVal dwReserved As Long, _
ByVal fdwType As Long, _
lpbData As Any, _
ByVal cbData As Long) As Long

'The above code sets the value of a Registry Key - not a string


Declare Function RegSetStringEx Lib "advapi32" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpszValueName As String, _
ByVal dwReserved As Long, _
ByVal fdwType As Long, _
lpbData As String, _
ByVal cbData As Long) As Long

Public Sub PasswordCache_On()
'Purpose: Creates a Registry key that allows password caching for

Dim Reg_HKey As Long 'Branch of the Registry
Dim Reg_Path As String 'Path in the Registry
Dim Reg_Value As String 'New Key Value To add
Dim Reg_DataType As Long 'Key Data Type
Dim Reg_Data As Long 'Data To go In the key
Dim keyhand As Long
Dim r As Long, IsNewKey As Long
DoCmd.Hourglass True
Reg_HKey = HKEY_LOCAL_MACHINE
Reg_Path = "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Network"
Reg_Value = "DisablePwdCaching"
Reg_DataType = REG_NONE
'Long Form Create Key

r = RegCreateKeyEx(Reg_HKey, Reg_Path, 0&, _
REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
ByVal 0&, keyhand, IsNewKey)
r = RegSetValueEx(keyhand, Reg_Value, _
ByVal 0&, Reg_DataType, _
Reg_Data, Len(Reg_Data))
DoCmd.Hourglass False
End Sub

(regpasswordcache.html)- by Paolo Puglisi - Modifica del 25/3/2019