комплектующие

[JIeT4uK]

кто нить может подкинуть идей, как мне определить железо стоящее на машине ???

[GM]

Можна через WMI, также можеш посмотреть ключи реестра HKEY_LOCAL_MACHINE\HARDWARE и HKEY_CURRENT_CONFIG\SYSTEM\CURRENTCONTROLSET.

[JIeT4uK]

В реестре мало что нашел, хотелось бы увидеть какая мать стоит и какая память (с остальным разобрался), а можно поподробнее про WMI что это и с чем его едят!!!!!!

[GM]

Какая память или же ее объем?

[Dex]

Контролов явно нету для определения железа! GM а может ты знаешь как с помощью DirectX это сделать (меня вопрос заданный JIeT4uK тоже интересует)?

[JIeT4uK]

да в принципе и то и другое , можно даже и проиизводителя

[GM]

Закачка не работает
Создайте файл frmDx.frm, и вставьте текст :

Код: Выделить всё

VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   4
   Caption         =   "Form1"
   ClientHeight    =   4980
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   4440
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4980
   ScaleWidth      =   4440
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame1
      Caption         =   "╨рчЁх°хэш  ¤ъЁрэр"
      Height          =   1950
      Left            =   45
      TabIndex        =   0
      Top             =   15
      Width           =   4335
      Begin VB.ComboBox cmbArray
         Height          =   315
         Left            =   150
         Style           =   1  'Simple Combo
         TabIndex        =   1
         Text            =   "Combo1"
         Top             =   285
         Width           =   4020
      End
      Begin VB.Label lblInfo
         Height          =   1200
         Left            =   165
         TabIndex        =   2
         Top             =   660
         Width           =   3945
      End
   End
   Begin VB.Frame Frame2
      Height          =   2970
      Left            =   45
      TabIndex        =   3
      Top             =   1920
      Width           =   4335
      Begin VB.ListBox lstHardware
         Height          =   2595
         Left            =   75
         TabIndex        =   4
         Top             =   225
         Width           =   4155
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Author: Jack Hoxley
Dim dx As New DirectX7

'This data structure is to simplify getting/using the display
'modes AFTER they have been enumerated.
Private Type DisplayModeDesc
Width As Long
Height As Long
BPP As Byte
End Type
Dim arr_DisplayModes() As DisplayModeDesc 'note the fact that I haven't
'specified how big the array is to be. This allows me to resize it later on.


Dim binit As Boolean
Dim dd As DirectDraw7
Dim Mainsurf As DirectDrawSurface7
Dim primary As DirectDrawSurface7
Dim backbuffer As DirectDrawSurface7
Dim ddsd1 As DDSURFACEDESC2
Dim ddsd2 As DDSURFACEDESC2
Dim ddsd3 As DDSURFACEDESC2
Dim ddsd4 As DDSURFACEDESC2
Dim brunning As Boolean
Dim CurModeActiveStatus As Boolean
Dim bRestore As Boolean




Sub Init()
'On Local Error GoTo errOut 'If there is an error we end the program.
Set dd = dx.DirectDrawCreate("")


Call dd.SetCooperativeLevel(hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)

Dim reqWidth As Long, reqHeight As Long, reqDepth As Byte
reqWidth = arr_DisplayModes(cmbArray.ListIndex + 1).Width
reqHeight = arr_DisplayModes(cmbArray.ListIndex + 1).Height
reqDepth = arr_DisplayModes(cmbArray.ListIndex + 1).BPP
Call dd.SetDisplayMode(reqWidth, reqHeight, reqDepth, 0, DDSDM_DEFAULT)

ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
ddsd1.lBackBufferCount = 1
Set primary = dd.CreateSurface(ddsd1)

'Get the backbuffer
Dim caps As DDSCAPS2
caps.lCaps = DDSCAPS_BACKBUFFER
Set backbuffer = primary.GetAttachedSurface(caps)
backbuffer.GetSurfaceDesc ddsd3     
backbuffer.SetFontTransparency True
backbuffer.SetForeColor RGB(0, 0, 0)
' init the surfaces
InitSurfaces             
binit = True
brunning = True
Do While brunning
blt
DoEvents
Loop
errOut:
EndIt
End Sub
Sub blt()
On Local Error GoTo errOut
If binit = False Then Exit Sub
Dim ddrval As Long
Dim rBack As RECT
bRestore = False
Do Until ExModeActive
DoEvents
bRestore = True
Loop

