'**************************************
'Windows API/Global Declarations for :Ge
'     t CPU Onformation
'**************************************
 
 
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.
' By: Serge
'
' Assumes:Listbox (List1) and a Command  
'     Button (Command1)
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/xq/ASP/txtCode
'     Id.4977/lngWId.1/qx/vb/scripts/ShowCode.
'     htm'for details.'**************************************
 
 
 
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