hardinfo.frm

get system information

VERSION 5.00
Begin VB.Form HardInfo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "读取硬件信息源代码"
   ClientHeight    =   4635
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5655
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   309
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   377
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdDisk 
      Caption         =   "硬盘"
      Height          =   420
      Left            =   2055
      TabIndex        =   8
      Top             =   720
      Width           =   1500
   End
   Begin VB.CommandButton CmdMonitor 
      Caption         =   "显示器"
      Height          =   420
      Left            =   210
      TabIndex        =   7
      Top             =   720
      Width           =   1500
   End
   Begin VB.CommandButton CmdMemory 
      Caption         =   "内存"
      Height          =   420
      Left            =   3900
      TabIndex        =   6
      Top             =   720
      Width           =   1500
   End
   Begin VB.CommandButton CmdModem 
      Caption         =   "调制解调器"
      Height          =   420
      Left            =   3900
      TabIndex        =   5
      Top             =   1875
      Width           =   1500
   End
   Begin VB.CommandButton CmdKeyboard 
      Caption         =   "键盘"
      Height          =   420
      Left            =   2055
      TabIndex        =   4
      Top             =   1875
      Width           =   1500
   End
   Begin VB.CommandButton CmdBIOS 
      Caption         =   "BIOS"
      Height          =   420
      Left            =   210
      TabIndex        =   3
      Top             =   1875
      Width           =   1500
   End
   Begin VB.CommandButton cmdCDROM 
      Caption         =   "光驱"
      Height          =   420
      Left            =   3900
      TabIndex        =   2
      Top             =   1290
      Width           =   1500
   End
   Begin VB.CommandButton CmdWin32_Motherboard 
      Caption         =   "主板"
      Height          =   420
      Left            =   2055
      TabIndex        =   1
      Top             =   1290
      Width           =   1500
   End
   Begin VB.CommandButton CmdWin32_Processor 
      Caption         =   "处理器"
      Height          =   420
      Left            =   210
      TabIndex        =   0
      Top             =   1290
      Width           =   1500
   End
   Begin VB.Label Label1 
      Caption         =   $"HardInfo.frx":0000
      Height          =   2055
      Left            =   240
      TabIndex        =   9
      Top             =   2400
      Width           =   5100
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      X1              =   4
      X2              =   366
      Y1              =   41
      Y2              =   41
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      X1              =   5
      X2              =   367
      Y1              =   40
      Y2              =   40
   End
   Begin VB.Image Image1 
      Height          =   600
      Left            =   3825
      MouseIcon       =   "HardInfo.frx":0108
      MousePointer    =   99  'Custom
      Picture         =   "HardInfo.frx":025A
      ToolTipText     =   " http://www.codefans.net "
      Top             =   0
      Width           =   1800
   End
End
Attribute VB_Name = "HardInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Download by http://www.codefans.net
'// －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'// Dunzipsoft Corp.
'// Dunzip / Jun 06,2006
'// (86-769)13649898291        (86-769)85477744
'// Http://www.dunzip.com

'// QQ:40334040       Mail:[e-mail]

'// 转载请注明出处。谢谢。
'// －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

'// 1、显示器资料（例如显示器序列号）
'// 2、主板信息（例如主板序列号）
'// 3、硬盘信息（例如硬盘序列号,品牌）
'// 4、芯片信息（例如芯片序列号）
'// 5、处理器信息（例如处理器序列号,品牌）
'// 6、光驱信息
'// 7、键盘信息
'// 8、Modem信息
'// 9、内存信息

Private Type TYPEEdition
    bVersion                        As Byte
    bRevision                       As Byte
    bReserved                       As Byte
    bIDEDeviceMap                   As Byte
    fCapabilities                   As Long
    dwReserved(4)                   As Long
End Type

Private Type TYPETIDEreg
    bFeaturesReg                    As Byte
    bSectorCountReg                 As Byte
    bSectorNumberReg                As Byte
    bCylLowReg                      As Byte
    bCylHighReg                     As Byte
    bDriveHeadReg                   As Byte
    bCommandReg                     As Byte
    bReserved                       As Byte
End Type

Private Type TYPETSendCmdIn
    cBufferSize                     As Long
    irDriveRegs                     As TYPETIDEreg
    bDriveNumber                    As Byte
    bReserved(2)                    As Byte
    dwReserved(3)                   As Long
End Type

Private Type TYPEDRVInfos
    bDriverError                    As Byte
    bIDEStatus                      As Byte
    bReserved(1)                    As Byte
    dwReserved(1)                   As Long
End Type

Private Type TYPETSendCmdOut
    cBufferSize                     As Long
    DRIVERSTATUS                    As TYPEDRVInfos
    bBuffer(511)                    As Byte
End Type

