SystemInfo

Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
'Maintenance string For PSS usage

End Type
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub GetSystemInfo Lib "kernel32" _
(lpSystemInfo As SYSTEM_INFO)
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, _
ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const PROCESSOR_INTEL_386 = 386
Private Const PROCESSOR_INTEL_486 = 486
Private Const PROCESSOR_INTEL_PENTIUM = 586
Private Const PROCESSOR_LEVEL_80386 As Long = 3
Private Const PROCESSOR_LEVEL_80486 As Long = 4
Private Const PROCESSOR_LEVEL_PENTIUM As Long = 5
Private Const PROCESSOR_LEVEL_PENTIUMII As Long = 6
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Type udtCPU
lClockSpeed As Variant
lProcType As Integer
strProcLevel As String
strProcRevision As String
lNumberOfProcessors As Long
End Type
Public Enum eVersion
eWindowsNT = 1
eWindows95_98 = 2
eUnknown = 3
End Enum
'*******************************************************

' Name: Get CPU Onformation

' Description:

' This will get the CPU info. Note that approximate

' Clock speed can be determined only for WindowsNT.

' Assumes:Listbox (List1) and a Command Button (Command1)

'-------------------------------------------------------

Public Function GetCPUInfo(ptCPUInfo As udtCPU)
Dim tSYS As SYSTEM_INFO
Dim intProcType As Integer
Dim strProcLevel As String
Dim strProcRevision As String
Call GetSystemInfo(tSYS)
Select Case tSYS.dwProcessorType
Case PROCESSOR_INTEL_386: intProcType = 386
Case PROCESSOR_INTEL_486: intProcType = 486
Case PROCESSOR_INTEL_PENTIUM: intProcType = 586
End Select
Select Case tSYS.wProcessorLevel
Case PROCESSOR_LEVEL_80386: strProcLevel = _
"Intel 80386"
Case PROCESSOR_LEVEL_80486: strProcLevel = _
"Intel 80486"
Case PROCESSOR_LEVEL_PENTIUM: strProcLevel = _
"Intel Pentium"
Case PROCESSOR_LEVEL_PENTIUMII: strProcLevel = _
"Intel Pentium Pro or Pentium II"
End Select
strProcRevision = "Model " & _
HiByte(tSYS.wProcessorRevision) & ", Stepping " & _
LoByte(tSYS.wProcessorRevision)
With ptCPUInfo
.lClockSpeed = GetCPUSpeed
.lNumberOfProcessors = tSYS.dwNumberOfProcessors
.lProcType = intProcType
.strProcLevel = IIf(strProcLevel = "", "None", strProcLevel)
.strProcRevision = IIf(strProcRevision = "", "None", strProcRevision)
End With
End Function

Private Function GetVersion() As eVersion
Dim os As OSVERSIONINFO
os.dwOSVersionInfoSize = Len(os)
If GetVersionEx(os) Then
If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
GetVersion = eWindowsNT
Else
GetVersion = eWindows95_98
End If
Else
GetVersion = eUnknown
End If
End Function



Public Function HiByte(ByVal wParam As Integer) As Byte
HiByte = (wParam And &HFF00&) \ (&H100)
End Function

Public Function LoByte(ByVal wParam As Integer) As Byte
LoByte = wParam And &HFF&
End Function

Private Function GetCPUSpeed() As Variant
Dim hKey As Long
Dim lClockSpeed As Long
Dim strKey As String
If GetVersion = eWindowsNT Then
strKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Call RegOpenKey(HKEY_LOCAL_MACHINE, strKey, hKey)
Call RegQueryValueEx(hKey, "~MHz", 0, 0, lClockSpeed, 4)
Call RegCloseKey(hKey)
GetCPUSpeed = lClockSpeed
Else
GetCPUSpeed = "Could not be determined"
End If
End Function

Private Sub Command1_Click()
Dim tCPU As udtCPU
Call GetCPUInfo(tCPU)
List1.AddItem "CPU Type: " & tCPU.lProcType
List1.AddItem "Number ofCPUs:" & tCPU.lNumberOfProcessors
List1.AddItem "CPU Level: " & tCPU.strProcLevel
List1.AddItem "CPU Revision:" & tCPU.strProcRevision
List1.AddItem "CPU Speed (Approx): " & tCPU.lClockSpeed
End Sub