Extract System Info From the Registry

Category:
Registry
Type:
Applications
Difficulty:
Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:
This code will help you extract system information from the registry, such as Owner Name, Windows OS Name, Service Pack Version, and whether the Dot Net Framework version 2.0 is installed. This project requires six modules and one form. Be sure to add five command button controls named accordingly to demo.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:

Code:'Copy this in a module Public hKey As Long Dim rtnsGetDotNetVersion() As String Dim blnRegKeyFound As Boolean Dim strVersion As String '************************************************************************************************************************ 'Author : 'Module : Generic 'Use : Gets the Windows Owner Name 'Method Of Usage: Using Windows Registry ' - Open the registry key: HKLM\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion '************************************************************************************************************************ Public Function sGetOwnerName() Dim sValue As String Dim lLenData As Long Dim lResult As Long Dim sValueName As String Dim lHandle As Long sValueName = "RegisteredOwner" lResult = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", lHandle) If lResult = 0 Then lResult = RegQueryValueEx(lHandle, sValueName, 0&, REG_SZ, "", lLenData) End If If lResult = ERROR_MORE_DATA Then sValue = Space(lLenData) lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, ByVal sValue, lLenData) End If If lResult = 0 Then sValue = Left(sValue, lLenData - 1) End If sGetOwnerName = sValue End Function '************************************************************************************************************************ 'Author : 'Module : Generic 'Use : Gets the Windows Directory Path 'Method Of Usage: Using Windows Registry ' - Open the registry key: HKLM\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion '************************************************************************************************************************ Public Function sGetWindowsPath() Dim sValue As String Dim lLenData As Long Dim lResult As Long Dim sValueName As String Dim lHandle As Long sValueName = "SystemRoot" lResult = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", lHandle) If lResult = 0 Then lResult = RegQueryValueEx(lHandle, sValueName, 0&, REG_SZ, "", lLenData) End If If lResult = ERROR_MORE_DATA Then sValue = Space(lLenData) lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, ByVal sValue, lLenData) End If If lResult = 0 Then sValue = Left(sValue, lLenData - 1) End If sGetWindowsPath = sValue End Function '************************************************************************************************************************ 'Author : 'Module : Generic 'Use : Get the Windows Operating System 'Method Of Usage: Using Windows Registry ' - Open the registry key: HKLM\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion '************************************************************************************************************************ Public Function sGetWindowsOSName() Dim sValue As String Dim lLenData As Long Dim lResult As Long Dim sValueName As String Dim lHandle As Long sValueName = "ProductName" lResult = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", lHandle) If lResult = 0 Then lResult = RegQueryValueEx(lHandle, sValueName, 0&, REG_SZ, "", lLenData) End If If lResult = ERROR_MORE_DATA Then sValue = Space(lLenData) lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, ByVal sValue, lLenData) End If If lResult = 0 Then sValue = Left(sValue, lLenData - 1) End If sGetWindowsOSName = sValue End Function '************************************************************************************************************************ 'Author : 'Module : Generic 'Use : Get the Windows Service Pack Version 'Method Of Usage: Using Windows Registry ' - Open the registry key: HKLM\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion '************************************************************************************************************************ Public Function sGetWindowsServicePk() Dim sValue As String Dim lLenData As Long Dim lResult As Long Dim sValueName As String Dim lHandle As Long sValueName = "CSDVersion" lResult = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", lHandle) If lResult = 0 Then lResult = RegQueryValueEx(lHandle, sValueName, 0&, REG_SZ, "", lLenData) End If If lResult = ERROR_MORE_DATA Then sValue = Space(lLenData) lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, ByVal sValue, lLenData) End If If lResult = 0 Then sValue = Left(sValue, lLenData - 1) End If sGetWindowsServicePk = sValue End Function '************************************************************************************************************************ 'Author : 'Module : Generic 'Use : Detect Presence Of DOT NET FRAMEWORK 2.0 'Method Of Usage: Using Windows Registry ' - Open the registry key: HKLM\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion '************************************************************************************************************************ Public Function sGetDotNetVersion(Optional strKey As String) Dim hKey As Long, Cnt As Long, sName As String, sData As String, Ret As Long, RetData As Long Const BUFFER_SIZE As Long = 255 Dim rtnsGetDotNetVersion() If blnRegKeyFound Then Exit Function End If Ret = BUFFER_SIZE 'Open the registry key If RegOpenKey(HKEY_LOCAL_MACHINE, strKey, hKey) = 0 Then 'Create a buffer sName = Space(BUFFER_SIZE) 'Enumerate the keys While RegEnumKeyEx(hKey, Cnt, sName, Ret, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> ERROR_NO_MORE_ITEMS ReDim Preserve rtnsGetDotNetVersion(Cnt) 'Show the enumerated key rtnsGetDotNetVersion(Cnt) = " " + Left$(sName, Ret) 'prepare for the next key sName = Trim(sName) sName = Left(sName, Len(sName) - 1) If Left(sName, 2) = "v2" Then strVersion = sName sGetDotNetVersion = sName blnRegKeyFound = True Exit Function End If sGetDotNetVersion strKey & "\" & sName Cnt = Cnt + 1 sName = Space(BUFFER_SIZE) Ret = BUFFER_SIZE sGetDotNetVersion = strVersion Wend 'close the registry key RegCloseKey hKey End If If sGetDotNetVersion = vbNullString Then sGetDotNetVersion = "Dot Net version 2 not found." End If End Function 'Add This to a Form Private Sub cmdDotNet_Click() 'This will return blank if DotNet version 2.0 is not found MsgBox sGetDotNetVersion End Sub Private Sub cmdOs_Click() MsgBox sGetWindowsOSName End Sub Private Sub cmdOwner_Click() MsgBox sGetOwnerName End Sub Private Sub cmdPath_Click() MsgBox sGetWindowsPath End Sub Private Sub cmdServicePk_Click() MsgBox sGetWindowsServicePk End Sub