Questo invece riguarda le Info della CPU:
Programma Principale Va nel Fmain.frm:
Option Explicit
'****************************************************************
'* VB file: fMain.frm
'*
'* DEMO PROGRAM FOR USING FUNCTIONS IN CPUinf32.bas
'*
'* Copyright (c) 1998, Ray Mercer. All rights reserved.
'****************************************************************
Private Sub Check1_Click()
End Sub
Private Sub chkCMOS_Click()
If chkCMOS.Value = vbChecked Then
txtClocks.Text = "-1"
txtClocks.Enabled = False
Else
txtClocks.Text = "0"
txtClocks.Enabled = True
End If
End Sub
Private Sub cmdCallFunc_Click(Index As Integer)
Dim clocks As Long 'for cpuspeed functions
Dim vs As DLL_VER 'for version function
Select Case Index
Case 0
lblFuncRet(Index) = CBool(wincpuidsupport())
Case 1
lblFuncRet(Index) = ProcessorCount()
Case 2
Me.MousePointer = vbHourglass
If chkNormCMOS.Value = vbChecked Then
clocks = -1& 'use CMOS timer
Else
clocks = 0& 'use default
End If
lblFuncRet(Index) = cpunormspeed(clocks)
Me.MousePointer = vbDefault
Case 3
Me.MousePointer = vbHourglass
If chkRawCMOS.Value = vbChecked Then
clocks = -1& 'use CMOS timer
Else
clocks = 0& 'use default
End If
lblFuncRet(Index) = cpurawspeed(clocks)
Me.MousePointer = vbDefault
Case 4
lblFuncRet(Index) = GetCPUDescription()
Case 5
lblFuncRet(Index) = GetCPUDescriptionString(Verbose:=CBool(chkVerbose.Value))
Case 6
lblFuncRet(Index) = GetCPUModel()
Case 7
lblFuncRet(Index) = GetCPUType()
Case 8
lblFuncRet(Index) = wincpuid()
Case 9
lblFuncRet(Index) = CPUHasMMX()
Case 10
lblFuncRet(Index) = CPUHasFPU()
Case 11
lblFuncRet(Index) = CPUHasTimeStampCounter()
Case 12
Call GetDllVerString(vs)
lblFuncRet(Index) = vs.Major & "." & vs.Minor
End Select
End Sub
Private Sub cmdCPUSpeed_Click()
Dim freqinfo As FREQ_INFO
Dim clocks As Long
clocks = Val(txtClocks.Text)
Me.MousePointer = vbHourglass
Call vbcpuspeed(clocks, freqinfo)
With freqinfo
lstCPUSpeed.AddItem ("=================="
lstCPUSpeed.AddItem ("ex_ticks: " & .ex_ticks)
lstCPUSpeed.AddItem ("in_cycles: " & .in_cycles)
lstCPUSpeed.AddItem ("norm_freq: " & .norm_freq)
lstCPUSpeed.AddItem ("raw_freq: " & .raw_freq)
lstCPUSpeed.AddItem ("=================="
End With
Me.MousePointer = vbDefault
End Sub
Private Sub cmdTimeStamp_Click()
Dim ts As TIME_STAMP
Dim Output As String
Dim i As Long
If GetTimeStampCode(ts) Then
Output = Hex$(ts.dwHigh)
Output = Output & " : " & Hex$(ts.dwLow)
Call lstTimeStamp.AddItem(Output)
Else
MsgBox "CPU does not have timestamp register"
End If
End Sub
Questo codice va invece in mCPUInf32:
Option Explicit
'****************************************************************
'* VB file: CPUInf32.bas... for cpuinf32 DLL
'*
'* modified 9/25/98 to support vbCPUInf.dll v.1.00
'* modified 1/24/99 to support ID of Celeron A processor
'*
'* Original Intel DLL was compiled with _cdecl calling convention for
'* the functions in speed.h. Therefore it was necessary to create a
'* "VB-friendly" version of this DLL in order to call the speed benchmarking
'* functions. I have renamed the new VB-friendly DLL to "vbCPUInf.dll"
'* in order to avoid compatibility problems with Intel DLL.
'*
'* please contact me at raymer@macnica.co.jp if you are interested in
'* C - source code for the vbCPUInf.dll
'*
'*
'* VisualBasic Functions for obtaining CPU hardware information
'* for Intel(c) CPUs using the vbCPUInf.dll created by Intel
'*
'* Copyright (c) 1998, Ray Mercer. All rights reserved.
'****************************************************************
'
'//PRIVATE DECLARES SECTION (Not callable outside of this module)
'////////////////////////////////////////////////////////////////
Public Type TIME_STAMP
dwLow As Long 'Lower 32-bits of Time Stamp Register value
dwHigh As Long 'Upper 32-bits of Time Stamp Register value
End Type
Public Type DLL_VER
Minor As String 'Minor Version
Major As String 'Major Version
End Type
Public Type FREQ_INFO
in_cycles As Long ' Internal clock cycles during test
ex_ticks As Long ' Microseconds elapsed during test
raw_freq As Long ' Raw frequency of CPU in MHz
norm_freq As Long ' Normalized frequency of CPU in MHz
End Type
Private Declare Function wincpuidext Lib "vbCPUInf.dll" () As Integer
Private Declare Function wincpufeatures Lib "vbCPUInf.dll" () As Long
Private Declare Function winrdtsc Lib "vbCPUInf.dll" () As Currency
Private Declare Function getdllversion Lib "vbCPUInf.dll" () As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpvDest As Any, _
lpvSource As Any, _
ByVal cbCopy As Long)
'// PUBLIC DECLARES SECTION /////////////////////////////////////
'////////////////////////////////////////////////////////////////
'****************************************************************
'* FUNCTION wincpuidsupport() As Long
'* =================================
'* Wincpuidsupport() tells the caller whether the host processor
'* supports the CPUID opcode or not.
'*
'* Inputs: none
'*
'* Returns:
'* 1 = CPUID opcode is supported
'* 0 = CPUID opcode is not supported
'****************************************************************
Public Declare Function wincpuidsupport Lib "vbCPUInf.dll" () As Integer
'****************************************************************
'* FUNCTION wincpuid() As Long
'* ===============
'* This routine uses the standard Intel assembly code to
'* determine what type of processor is in the computer, as
'* described in application note AP-485 (Intel Order #241618).
'* Wincpuid() returns the CPU type as an integer (that is,
'* 2 bytes, a WORD) in the AX register.
'*
'* Returns:
'* 0 = 8086/88
'* 2 = 80286
'* 3 = 80386
'* 4 = 80486
'* 5 = Pentium(R) Processor
'* 6 = PentiumPro(R) Processor
'* 7 or higher = Processor beyond the PentiumPro6(R) Processor
'****************************************************************
Public Declare Function wincpuid Lib "vbCPUInf.dll" () As Long
'/***************************************************************
'* vbCpuSpeed() -- Return the raw clock rate of the host CPU.
'*
'* Inputs:
'* clocks: NULL: Use default value for number of cycles
'* per BSF instruction - note* default value is 10
'* Positive Integer: Use clocks value for number
'* of cycles per BSF instruction.
'* -1: Use CMos timer to calculate speed
'* (May not work for WinNT.
'* freqinfo: a FREQ_INFO struct (UDT) to fill
'*
'* Returns:
'* If error then return all zeroes in FREQ_INFO structure
'* Else return FREQ_INFO structure containing calculated
'* clock frequency, normalized clock frequency, number of
'* clock cycles during test sampling, and the number of
'* microseconds elapsed during the sampling.
'***************************************************************/
Public Declare Sub vbcpuspeed Lib "vbCPUInf.dll" (ByVal clocks As Long, ByRef freqinfo As FREQ_INFO)
'returns only FREQ_INFO.raw_freq member
Public Declare Function cpurawspeed Lib "vbCPUInf.dll" (ByVal clocks As Long) As Long
'returns only FREQ_INFO.norm_freq member
Public Declare Function cpunormspeed Lib "vbCPUInf.dll" (ByVal clocks As Long) As Long
'/***************************************************************
'* ProcessorCount() -- Return the number of CPU's on this machine.
'*
'* Inputs: (none)
'*
'* Returns:
'* count of the number of processors on this machine.
'***************************************************************/
Public Declare Function ProcessorCount Lib "vbCPUInf.dll" () As Long
'// PRIVATE FUNCTION SECTION (Not callable outside of this module)
'////////////////////////////////////////////////////////////////
'/***************************************************************
'/ based on a similar function in "Hardcore VB5" by Bruce McKinney
'/ by Ray Mercer
'/ returns:
'/ value of Specified Bit in a bitfield up to 32 bits long
'/ False=bit is not "set"(0)
'/ True=bit is "set"(1)
Private Function GetBit(ByVal iValue As Long, ByVal iBitPos As Integer) As Boolean
Debug.Assert iBitPos >= 0 And iBitPos <= 31
Dim BitVal As Long
Select Case iBitPos
Case 0
BitVal = &H1&
Case 1
BitVal = &H2&
Case 2
BitVal = &H4&
Case 3
BitVal = &H8&
Case 4
BitVal = &H10&
Case 5
BitVal = &H20&
Case 6
BitVal = &H40&
Case 7
BitVal = &H80&
Case 8
BitVal = &H100&
Case 9
BitVal = &H200&
Case 10
BitVal = &H400&
Case 11
BitVal = &H800&
Case 12
BitVal = &H1000&
Case 13
BitVal = &H2000&
Case 14
BitVal = &H4000&
Case 15
BitVal = &H8000&
Case 16
BitVal = &H10000
Case 17
BitVal = &H20000
Case 18
BitVal = &H40000
Case 19
BitVal = &H80000
Case 20
BitVal = &H100000
Case (21)
BitVal = &H200000
Case (22)
BitVal = &H400000
Case (23)
BitVal = &H800000
Case (24)
BitVal = &H1000000
Case (25)
BitVal = &H2000000
Case (26)
BitVal = &H4000000
Case (27)
BitVal = &H8000000
Case (28)
BitVal = &H10000000
Case (29)
BitVal = &H20000000
Case (30)
BitVal = &H40000000
Case (31)
BitVal = &H80000000
End Select
GetBit = iValue And BitVal
End Function
'// PUBLIC FUNCTION SECTION /////////////////////////////////////
'////////////////////////////////////////////////////////////////
'****************************************************************
'* FUNCTION GetCPUDescription() As Long
'* ==================
'* Returns a value which describes the currently installed CPU
'* according to the chart below:
'*
'* Inputs: none
'*
'* Outputs:
'* Value Meaning
'* ______________________________________
'* 64, 65 Intel 486
'* 66 Intel 486SX
'* 67 Intel 487, DX2, or OverDrive
'* 68 Intel 486SL
'* 69 Intel 486SX2
'* 71 Write-Back Enhanced Intel DX2
'* 72 Intel DX4 or DX4 OverDrive
'* 328 Intel DX4 OverDrive
'* 81 Pentium (60, 66)
'* 82 Pentium (75, 90, 100, 120, 133, 150, 166, 200)
'* 337 Pentium OverDrive (60, 66)
'* 338 Pentium OverDrive (75, 90, 100, 120, 133)
'* 339 Pentium OverDrive For 486
'* 84 Pentium with MMX (166, 200)
'* 340 Pentium OverDrive with MMX (75, 90, 100, 120, 133)
'* 97 Pentium Pro
'* 99 Pentium II model 3
'* 101 Pentium II model 5 or Celeron
'* 102 Celeron A
'* 355 reserved for future Pentium Pro OverDrive
'*
'****************************************************************
Public Function GetCPUDescription() As Long
Dim BitField As Long
Dim iType As Long
Dim iFamily As Long
Dim iModel As Long
iType = GetCPUType()
iFamily = wincpuid()
iModel = GetCPUModel()
iType = iType * 256 'shift left 8 bits
iFamily = iFamily * 16 'shift left 4 bits
BitField = iType Or iFamily Or iModel 'combine all ten bits
'10bit Bitfield Definitions
'Taken from Intel application note AP-485 (Intel Order #241618)
'TYPE FAMILY MODEL
'00 0100 0000 Intel 486
'00 0100 0001 Intel 486
'00 0100 0010 Intel 486SX
'00 0100 0011 Intel 487, DX2, or OverDrive
'00 0100 0100 Intel 486SL
'00 0100 0101 Intel 486SX2
'00 0100 0111 Write-Back Enhanced Intel DX2
'00 0100 1000 Intel DX4 or DX4 OverDrive
'01 0100 1000 Intel DX4 OverDrive
'00 0101 0001 Pentium (60, 66)
'00 0101 0010 Pentium (75, 90, 100, 120, 133, 150, 166, 200)
'01 0101 0001 Pentium OverDrive (60, 66)
'01 0101 0010 Pentium OverDrive (75, 90, 100, 120, 133)
'01 0101 0011 Pentium OverDrive For 486
'00 0101 0100 Pentium with MMX (166, 200)
'01 0101 0100 Pentium OverDrive with MMX (75, 90, 100, 120, 133)
'00 0110 0001 Pentium Pro
'00 0110 0011 Pentium II model 3
'00 0110 0101 Pentium II model 5 or Celeron
'01 0110 0011 reserved for future Pentium Pro OverDrive
GetCPUDescription = BitField
End Function
'****************************************************************
'* FUNCTION GetCPUDescriptionString(Optional ByVal Verbose As Boolean = True) As String
'* ==================
'* Returns a value which describes the currently installed CPU
'* according to the chart below:
'*
'* Inputs:
'* Verbose True (Default) = Long Description strings
'* False = Short Description strings
'* Outputs:
'* Returns a string containing a description of the currently installed CPU
'*****************************************************************
Public Function GetCPUDescriptionString(Optional ByVal Verbose As Boolean = True) As String
Dim CPU As Long
Dim Description As String
CPU = GetCPUDescription()
If Verbose Then
Select Case CPU
Case 64, 65
Description = "Intel 486 Processor"
Case 66
Description = "Intel 486SX Processor"
Case 67
Description = "Intel 487, DX2, or OverDrive Processor"
Case 68
Description = "Intel 486SL Processor"
Case 69
Description = "Intel 486SX2 Processor"
Case 71
Description = "Write-Back Enhanced Intel DX2 Processor"
Case 72
Description = "Intel DX4 or DX4 OverDrive Processor"
Case 328
Description = "Intel DX4 OverDrive Processor"
Case 81
Description = "Pentium Processor (60, 66)"
Case 82
Description = "Pentium Processor (75, 90, 100, 120, 133, 150, 166, 200)"
Case 337
Description = "Pentium OverDrive Processor (60, 66)"
Case 338
Description = "Pentium OverDrive Processor (75, 90, 100, 120, 133)"
Case 339
Description = "Pentium OverDrive Processor For 486-based Systems"
Case 84
Description = "Pentium Processor with MMX (166, 200)"
Case 340
Description = "Pentium OverDrive Processor with MMX (75, 90, 100, 120, 133)"
Case 97
Description = "Pentium Pro Processor"
Case 99
Description = "Pentium II Processor (model 3)"
Case 101
Description = "Pentium II (model 5) or Celeron Processor"
Case 102
Description = "Pentium II Celeron A Processor"
Case 355
Description = "Pentium Pro OverDrive Processor"
Case Else
Description = "Processor Type Unknown"
End Select
Else
Select Case CPU
Case 64 - 69, 71
Description = "486"
Case 72, 328
Description = "486DX4"
Case 81, 82, 337 - 339
Description = "Pentium"
Case 84, 340
Description = "PentiumMMX"
Case 97, 355
Description = "PentiumPro"
Case 99
Description = "PentiumII"
Case 101
Description = "PentiumII/Celeron"
Case 102
Description = "PentiumII/CeleronA"
Case Else
Description = "Unknown"
End Select
End If
GetCPUDescriptionString = Description
End Function
'****************************************************************
'* FUNCTION GetCPUModel() As Long
'* =================
'* AX(7:4) = CPU Model, if the processor supports the CPUID
'* opcode; zero otherwise
'* Inputs: none
'*
'* Returns:
'* the second-lowest nibble value of the return from wincpuidext()
'* (bits 7-4)
'* current Intel chip models range from 0 to 7
'****************************************************************
Public Function GetCPUModel() As Long
Dim BitField As Integer
Dim LowByte As Byte
BitField = wincpuidext()
'get LowByte of the 32bit return value while masking Lowest Nibble
LowByte = BitField And &HF0&
'shift High Nibble to LowNibble
If LowByte Then 'avoid divide by 0 error
GetCPUModel = LowByte / 16
End If
End Function
'****************************************************************
'* FUNCTION GetCPUType() As Long
'* =================
'* AX(13:12) = Processor type (00=Standard OEM CPU, 01=OverDrive,
'* 10=Dual CPU, 11=Reserved)
'* Inputs: none
'*
'* Returns:
'* 0 = Standard OEM CPU
'* 1 = OverDrive
'* 2 = Dual CPU
'* 3 = Unknown (Reserved)
'****************************************************************
Public Function GetCPUType() As Long
Dim BitField As Integer
Dim Bit1 As Boolean
Dim Bit2 As Boolean
Dim CPUType As Long
BitField = wincpuidext()
Bit1 = GetBit(BitField, 13)
Bit2 = GetBit(BitField, 12)
If Bit1 Then
If Bit2 Then
'11 - Reserved
CPUType = 3
Else
'10 - Dual CPU
CPUType = 2
End If
Else
If Bit2 Then
'01 - OverDrive
CPUType = 1
Else
'00 - Standard OEM CPU
CPUType = 0
End If
End If
GetCPUType = CPUType
End Function
'****************************************************************
'* FUNCTION wincpufeatures() As Long
'* ======================
'* Wincpufeatures() returns the CPU features flags as a DWORD
'* (that is, 32 bits).
'*
'* Inputs: none
'*
'* Returns:
'* 0 = Processor which does not execute the CPUID instruction.
'* This includes 8086, 8088, 80286, 80386, and some
'* older 80486 processors.
'*
'* Else
'* Feature Flags (refer to App Note AP-485 for description).
'* This DWORD was put into EDX by the CPUID instruction.
'*
'* Current flag assignment is as follows:
'*
'* bit31..25 reserved (unknown value)
'* bit24=1 Fast Floating Point Save And Restore supported
'* bit23=1 MMX
'* bits22..18 reserved (unknown value)
'* bit17=1 36-bit Page Size Extension supported
'* bit16=1 Page Attribute Table supported
'* bit15=1 Conditional Move Instruction spported
'* bit14=1 Machine Check Architecture (MCG_CAP) supported
'* bit13=1 Page Global Enable supported
'* bit12=1 Memory Type Range Registers (MTRR_CAP) supported
'* bit11=1 Fast System Call (SYSENTER, SYSEXIT) supported
'* bit10 reserved (unknown value)
'* bit9=1 CPU contains a local APIC (iPentium-3V)
'* bit8=1 CMPXCHG8B instruction supported
'* bit7=1 machine check exception supported
'* bit6=1 Physical Address Extension supported
'* bit5=1 iPentium-style MSRs supported
'* bit4=1 time stamp counter TSC supported
'* bit3=1 page size extensions supported
'* bit2=1 I/O breakpoints supported
'* bit1=1 enhanced virtual 8086 mode supported
'* bit0=1 CPU contains a floating-point unit (FPU)
'*
'* Note: New bits will be assigned on future processors... see
'* processor data books for updated information
'*
'* The following 3 functions call wincpufeatures to call for
'* 3 specific, individual flags which VB programmers might find useful
'****************************************************************
Public Function CPUHasMMX() As Boolean
'returns True if CPU has MMX
'and CPU supports CPUID instruction
Dim BitField As Long
BitField = wincpufeatures()
If BitField Then 'MMX CPUS should support CPUID Instructions
CPUHasMMX = GetBit(BitField, 23)
End If
End Function
Public Function CPUHasFPU() As Boolean
'returns True if CPU has a Floating Point Processor
'and CPU supports CPUID instruction
Dim BitField As Long
BitField = wincpufeatures()
If BitField Then
CPUHasFPU = GetBit(BitField, 0)
End If
End Function
Public Function CPUHasTimeStampCounter() As Boolean
'returns True if CPU has a TimeStampCounter register
'and CPU supports CPUID instruction
Dim BitField As Long
BitField = wincpufeatures()
If BitField Then
CPUHasTimeStampCounter = GetBit(BitField, 4)
End If
End Function
'****************************************************************
'* Function GetTimeStampCode()as Boolean
'* ============================
'* returns the value in the Time Stamp Counter (if one
'* exists).
'*
'* Inputs:
'* A UDT of type TIME_STAMP to recieve the 64bit value
'*
'* Returns:
'* False= CPU does not support the time stamp register
'*
'* Else
'* Returns True and loads the UDT with the number of clock cycles
'* since the CPU was powered up or reset. Since VB can't handle
'* 64bit integer values natively (Not even VB6!) we must use
'* a Currency type,a UDT, CopyMemory(),and VarPtr()
'* (Can you say "hack"?)
'*
'****************************************************************
Public Function GetTimeStampCode(ts As TIME_STAMP) As Boolean
Dim curTS As Currency
curTS = winrdtsc() 'retrieve 64bit value as currency
If curTS Then
CopyMemory ts.dwHigh, curTS, 4
CopyMemory ts.dwLow, ByVal VarPtr(curTS) + 4, 4
GetTimeStampCode = True
End If
End Function
'****************************************************************
'* Function getdllversion()
'* ==============================
'* Getdllversion() returns the Major and minor version of the
'* CPUInf32 DLL.
'*
'* Inputs: none
'*
'* Returns: Major and Minor version of this DLL.
'*
'* i.e. getdllversion() = 0x01 00
'* Major Version<--|-->Minor Version
'*
'****************************************************************
Public Sub GetDllVerString(verString As DLL_VER)
Dim ver As Integer
Dim tmpRes As Integer
Dim hi As Byte
Dim lo As Byte
ver = getdllversion()
hi = (ver And &HFF00) / &HFF
lo = ver And &HFF
verString.Major = Format$(hi, "##0"
verString.Minor = Format$(lo, "##00"
End Sub
maximilian
