Donne des informations sur votre système
Soyez le premier à donner votre avis sur cette source.
Vue 6 201 fois - Téléchargée 606 fois
Description
Donne des informations sur votre système
Source / Exemple :
' Form
Private Sub cmdCallFunc_Click(Index As Integer)
Select Case Index
Case 0
lblFuncRet(Index) = CBool(wincpuidsupport())
Case 1
lblFuncRet(Index) = ProcessorCount()
Case 2
Me.MousePointer = vbHourglass
lblFuncRet(Index) = cpunormspeed()
Me.MousePointer = vbDefault
Case 3
Me.MousePointer = vbHourglass
lblFuncRet(Index) = cpurawspeed()
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
Dim vs As DLL_VER
Call GetDllVerString(vs)
lblFuncRet(Index) = vs.Major & "." & vs.Minor
End Select
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
' 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
Private Declare Function wincpuidext Lib "CpuInf32.dll" () As Integer
Private Declare Function wincpufeatures Lib "CpuInf32.dll" () As Long
Private Declare Function winrdtsc Lib "CpuInf32.dll" () As Currency
Private Declare Function getdllversion Lib "CpuInf32.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 "CpuInf32.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 "CpuInf32.dll" () As Long
Public Declare Function cpurawspeed Lib "CpuInf32.dll" () As Long
Public Declare Function cpunormspeed Lib "CpuInf32.dll" () As Long
Public Declare Function ProcessorCount Lib "CpuInf32.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
'* 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 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 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
Codes Sources
A voir également
- Donne des informations sur votre système
- Systeme reducteur ✓ - Forum Delphi / Pascal
- Systeme de geolocalisation - Forum Java
- Système de pointage - Forum PHP
- Système de ticket ✓ - Forum PHP
- Reducteur de conbinaisons - Forum Javascript / DHTML
26 févr. 2004 à 09:40
et je di merci Scooby
27 nov. 2003 à 22:07
@+
27 nov. 2003 à 19:19
La critique d'un code comme celui-ci n'a pas sa place ici. Que ceux qui critiquent fournissent leurs sources aussi proprement !
Enfin, même si le code n'est pas de lui, il a le mérite de vouloir faire progresser les autres en ajoutant un code intéressant plutôt qu'un code pourri comme on en voit malheureusement trop.
Cependant, si Scooby1 (l'initiateur de cette page) se souvenait de l'url où il a trouvé ce code, ça pourrait intéresser de connaître quels sont les sites instructifs.
27 nov. 2003 à 16:55
La critique de eyesonlyle ne sert à rien puisse que la réponse a déjà été donnée alors ce qui viennent pour critiquer sont les bienvenues tant que ces critiques sont là pour faire progressées le code sources, sinon aller voir ailleur pour vos conneries. De plus merci de parler Français.
Merci d'avance et @+
27 nov. 2003 à 16:50
Merci d'avance et @+
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.