Hjælp med at finde Computer information (eks. Processor, Ram osv.)

Gå ind i BIOS

Se på de forskellige dele, der burde deres navne stå.

Det er meningen jeg vil lave et program som kan vise alt dette, til f.eks. folk som ikke \'turer\' at gå ind i bios og kigge

selvfølgelig visual basic kategorien :) undskyld...

Det er lidt svert at lave nogle uncompiled eksempler, men her er lidt info om processor.

Det med \"GetCPUSpeed\" er vist noget fusk, jeg kan ikke få det til at funke. ;)

du skal bruge en Form1 og en Command1 og indsætte koden i Form1

\'---------- Form1 ----------
Option Explicit

\'Flags for GetSystemInfo
Private Const PROCESSOR_INTEL_386 As Long = 386
Private Const PROCESSOR_INTEL_486 As Long = 486
Private Const PROCESSOR_INTEL_PENTIUM As Long = 586
Private Const PROCESSOR_MIPS_R4000 As Long = 4000
Private Const PROCESSOR_ALPHA_21064 As Long = 21064
Private Const PROCESSOR_PPC_601 As Long = 601
Private Const PROCESSOR_PPC_603 As Long = 603
Private Const PROCESSOR_PPC_604 As Long = 604
Private Const PROCESSOR_PPC_620 As Long = 620
Private Const PROCESSOR_HITACHI_SH3 As Long = 10003    \'Windows CE
Private Const PROCESSOR_HITACHI_SH3E As Long = 10004  \'Windows CE
Private Const PROCESSOR_HITACHI_SH4 As Long = 10005    \'Windows CE
Private Const PROCESSOR_MOTOROLA_821 As Long = 821    \'Windows CE
Private Const PROCESSOR_SHx_SH3 As Long = 103          \'Windows CE
Private Const PROCESSOR_SHx_SH4 As Long = 104          \'Windows CE
Private Const PROCESSOR_STRONGARM As Long = 2577      \'Windows CE - 0xA11
Private Const PROCESSOR_ARM720 As Long = 1824          \'Windows CE - 0x720
Private Const PROCESSOR_ARM820 As Long = 2080          \'Windows CE - 0x820
Private Const PROCESSOR_ARM920 As Long = 2336          \'Windows CE - 0x920
Private Const PROCESSOR_ARM_7TDMI As Long = 70001      \'Windows CE

Private Const PROCESSOR_ARCHITECTURE_INTEL As Long = 0
Private Const PROCESSOR_ARCHITECTURE_MIPS As Long = 1
Private Const PROCESSOR_ARCHITECTURE_ALPHA As Long = 2
Private Const PROCESSOR_ARCHITECTURE_PPC As Long = 3
Private Const PROCESSOR_ARCHITECTURE_SHX As Long = 4
Private Const PROCESSOR_ARCHITECTURE_ARM As Long = 5
Private Const PROCESSOR_ARCHITECTURE_IA64 As Long = 6
Private Const PROCESSOR_ARCHITECTURE_ALPHA64 As Long = 7
Private Const PROCESSOR_ARCHITECTURE_UNKNOWN  As Long = &HFFFF

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 sCPURegKey = \"HARDWARE\\DESCRIPTION\\System\\CentralProcessor\\0\"