Private Type TYPETIDSector
    wGenConfig                      As Integer
    wNumCyls                        As Integer
    wReserved                       As Integer
    wNumHeads                       As Integer
    wBytesPerTrack                  As Integer
    wBytesPerSector                 As Integer
    wSectorsPerTrack                As Integer
    wVendorUnique(2)                As Integer
    sSerialNumber(19)               As Byte
    wBufferType                     As Integer
    wBufferSize                     As Integer
    wECCSize                        As Integer
    sFirmwareRev(7)                 As Byte
    sModelNumber(39)                As Byte
    wMoreVendorUnique               As Integer
    wDoubleWordIO                   As Integer
    wCapabilities                   As Integer
    wReserved1                      As Integer
    wPIOTiming                      As Integer
    wDMATiming                      As Integer
    Wbs                             As Integer
    wNumCurrentCyls                 As Integer
    wNumCurrentHeads                As Integer
    wNumCurrentSectorsPerTrack      As Integer
    ulCurrentSectorCapacity(3)      As Byte
    wMultSectorStuff                As Integer
    ulTotalAddressableSectors(3)    As Byte
    wSingleWordDMA                  As Integer
    wMultiWordDMA                   As Integer
    bReserved(127)                  As Byte
End Type

Private Type TYPEOverLapped
    Internal                        As Long
    InternalHigh                    As Long
    offset                          As Long
    OffsetHigh                      As Long
    hEvent                          As Long
End Type

Private Type TYPESecurity
    nLength                         As Long
    lpSecurityDescriptor            As Long
    bInheritHandle                  As Long
End Type

'// －kernel32－
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function RtlMoveMemory Lib "kernel32" (ByRef lpvDest As Any, ByRef lpvSource As Any, ByVal lpvLength As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByVal lpBytesReturned As Long, ByRef lpOverlapped As TYPEOverLapped) As Long
Private Declare Function BrandExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long      ' 运行文件


'// －硬盘信息－
'// －－－－－－

'// －硬盘品牌－
Public Function ReadDiskBrands(ByVal DiskNumber As Long) As String
    On Error Resume Next
    Dim hWnd As Long, ArrayReturn(40) As Byte
    Dim PhdInfo As TYPETIDSector, Olpv As TYPEOverLapped
    Dim InInfo As TYPETSendCmdIn, OutInfo As TYPETSendCmdOut, DeviceInfo As TYPEEdition
    hWnd = CreateFileA("\\.\PhysicalDrive" & CStr(DiskNumber - 1), &H80000000 Or &H40000000, &H1 Or &H2, 0, 3, 0, 0)
    If CBool(DeviceIoControl(hWnd, &H74080, ByVal 0&, 0, DeviceInfo, Len(DeviceInfo), ByVal 0, Olpv)) Then
        If CBool(DeviceInfo.fCapabilities) Then
            With InInfo
                .irDriveRegs.bDriveHeadReg = IIf(CBool(DiskNumber - 1), &HB0, &HA0)
                .irDriveRegs.bCommandReg = &HEC
                .bDriveNumber = DiskNumber - 1
                .irDriveRegs.bSectorCountReg = 1
                .irDriveRegs.bSectorNumberReg = 1
                .cBufferSize = 512
            End With
        
            If DeviceIoControl(hWnd, &H7C088, InInfo, Len(InInfo), OutInfo, Len(OutInfo), ByVal 0, Olpv) > 0 Then
                Call RtlMoveMemory(PhdInfo, OutInfo.bBuffer(0), Len(PhdInfo))
                Call RtlMoveMemory(ArrayReturn(0), PhdInfo.sModelNumber(0), 40)
                ReadDiskBrands = ByteToString(ArrayReturn)
            End If
        End If
    End If
    Call CloseHandle(hWnd)
    
    Call Err.Clear
    DoEvents
End Function

'// －硬盘编号－
Public Function ReadDiskSerialNumber(ByVal DiskNumber As Long) As String
    On Error Resume Next
    Dim hWnd As Long, Olpv As TYPEOverLapped
    Dim PhdInfo As TYPETIDSector, ArrayReturn(40) As Byte
    Dim InInfo As TYPETSendCmdIn, OutInfo As TYPETSendCmdOut, DeviceInfo As TYPEEdition
    hWnd = CreateFileA("\\.\PhysicalDrive" & CStr(DiskNumber - 1), &H80000000 Or &H40000000, &H1 Or &H2, 0, 3, 0, 0)
    If CBool(DeviceIoControl(hWnd, &H74080, ByVal 0&, 0, DeviceInfo, Len(DeviceInfo), ByVal 0, Olpv)) Then
        If CBool(DeviceInfo.fCapabilities) Then
            With InInfo
                .irDriveRegs.bDriveHeadReg = IIf(CBool(DiskNumber - 1), &HB0, &HA0)
                .irDriveRegs.bCommandReg = &HEC
                .bDriveNumber = DiskNumber - 1