' if we lost and got back the surfaces, then restore them
DoEvents
If bRestore Then bRestore = False
dd.RestoreAllSurfaces
InitSurfaces
'get the area of the screen where our window is
'this sets the rectangle to be the size of the screen.
rBack.Bottom = ddsd3.lHeight
rBack.Right = ddsd3.lWidth
ddrval = backbuffer.BltFast(0, 0, Mainsurf, rBack, DDBLTFAST_WAIT)
Call backbuffer.DrawText(10, 10, "Press Any Key To Continue", False)
'flip the back buffer to the screen
primary.Flip Nothing, DDFLIP_WAIT
errOut:
End Sub
Sub EndIt()
Call dd.RestoreDisplayMode
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
Unload Me
End Sub

Function ExModeActive() As Boolean
'This is used to test if we're in the correct resolution.
Dim TestCoopRes As Long
TestCoopRes = dd.TestCooperativeLevel
If (TestCoopRes = DD_OK) Then
ExModeActive = True
Else
ExModeActive = False
End If
End Function

Sub InitSurfaces()
Set Mainsurf = Nothing

'load the bitmap into a surface - backdrop.bmp
ddsd4.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
ddsd4.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddsd4.lWidth = ddsd3.lWidth
ddsd4.lHeight = ddsd3.lHeight
Set Mainsurf = dd.CreateSurfaceFromFile(App.Path & "\backdrop.bmp", ddsd4)
End Sub

Sub GetDisplayModes()
'This is the actual code that reports back what display modes are available.
'You could modify this to be a function, which enumerates the display modes
'and runs through the list until it finds the one that you want. ie. You're program
'runs in 800x600 in 32bpp mode; create a function that searches through the
'available modes UNTIL it finds the one you want (800x600x32), at this point it
'reports back True or false......

Dim DisplayModesEnum As DirectDrawEnumModes
Dim ddsd2 As DDSURFACEDESC2
Dim dd As DirectDraw7 'These two lines can also be seen in the Init sub. This time
'it doesn't go to fullscreen mode
Set dd = dx.DirectDrawCreate("")
dd.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL

'Create the Enumeration object
Set DisplayModesEnum = dd.GetDisplayModesEnum(0, ddsd2)
'Remember the array that wasn't defined? At this point
'we set the size of the array.
ReDim arr_DisplayModes(DisplayModesEnum.GetCount()) As DisplayModeDesc

'This loop runs through the display modes, retrieving the data.
'Height/Width/BPP aren't the only things that you can retrieve here....
Dim i As Integer
For i = 1 To DisplayModesEnum.GetCount()
DisplayModesEnum.GetItem i, ddsd2
cmbArray.AddItem CStr(ddsd2.lWidth) & "x" & CStr(ddsd2.lHeight) & " " & Str(ddsd2.ddpfPixelFormat.lRGBBitCount) & "bpp"
cmbArray.Text = CStr(ddsd2.lWidth) & "x" & CStr(ddsd2.lHeight) & " " & CStr(ddsd2.ddpfPixelFormat.lRGBBitCount) & "bpp"

'This fills out the data structure to include information
'on the current display mode.
arr_DisplayModes(i).Height = ddsd2.lHeight
arr_DisplayModes(i).Width = ddsd2.lWidth
arr_DisplayModes(i).BPP = ddsd2.ddpfPixelFormat.lRGBBitCount
Next i

'Directdraw is no longer needed - destroy it.
Set dd = Nothing

'Fill out the user-display label
lblInfo.Caption = "Display Mode index = " & cmbArray.ListIndex + 1 & vbCr
lblInfo.Caption = lblInfo.Caption & " Height = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Height) & vbCr
lblInfo.Caption = lblInfo.Caption & " Width = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Width) & vbCr
lblInfo.Caption = lblInfo.Caption & " Colour Depth = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).BPP) & vbCr
End Sub

Sub GetDDCaps()
'This part returns the capabilities of DirectDraw
'You only really need this information if you're going to do
'any technical stuff.
Dim dd As DirectDraw7
Dim hwCaps As DDCAPS 'HARDWARE
Dim helCaps As DDCAPS 'SOFTWARE EMULATION