Private Const HKEY_LOCAL_MACHINE As Long = &H80000002

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 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 Function GetCPUSpeed() As Long
  Dim hKey As Long
  Dim cpuSpeed As Long
   
  \'Open CPU key
  Call RegOpenKey(HKEY_LOCAL_MACHINE, sCPURegKey, hKey)
                   
  \'and retrieve the value
  Call RegQueryValueEx(hKey, \"~MHz\", 0, 0, cpuSpeed, 4)
  Call RegCloseKey(hKey)
   
  GetCPUSpeed = cpuSpeed
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 Sub Command1_Click()

  Dim SI As SYSTEM_INFO
  Dim tmp As String
 
  Call GetSystemInfo(SI)
 
  Print \"Number Of Processors\", SI.dwNumberOfProcessors
 
  Select Case SI.dwProcessorType
      Case PROCESSOR_INTEL_386: tmp = \"386\"
      Case PROCESSOR_INTEL_486: tmp = \"486\"
      Case PROCESSOR_INTEL_PENTIUM: tmp = \"Pentium\"
      Case PROCESSOR_MIPS_R4000: tmp = \"MIPS 4000\"
      Case PROCESSOR_ALPHA_21064: tmp = \"Alpha\"
  End Select

  Print \"Processor Type\", SI.dwProcessorType, tmp

  Select Case SI.wProcessorLevel
      Case PROCESSOR_LEVEL_80386: tmp = \"Intel 80386\"
      Case PROCESSOR_LEVEL_80486: tmp = \"Intel 80486\"
      Case PROCESSOR_LEVEL_PENTIUM: tmp = \"Intel Pentium\"
      Case PROCESSOR_LEVEL_PENTIUMII: tmp = \"Intel Pentium Pro or Pentium II\"
  End Select
 
  Print \"Processor Level\", SI.wProcessorLevel, tmp
 
  Print \"Processor Revision\", SI.wProcessorRevision, _
        \"Model \"; HiByte(SI.wProcessorRevision) & _
        \", Stepping \" & LoByte(SI.wProcessorRevision)

  If GetCPUSpeed() <> 0 Then
  Print \"CPU Speed\", , \" \" & GetCPUSpeed() & \" MHz\"
  Else
  Print \"CPU Speed\", , \" ERROR MHz\"
  End If
End Sub
\'---------- Form1 ----------

Her er lidt om RAM/Memory

\'---------- Form1 ----------
Option Explicit

Private Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type

Private Declare Sub GlobalMemoryStatus Lib \"kernel32\" _
  (lpBuffer As MEMORYSTATUS)

\'constants used to shorten the output strings
Const fmt As String = \"###,###,###,###\"
Const skb As String = \" Kbyte\"
Const nkb As Long = 1024

Private Sub Form_Load()
Dim MS As MEMORYSTATUS
MS.dwLength = Len(MS)
GlobalMemoryStatus MS

\'divide the memory variables by 1024 (nkb)
\'to obtain the size in kilobytes
Text1 = Format$(MS.dwMemoryLoad, fmt) & \" % used\"
Text2 = Format$(MS.dwTotalPhys / nkb, fmt) & skb
Text3 = Format$(MS.dwAvailPhys / nkb, fmt) & skb
Text4 = Format$(MS.dwTotalPageFile / nkb, fmt) & skb
Text5 = Format$(MS.dwAvailPageFile / nkb, fmt) & skb
Text6 = Format$(MS.dwTotalVirtual / nkb, fmt) & skb
Text7 = Format$(MS.dwAvailVirtual / nkb, fmt) & skb

End Sub
Private Sub Form_Unload(Cancel As Integer)
  Set Form1 = Nothing
End Sub
\'---------- Form1 ----------

Her er lidt om Grafikkort.

\'---------- Form1 ----------
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CDS_TEST = &H4

Private Type DISPLAY_DEVICE
    cb As Long
    DeviceName As String * 32
    DeviceString As String * 128
    StateFlags As Long
    DeviceID As String * 128
    DeviceKey  As String * 128
End Type

Private Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    dmICMMethod As Long \'NT 4.0
    dmICMIntent As Long \'NT 4.0
    dmMediaType As Long \'NT 4.0
    dmDitherType As Long \'NT 4.0
    dmReserved1 As Long \'NT 4.0
    dmReserved2 As Long \'NT 4.0
    dmPanningWidth As Long \'Win2000
    dmPanningHeight As Long \'Win2000
End Type

Private Declare Function EnumDisplayDevices Lib \"user32\" Alias \"EnumDisplayDevicesA\" _
                        (Unused As Any, ByVal iDevNum As Long, lpDisplayDevice As _
                        DISPLAY_DEVICE, ByVal dwFlags As Long) As Boolean

Private Sub Form_Load()
    Dim DD As DISPLAY_DEVICE, DevM As DEVMODE
    DD.cb = Len(DD)
    \'First retieve some display info
    If EnumDisplayDevices(ByVal 0&, 0, DD, ByVal 0&) Then
        \'and show it
        Me.AutoRedraw = True
        Me.Print \"Device String:\" + Left$(DD.DeviceString, InStr(1, DD.DeviceString, Chr$(0)) - 1)
        Me.Print \"Device Name:\" + Left$(DD.DeviceName, InStr(1, DD.DeviceName, Chr$(0)) - 1)
        Me.Print \"Device Key:\" + Left$(DD.DeviceKey, InStr(1, DD.DeviceKey, Chr$(0)) - 1)
        Me.Print \"Device ID:\" + Left$(DD.DeviceID, InStr(1, DD.DeviceID, Chr$(0)) - 1)
    Else
        Me.Print \"Error while retrieving Display Information\"
    End If
End Sub
\'---------- Form1 ----------

Hej martin_zeus!

Du kan bruge denne kode til at se processortype og antal prcessore:

Webcrawler
- Enjoy




\'Viser din processor-type ved klik på knappen \"Command1_Click\".
\'Det øverste skal under General.
---------------------------------------------------------------


Option Explicit

Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessores As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Private Declare Sub GetSystemInfo Lib \"kernel32\" (lpSystemInfo As SYSTEM_INFO)


Private Sub Command1_Click()
Dim sys As SYSTEM_INFO
GetSystemInfo sys
Print \"Processor type: \"; sys.dwProcessorType
Print \"No. Processors: \"; sys.dwNumberOfProcessores
End Sub

-Webcrawler



\'Sådan tjekker man om ens modem har forbindelse:
\'-----------------------------------------------
\'Tilføj en form og et modul til dit projekt.
\'Tilføj en label ved navn \"lblmodemstatus\" til dit projekt.
\'Tilføj den første nedestående tekst til din form. De første to linier kommer
\'automatisk i Declarations-delen.
\'Tilføj sidste nedestående tekst (den efter \'****) til dit modul.


Public MyConnection As String
Public mStatis As Boolean


Private Sub Label1_Change()
Call activeconnection
           
        If mStatis = False Then
            MyConnection = \"Modemet har ingen forbindelse\"
            lblModemStatus.Visible = True
            lblModemStatus.ForeColor = vbBlack
            lblModemStatus.FontBold = False
            lblModemStatus.FontSize = 10
           
          ElseIf mStatis = True Then
            MyConnection = \"Modemet har forbindelse\"
            lblModemStatus.ForeColor = vbRed
            lblModemStatus.FontBold = True
            lblModemStatus.FontSize = 14
           
            If lblModemStatus.Visible = True Then
                lblModemStatus.Visible = False
                Else
                lblModemStatus.Visible = True
            End If
        End If
    lblModemStatus.Caption = MyConnection
End Sub

\'***************************************************

Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const ERROR_SUCCESS = 0&
Global Const APINULL = 0&
Global ReturnCode As Long

Declare Function RegCloseKey Lib \"advapi32.dll\" (ByVal hKey As Long) As Long
Declare Function RegOpenKey Lib \"advapi32.dll\" Alias \"RegOpenKeyA\" (ByVal _
hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

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

-Webcrawler

Sådan kan man tjekke om computeren har et lydkort:
--------------------------------------------------
\'Tilføj en form med en knap.
\'Tilføj et modul.
\'Tilføj første del til din kanp, og anden del til dit modul.


\'1. del
Dim i As Integer
i = waveOutGetNumDevs()
If i > 0 Then
    MsgBox \"Dit system kan afspille lydfiler.\", _
    vbInformation, \"Lydkort test\"
Else
    MsgBox \"Dit system kan ikke afspille lydfiler.\", _
    vbInformation, \"Lydkort test\"
End If


\'2. del
Declare Function waveOutGetNumDevs Lib \"winmm.dll\" _
Alias \"waveOutGetNumDevs\" () As Long

\'Sådan kan du tjekke om computeren har et mus installeret:
\'Øverste del skal i General Declarations og rensten evt. til en knap eller Form_Load


Private Declare Function GetSystemMetrics Lib \"user32.dll\" (ByVal nIndex As Long) As Long



Private Sub Form_Load()
Dim x As Long
x = GetSystemMetrics(19)
If x Then
MsgBox \"Mouse is installed\"
Else
MsgBox \"Mouse is not installed\"
End If
End
End Sub

Har du så ikke også CPU farten. Den er meget vigtig

martin_zeus >> Ikke for at jokke i sp... men syntes du ikke at du har fået nok for 40 point ;)