Module PAWWMIRegistry
Option Compare Database
Option Explicit
Const HKLM = &H80000002 ' Registry const
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
'---------------------------------------------------------------------------------------
' Procedure : CreateRegKeyHKLM
' Author : Patrick Wood http://gainingaccess.net/
' Date : 3/22/2010
' Purpose : Create a HKEY_LOCAL_MACHINE Registry subkey.
' Example : Call CreateRegKeyHKLM("SOFTWARE\ATestKey")
'---------------------------------------------------------------------------------------
'
Sub CreateRegKeyHKLM(strKeyPath As String)
On Error Resume Next
Dim objReg As Object
Dim lngReturn As Long
Dim strComputer As String
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
lngReturn = objReg.CreateKey(HKEY_LOCAL_MACHINE, strKeyPath)
' If the lngReturn value is 0 the subkey was saved successfully.
If lngReturn > 0 Then
Debug.Print "Create Registry Key failed. Wbem Error Number " & lngReturn
End If
If Err.Number > 0 Then
Debug.Print "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In procedure CreateStringValueHKCU"
End If
Set objReg = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : CreateRegKeyHKCU
' Author : Patrick Wood http://gainingaccess.net/
' Date : 3/22/2010
' Purpose : Create a HKEY_CURRENT_USER Registry subkey.
' Example : Call CreateRegKeyHKCU("SOFTWARE\ATestKey")
'---------------------------------------------------------------------------------------
'
Sub CreateRegKeyHKCU(strKeyPath As String)
On Error Resume Next
Dim objReg As Object
Dim lngReturn As Long
Dim strComputer As String
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
lngReturn = objReg.CreateKey(HKEY_CURRENT_USER, strKeyPath)
' If the lngReturn value is 0 the subkey was saved successfully.
If lngReturn > 0 Then
Debug.Print "Create Registry Key failed. Wbem Error Number " & lngReturn
End If
If Err.Number > 0 Then
Debug.Print "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In procedure CreateStringValueHKCU"
End If
Set objReg = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : RegWriteStringValue
' Author : Patrick Wood http://gainingaccess.net/
' Date : 3/22/2010
' Purpose : Write a new subkey, StringValueName, and StringValue to the Registry
'---------------------------------------------------------------------------------------
'
Sub RegWriteStringValue()
Dim WshShell As Object
Set WshShell = CreateObject( "WScript.Shell")
WshShell.RegWrite "HKCU\Software\ANewTestKey\MyStringValue", "My New Value", "REG_SZ"
Set WshShell = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : RegWriteDWORDValue
' Author : Patrick Wood http://gainingaccess.net/
' Date : 3/22/2010
' Purpose : Write a new subkey, DWORDValueName, and DWORDValue to the Registry
'---------------------------------------------------------------------------------------
'
Sub RegWriteDWORDValue()
Dim WshShell As Object
Set WshShell = CreateObject( "WScript.Shell")
WshShell.RegWrite "HKCU\Software\ANewTesKey\MyDWORDValue", 651545474, "REG_DWORD"
Set WshShell = Nothing
End Sub
Back to Top of Code
'--------------------------------------------------------------------------------------------------------
' Hey, Scripting Guy! How can I retrieve the path to the Program Files folder on a computer?
' -- CC
' http://blogs.technet.com/heyscriptingguy/archive/2005/12/22/how-can-i-retrieve-the-path-to-the-program-files-folder-on-a-computer.aspx
'---------------------------------------------------------------------------------------
' Procedure : GetProgFilesDirPath
' Date : 1/7/2010
' : Code adapted from VBScript by Patrick Wood
' Purpose : Get the computer's Program Files Path
'---------------------------------------------------------------------------------------
'
Function GetProgFilesPath() As String
Dim objReg As Object
Dim strComputer As String
Dim strKeyPath As String
Dim ValueName As String
Dim strValue
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion"
ValueName = "ProgramFilesDir"
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, ValueName, strValue
GetProgFilesPath = strValue
Debug.Print GetProgFilesPath
End Function
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : CopyFile
' Date : 1/8/2010
' Author : Patrick Wood http://gainingaccess.net/
' Purpose : Copy a file to the Program Files Directory and then close this database.
'---------------------------------------------------------------------------------------
'
Sub CopyFile()
Dim strFilePath As String
Dim strProgFilesPath As String
' The path and name of the database to copy
strFilePath = "C:\MainDB.mdb"
' Get the Program Files Directory Path
strProgFilesPath = GetProgFilesPath
' Copy the Database to the Program Files Directory
FileCopy strFilePath, strProgFilesPath & "\MainDB.mdb"
' We are finished with this DB so close it
' Application.Quit
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Read multiple type values from a Registry SubKey
'---------------------------------------------------------------------------------------
' Procedure : GetHKLMRegValues
' Purpose : Use an Array to get security data from the Registry
' Example : Call GetHKLMRegValues("SYSTEM\CurrentControlSet\Control\Lsa")
'---------------------------------------------------------------------------------------
'
Sub GetHKLMRegValues(strKeyPath As String)
Dim objReg As Object
Dim strComputer As String
Dim estrValue As String
Dim i As Long
Dim arrEntryNames
Dim arrValueTypes
Dim arrValues
Dim arrValue
Dim byteValue
Dim dwValue
Dim strValue
Dim lngCount As Long
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
' Use an array to access the data
objReg.EnumValues HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames, arrValueTypes
Debug.Print "HKEY_LOCAL_MACHINE\" & strKeyPath
Debug.Print "========================================"
' Loop through the array
For i = 0 To UBound(arrEntryNames)
lngCount = lngCount + 1
Debug.Print " "
Debug.Print "------------------" & lngCount & "-------------------"
Debug.Print "Entry Name: " & arrEntryNames(i)
' Get the different types of array items values
Select Case arrValueTypes(i)
Case REG_SZ
Debug.Print "Data Type: String"
objReg.GetStringValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), strValue
Debug.Print "Value: " & strValue
Case REG_EXPAND_SZ
Debug.Print "Data Type: Expanded String"
objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), estrValue
Debug.Print "Value: " & estrValue
Case REG_BINARY
Debug.Print "Data Type: Binary"
objReg.GetBinaryValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), arrValue
For Each byteValue In arrValue
Debug.Print "Value: " & byteValue & " "
Next
Debug.Print vbCrLf
Case REG_DWORD
Debug.Print "Data Type: DWORD"
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), dwValue
Debug.Print "Value: " & dwValue
Case REG_MULTI_SZ
Debug.Print "Data Type: Multi String"
objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), arrValues
For Each strValue In arrValues
Debug.Print strValue
Next
End Select
Next i
Set objReg = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Save multiple type values from a User Registry SubKey to a text file.
'---------------------------------------------------------------------------------------
' Procedure : SaveUserRegValues
' Date : 6/6/2009
' Author : Patrick Wood http://gainingaccess.net/
' Purpose : Use an Array to get security data from the Registry
' Example : Call SaveUserRegValues("Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "C:\UserFileLocations.txt")
'---------------------------------------------------------------------------------------
'
Sub SaveUserRegValues(strKeyPath As String, strTextFilePath As String)
Dim objReg As Object
Dim fso As Object
Dim fsoFile As Object
Dim strComputer As String
Dim estrValue As String
Dim i As Long
Dim arrEntryNames
Dim arrValueTypes
Dim arrValues
Dim arrValue
Dim byteValue
Dim dwValue
Dim strValue
Set fso = CreateObject( "Scripting.FileSystemObject")
Set fsoFile = fso.CreateTextFile(strTextFilePath)
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
' Use an array to access the data
objReg.EnumValues HKEY_CURRENT_USER, _
strKeyPath, arrEntryNames, arrValueTypes
' Begin writing to the text file
fsoFile.WriteLine "HKEY_CURRENT_USER\" & strKeyPath
fsoFile.WriteLine "========================================"
' Loop through the array
For i = 1 To UBound(arrEntryNames)
fsoFile.WriteLine " "
fsoFile.WriteLine "-------------------------------------"
fsoFile.WriteLine "Entry Name: " & arrEntryNames(i)
' Write the different types of array items values
Select Case arrValueTypes(i)
Case REG_SZ
fsoFile.WriteLine "Data Type: String"
objReg.GetStringValue HKEY_CURRENT_USER, _
strKeyPath, arrEntryNames(i), strValue
fsoFile.WriteLine "Value: " & strValue
Case REG_EXPAND_SZ
fsoFile.WriteLine "Data Type: Expanded String"
objReg.GetExpandedStringValue HKEY_CURRENT_USER, _
strKeyPath, arrEntryNames(i), estrValue
fsoFile.WriteLine "Value: " & estrValue
Case REG_BINARY
fsoFile.WriteLine "Data Type: Binary"
objReg.GetBinaryValue HKEY_CURRENT_USER, _
strKeyPath, arrEntryNames(i), arrValue
For Each byteValue In arrValue
fsoFile.WriteLine "Value: " & byteValue & " "
Next
fsoFile.WriteLine vbCrLf
Case REG_DWORD
fsoFile.WriteLine "Data Type: DWORD"
objReg.GetDWORDValue HKEY_CURRENT_USER, _
strKeyPath, arrEntryNames(i), dwValue
fsoFile.WriteLine "Value: " & dwValue
Case REG_MULTI_SZ
fsoFile.WriteLine "Data Type: Multi String"
objReg.GetMultiStringValue HKEY_CURRENT_USER, _
strKeyPath, arrEntryNames(i), arrValues
For Each strValue In arrValues
fsoFile.WriteLine strValue
Next
End Select
Next i
fsoFile.Close
Set fsoFile = Nothing
Set fso = Nothing
Set objReg = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Save multiple type values from a Registry SubKey to a text file.
'---------------------------------------------------------------------------------------
' Procedure : SaveRegValues
' Date : 6/6/2009
' Author : Patrick Wood http://gainingaccess.net/
' Purpose : Use an Array to get security data from the Registry
' Example : Call SaveRegValues("SYSTEM\CurrentControlSet\Control\Lsa", "C:\RegistryValues.txt")
'---------------------------------------------------------------------------------------
'
Sub SaveRegValues(strKeyPath As String, strTextFilePath As String)
On Error GoTo ErrHandle
Dim objReg As Object
Dim fso As Object
Dim fsoFile As Object
Dim strComputer As String
Dim estrValue As String
Dim i As Long
Dim arrEntryNames
Dim arrValueTypes
Dim arrValues
Dim arrValue
Dim byteValue
Dim dwValue
Dim strValue
Set fso = CreateObject( "Scripting.FileSystemObject")
Set fsoFile = fso.CreateTextFile(strTextFilePath)
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
' Use an array to access the data
objReg.EnumValues HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames, arrValueTypes
' Begin writing to the text file
fsoFile.WriteLine "HKEY_LOCAL_MACHINE\" & strKeyPath
fsoFile.WriteLine "========================================"
' Loop through the array
For i = 1 To UBound(arrEntryNames)
fsoFile.WriteLine " "
fsoFile.WriteLine "-------------------------------------"
fsoFile.WriteLine "Entry Name: " & arrEntryNames(i)
' Write the different types of array items values
Select Case arrValueTypes(i)
Case REG_SZ
fsoFile.WriteLine "Data Type: String"
objReg.GetStringValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), strValue
fsoFile.WriteLine "Value: " & strValue
Case REG_EXPAND_SZ
fsoFile.WriteLine "Data Type: Expanded String"
objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), estrValue
fsoFile.WriteLine "Value: " & estrValue
Case REG_BINARY
fsoFile.WriteLine "Data Type: Binary"
objReg.GetBinaryValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), arrValue
For Each byteValue In arrValue
fsoFile.WriteLine "Value: " & byteValue & " "
Next
fsoFile.WriteLine vbCrLf
Case REG_DWORD
fsoFile.WriteLine "Data Type: DWORD"
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), dwValue
fsoFile.WriteLine "Value: " & dwValue
Case REG_MULTI_SZ
fsoFile.WriteLine "Data Type: Multi String"
objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, _
strKeyPath, arrEntryNames(i), arrValues
For Each strValue In arrValues
fsoFile.WriteLine strValue
Next
End Select
Next i
fsoFile.Close
Set fsoFile = Nothing
Set fso = Nothing
Set objReg = Nothing
ExitHere:
Exit Sub
ErrHandle:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In procedure SaveRegValues"
Resume ExitHere
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : GetRegCountryCodes
' Author : Patrick Wood http://gainingaccess.net/
' Purpose : Get Country Names matched to Numbers from the Registry
' Example : Call GetRegCountryCodes("tblCountries")
'---------------------------------------------------------------------------------------
'
Sub GetRegCountryCodes(strTable As String)
On Error Resume Next
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objReg As Object
Dim strComputer As String
Dim strKeyPath As String
Dim strValue As String ' The Entry Value
Dim strValueName As String
Dim arrSubKeys
Dim SubKey
strComputer = "."
Set db = CurrentDb
'Set up the file.
Set rst = db.OpenRecordset(strTable, dbOpenDynaset)
' The NamesSpace is not "\root\cimv2" but "\root\default:StdRegProv"
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
' The Registry Path we need to access
strKeyPath = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Telephony\Country List"
strValueName = "Name" ' The name of the Entry from which to get the value
' Create an Array of the Subkeys
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Loop through the Array Add the records to the Table
For Each SubKey In arrSubKeys
' Get the Country name from the Subkey Entry "Name" using the strValue variable
objReg.GetStringValue HKLM, strKeyPath & "\" & SubKey, strValueName, strValue
' Append the information to the Table
rst.AddNew
rst!CountryID = SubKey
rst!CountryName = strValue
rst.Update
Next
rst.Close
Set objReg = Nothing
Set rst = Nothing
Set db = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : SaveSelectCaseCountries
' Author : Patrick Wood http://gainingaccess.net/
' Purpose : Save Procedure Select Case Country Names from the Registry as a text file
' Example : Call SaveSelectCaseCountries("C:\CountriesSelectCase.txt") or
' : Call SaveSelectCaseCountries("C:\CountriesSelectCase.bas")
'---------------------------------------------------------------------------------------
'
Sub SaveSelectCaseCountries(strTxtFilePath As String)
Dim objReg As Object
Dim strComputer As String
Dim strKeyPath As String
Dim strValue As String
Dim strValueName As String
Dim fso As Object
Dim fsoFile As Object
Dim arrSubKeys
Dim SubKey
strComputer = "."
Set fso = CreateObject( "Scripting.FileSystemObject")
Set fsoFile = fso.CreateTextFile(strTxtFilePath)
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Telephony\Country List"
strValueName = "Name"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
fsoFile.WriteLine "Option Compare Database"
fsoFile.WriteLine "Option Explicit"
fsoFile.WriteBlankLines (1)
fsoFile.WriteLine "Function GetCountryName(strNumber As String) As String"
fsoFile.WriteBlankLines (1)
fsoFile.WriteLine " Select Case strNumber"
For Each SubKey In arrSubKeys
objReg.GetStringValue HKLM, strKeyPath & "\" & SubKey, strValueName, strValue
' Write the value as a String
fsoFile.WriteLine " Case """ & SubKey & """"
fsoFile.WriteLine " GetCountryName = """ & strValue & """"
Next
fsoFile.WriteLine " Case Else"
fsoFile.WriteLine " GetCountryName = ""Unknown"""
fsoFile.WriteLine " End Select"
fsoFile.WriteBlankLines (1)
fsoFile.WriteLine "End Function"
fsoFile.Close
Set fsoFile = Nothing
Set fso = Nothing
Set objReg = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Procedure : SaveSelectCaseCountryNo
' Date : 6/06/2009
' Author : Patrick Wood http://gainingaccess.net/
' Purpose : Save Country Names and the codes as Strings from the Registry as a Procedure using
' : Select Case in a text file
' Example : Call SaveSelectCaseCountryNo("C:\CountriesSelectCaseNo.txt") or
' : Call SaveSelectCaseCountryNo("C:\CountriesSelectCaseNo.bas")
'---------------------------------------------------------------------------------------
'
Sub SaveSelectCaseCountryNo(strTxtFilePath As String)
Dim objReg As Object
Dim fso As Object
Dim fsoFile As Object
Dim strComputer As String
Dim strKeyPath As String
Dim strValue As String
Dim strValueName As String
Dim arrSubKeys
Dim SubKey
strComputer = "."
Set fso = CreateObject( "Scripting.FileSystemObject")
Set fsoFile = fso.CreateTextFile(strTxtFilePath)
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Telephony\Country List"
strValueName = "Name"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
fsoFile.WriteLine "Option Compare Database"
fsoFile.WriteLine "Option Explicit"
fsoFile.WriteBlankLines (1)
fsoFile.WriteLine "Function GetCountryNameNo(lngNumber As Long) As String"
fsoFile.WriteBlankLines (1)
fsoFile.WriteLine " Select Case lngNumber"
For Each SubKey In arrSubKeys
objReg.GetStringValue HKLM, strKeyPath & "\" & SubKey, strValueName, strValue
' Write the value as an Integer
fsoFile.WriteLine " Case Is = " & SubKey
fsoFile.WriteLine " GetCountryNameNo = """ & strValue & """"
Next
fsoFile.WriteLine " Case Else"
fsoFile.WriteLine " GetCountryNameNo = ""Unknown"""
fsoFile.WriteLine " End Select"
fsoFile.WriteBlankLines (1)
fsoFile.WriteLine "End Function"
fsoFile.Close
Set fsoFile = Nothing
Set fso = Nothing
Set objReg = Nothing
End Sub
Back to Top of Code
'--------------------------------------------------------------------
' Save data to the Access VBA Default Registry location:
' HKEY_CURRENT_USER\Software\VB and VBA Program Settings
' You must first enter an Application Title ("AppTitle") in the
' Menu Bar Tools > Startup "Application Title" textbox.
'--------------------------------------------------------------------
Sub SaveVBARegValue()
SaveSetting CurrentDb.Properties("AppTitle"), "StoredData", "MyKey", "My data."
End Sub
Back to Top of Code
'--------------------------------------------------------------------
' Read the data previously saved to the Access VBA Default Registry location
' To have different Settings for Different Databases give each database
' a unique AppTitle using the Menu or VBA.
' Author: Patrick Wood http://gainingaccess.net/
'--------------------------------------------------------------------
Sub ReadVBARegValue()
Debug.Print GetSetting(CurrentDb.Properties("AppTitle"), _
"StoredData", "MyKey", "myDefault")
End Sub
Back to Top of Code
' Several ways to read the same data from the Registry
Sub ReadRegKeyValue()
Dim strValue As String
Debug.Print GetSetting(CurrentDb.Properties("AppTitle"), _
"StoredData", "MyKey", "myDefault")
strValue = GetSetting(CurrentDb.Properties("AppTitle"), _
"StoredData", "MyKey", "Default")
Debug.Print strValue
Debug.Print GetSetting(CurrentDb.Properties("AppTitle"), _
"StoredData", "MyKey")
End Sub
Back to Top of Code
' Author: Patrick Wood http://gainingaccess.net/
' Read all of the Keys and their Values of a specified section
Sub GetAllKeyValues()
Dim varData As Variant
Dim i As Integer
varData = GetAllSettings(CurrentDb.Properties("AppTitle"), "StoredData")
For i = LBound(varData, 1) To UBound(varData, 1)
Debug.Print varData(i, 0) & " - " & varData(i, 1)
Next i
End Sub
Back to Top of Code
Sub DeleteRegKey()
DeleteSetting CurrentDb.Properties("AppTitle"), "StoredData", "MyKey"
End Sub
Back to Top of Code
Sub DeleteRegSection()
DeleteSetting CurrentDb.Properties("AppTitle"), "StoredData"
End Sub
Back to Top of Code
'--------------------------------------------------------------------
' Read a DWord registry value. Const REG_DWORD = 4
' Author: Patrick Wood http://gainingaccess.net/
'--------------------------------------------------------------------
Sub GetRegDWord()
Dim objReg As Object
Dim strComputer As String
Dim strKeyPath As String
Dim strValueName As String
Dim strDWordValue As String
Dim dwValue
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update"
strValueName = "AUOptions"
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, dwValue
strDWordValue = Nz(dwValue, "Null")
Select Case strDWordValue
Case "2"
strDWordValue = strDWordValue & " - Notify for download and notify for install."
Case "3"
strDWordValue = strDWordValue & " - Auto download and notify for install."
Case "4"
strDWordValue = strDWordValue & " - Auto download and schedule the install."
Case "Null"
strDWordValue = "Automatic Updates status is Unknown - No value was returned."
Case Else
strDWordValue = strDWordValue & " - Automatic Updates are not enabled."
End Select
Debug.Print strDWordValue
Set objReg = Nothing
End Sub
Back to Top of Code
'--------------------------------------------------------------------
' Read a string registry value Const REG_SZ = 1
' Author: Patrick Wood http://gainingaccess.net/
'--------------------------------------------------------------------
Sub GetRegString()
Dim objReg As Object
Dim strComputer As String
Dim strKeyPath As String
Dim strValueName As String
Dim strValue
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MSACCESS.EXE"
strValueName = "Path"
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
Debug.Print "Microsoft Access Location: " & strValue
Set objReg = Nothing
End Sub
Back to Top of Code
'--------------------------------------------------------------------
' Purpose : Read a multi-string registry value Const REG_MULTI_SZ = 7
' Author : Patrick Wood http://gainingaccess.net/
' Example : Call SaveRegSystemEventLog("C:\MyTextFile.txt")
'--------------------------------------------------------------------
Sub SaveRegSystemEventLog(strTextFilePath As String)
Dim objReg As Object
Dim fso As Object
Dim fsoFile As Object
Dim strComputer As String
Dim strValueName As String
Dim strKeyPath As String
Dim arrValues
Dim arrValue
Set fso = CreateObject( "Scripting.FileSystemObject")
Set fsoFile = fso.CreateTextFile(strTextFilePath)
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Services\Eventlog\System"
strValueName = "Sources"
objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
strValueName, arrValues
For Each arrValue In arrValues
fsoFile.WriteLine arrValue
' Debug.Print arrValue
Next
fsoFile.Close
Set fsoFile = Nothing
Set fso = Nothing
Set objReg = Nothing
End Sub
Back to Top of Code
'--------------------------------------------------------------------
' Read an expanded string registry value. Const REG_EXPAND_SZ = 2
' Author: Patrick Wood http://gainingaccess.net/
'--------------------------------------------------------------------
Sub ReadExpandedRegString()
Dim objReg As Object
Dim strComputer As String
Dim strValueName As String
Dim strKeyPath As String
Dim strValue
strComputer = "."
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon"
strValueName = "UIHost"
objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
strValueName, strValue
Debug.Print "The Windows logon UI host is: " & strValue
Set objReg = Nothing
End Sub
Back to Top of Code
'---------------------------------------------------------------------------------------
' Read a binary registry value. Const REG_BINARY = 3
' Author: Patrick Wood http://gainingaccess.net/
'---------------------------------------------------------------------------------------
Sub ReadBinaryRegValue(strTextFilePath As String)
Dim objReg As Object
Dim fso As Object
Dim fsoFile As Object
Dim strComputer As String
Dim strKeyPath As String
Dim strValueName As String
Dim i As Long
Dim varValue
Const HKEY_LOCAL_MACHINE = &H80000002
Set fso = CreateObject( "Scripting.FileSystemObject")
Set fsoFile = fso.CreateTextFile(strTextFilePath)
strComputer = "."
Set objReg = GetObject( "winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Office\11.0\Access"
strValueName = "AccessName"
objReg.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, _
strValueName, varValue
For i = LBound(varValue) To UBound(varValue)
fsoFile.WriteLine varValue(i)
Next
fsoFile.Close
Set fsoFile = Nothing
Set fso = Nothing
Set objReg = Nothing
End Sub
Back to Top of Code
This page was last updated Monday, April 19, 2010
For questions about this page, please email WebMaster