Set dd = dx.DirectDrawCreate("")
dd.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
dd.GetCaps hwCaps, helCaps

'how much video memory is available
lstHardware.AddItem "GENERAL INFORMATION"
'The memory amount can be useful. If you know that you're surfaces require
'450kb of memory then you can check if the host computer has this much memory.
lstHardware.AddItem " total video memory " & CStr(hwCaps.lVidMemTotal) & " bytes (" & CStr(Format$(hwCaps.lVidMemTotal / 1024, "#.0")) & "Kb)"
lstHardware.AddItem " free video memory " & CStr(hwCaps.lVidMemFree) & " bytes (" & CStr(Format$(hwCaps.lVidMemFree / 1024, "#.0")) & "Kb)"

lstHardware.AddItem " There are " & hwCaps.lNumFourCCCodes & " FourCC codes available"
lstHardware.AddItem ""

lstHardware.AddItem "HARDWARE CAPABILITIES"

'You can get a list of what these constants mean in the
'sdk help file. If you don't have the help file you're a bit stuck!
Dim lVal  As Long
lVal = hwCaps.ddsCaps.lCaps2
If lVal And DDCAPS2_CANCALIBRATEGAMMA Then
lstHardware.AddItem " Supports gamma correction"
Else
lstHardware.AddItem " No support for gamma correction"
End If

If lVal And DDCAPS2_CERTIFIED Then
lstHardware.AddItem " The driver is certified"
Else
lstHardware.AddItem " The driver is not certified"
End If

If lVal And DDCAPS2_WIDESURFACES Then
lstHardware.AddItem " support for surfaces wider than the screen"
Else
lstHardware.AddItem " No support for surfaces wider than the screen"
End If

lVal = hwCaps.lSVBFXCaps
If lVal And DDFXCAPS_BLTALPHA Then
lstHardware.AddItem " Support for Alpha Blended Blit operations"
Else
lstHardware.AddItem " No support for Alpha Blended Blit operations"
End If

If lVal And DDFXCAPS_BLTROTATION Then
lstHardware.AddItem " Support for rotation Blit operations"
Else
lstHardware.AddItem " No support for rotation Blit operations"
End If

lVal = hwCaps.lSSBCaps
If lVal And DDCAPS_3D Then
lstHardware.AddItem " Support for 3D Acceleration"
Else
lstHardware.AddItem " No support for 3D acceleration"
End If

If lVal And DDCAPS_BLTQUEUE Then
lstHardware.AddItem " Support for asynchronous blitting"
Else
lstHardware.AddItem " No support for asynchronous blitting"
End If

If lVal And DDCAPS_BLTSTRETCH Then
lstHardware.AddItem " Support for stretching during Blit operations"
Else
lstHardware.AddItem " No support for stretching during blit operations"
End If

If lVal And DDCAPS_NOHARDWARE Then
lstHardware.AddItem " Hardware support is available"
Else
lstHardware.AddItem " No hardware support"
End If

'//////////////////////SOFTWARE\\\\\\\\\\\\\\\\\\\\\\\\\\\\

lstHardware.AddItem "SOFTWARE CAPABILITIES"

lVal = helCaps.ddsCaps.lCaps2
If lVal And DDCAPS2_WIDESURFACES Then
lstHardware.AddItem " The device supports surfaces wider than the screen"
Else
lstHardware.AddItem " The device does not support surfaces wider than the screen"

End If
'If lVal = helCaps.lSVBFXCaps Then
If lVal And DDFXCAPS_BLTALPHA Then
lstHardware.AddItem " Software supports Alpha Blended Blit operations"
Else
lstHardware.AddItem " No Software support for Alpha Blended Blit operations"
End If

If lVal And DDFXCAPS_BLTROTATION Then
lstHardware.AddItem " Software supports rotation Blit operations"
Else
lstHardware.AddItem " No software support for rotation Blit operations"
End If

lVal = helCaps.lSSBCaps
If lVal And DDCAPS_3D Then
lstHardware.AddItem " Software supports 3D Acceleration"
Else
lstHardware.AddItem " No software support for 3D acceleration"
End If

If lVal And DDCAPS_BLTQUEUE Then
lstHardware.AddItem " Software supports asynchronous blitting"
Else
lstHardware.AddItem " No software support for asynchronous blitting"
End If
'End If
Set dd = Nothing

End Sub


'These Next three procedures just update the user-display with the
'information he/she has just selected.
Private Sub cmbArray_Click()
lblInfo.Caption = "Display Mode index = " & cmbArray.ListIndex + 1 & vbCr
lblInfo.Caption = lblInfo.Caption & " Height = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Height) & vbCr
lblInfo.Caption = lblInfo.Caption & " Width = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Width) & vbCr
lblInfo.Caption = lblInfo.Caption & "ColourDepth = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).BPP) & vbCr
End Sub

Private Sub cmbArray_KeyDown(KeyCode As Integer, Shift As Integer)
lblInfo.Caption = "Display Mode index = " & cmbArray.ListIndex + 1 & vbCr
lblInfo.Caption = lblInfo.Caption & " Height = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Height) & vbCr
lblInfo.Caption = lblInfo.Caption & " Width = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Width) & vbCr
lblInfo.Caption = lblInfo.Caption & " Colour Depth = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).BPP) & vbCr
End Sub

Private Sub cmbArray_Scroll()
lblInfo.Caption = "Display Mode index = " & cmbArray.ListIndex + 1 & vbCr
lblInfo.Caption = lblInfo.Caption & " Height = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Height) & vbCr
lblInfo.Caption = lblInfo.Caption & " Width = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).Width) & vbCr
lblInfo.Caption = lblInfo.Caption & " Colour Depth = " & CStr(arr_DisplayModes(cmbArray.ListIndex + 1).BPP) & vbCr
End Sub


Private Sub Form_Load()
Me.Show
'This lists the display modes
GetDisplayModes
'This lists the hardware/software CAPabilities
GetDDCaps
End Sub


[GM]

Насчет объема:

Код: Выделить всё

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)
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim MemStat As MEMORYSTATUS
    'retrieve the memory status
    GlobalMemoryStatus MemStat
    MsgBox "You have" + Str$(MemStat.dwTotalPhys / 1024) + " Kb total memory and" + Str$(MemStat.dwAvailPageFile / 1024) + " Kb available PageFile memory."
End Sub


[JIeT4uK]

спасибо , но это немного н то что я бы хотел увидеть, просто хотелось бы знать что конкретно знать что стоит внутри не раскрывая системника .
нашел как узнать что за винт какое видео, ну вроде и объем памяти есть а остальное загадка

[GM]

Вот и пример с WMI нашел для CPU и БИОСА:

Код: Выделить всё

Option Explicit
Type CPU_INFO
    Version As String
    Type As String
    Socket As String
    Manufacturer As String
    ClocksMax As String
    ClocksCur As String
End Type

Type BIOS_INFO
    Manufacturer As String
    Version As String
End Type
Dim objWMIService As Object
Dim colItems As Object
Public Sub GetCPU(CPUInfoType As CPU_INFO)
On Error Resume Next
Dim objItem As Object
Dim strcomputer As String
strcomputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strcomputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")

With CPUInfoType
For Each objItem In colItems
    .Type = objItem.Description
    .Manufacturer = objItem.Manufacturer
    .Version = objItem.Version
    .Socket = objItem.SocketDesignation
    .ClocksMax = objItem.MaxClockSpeed & "MHz"
    .ClocksCur = objItem.CurrentClockSpeed & "MHz"
Next
End With
End Sub
Public Sub GetBIOS(BIOSInfoType As BIOS_INFO)
On Error Resume Next
Dim strcomputer As String
Dim objBios As Object
Dim colSettings As Object
strcomputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strcomputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery("Select * from Win32_BIOS")

With BIOSInfoType
For Each objBios In colSettings
    .Manufacturer = objBios.Manufacturer
    .Version = objBios.Version
Next
End With
End Sub





Чуть поправил

[JIeT4uK]

извините за тупость но как это заставить мне что либо сообщить

[GM]

Ну например:

Код: Выделить всё

Private Sub Command1_Click()
Dim a As CPU_INFO
Call GetCPU(a)
MsgBox a.Manufacturer & vbCrLf & a.Type
End Sub