Private Const MAX_IDE_DRIVES As Long = 4 ' Max number of drives assuming primary/secondary, master/slave topology
Private Const IDENTIFY_BUFFER_SIZE As Long = 512
Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088
Private Type GETVERSIONOUTPARAMS
bVersion As Byte ' Binary driver version.
bRevision As Byte ' Binary driver revision.
bReserved As Byte ' Not used.
bIDEDeviceMap As Byte ' Bit map of IDE devices.
fCapabilities As Long ' Bit mask of driver capabilities.
dwReserved(3) As Long ' For future use.
End Type
Private Type IDEREGS
bFeaturesReg As Byte ' Used for specifying SMART "commands".
bSectorCountReg As Byte ' IDE sector count register
bSectorNumberReg As Byte ' IDE sector number register
bCylLowReg As Byte ' IDE low order cylinder value
bCylHighReg As Byte ' IDE high order cylinder value
bDriveHeadReg As Byte ' IDE drive/head register
bCommandReg As Byte ' Actual IDE command.
End Type
Private Type SENDCMDINPARAMS
cBufferSize As Long ' Buffer size in bytes
irDriveRegs As IDEREGS ' Structure with drive register values.
bDriveNumber As Byte ' Physical drive number to send
bReserved(2) As Byte ' Reserved for future expansion.
dwReserved(3) As Long ' For future use.
bBuffer(0) As Byte ' Input buffer.
End Type
Private Const IDE_ATAPI_ID As Long = &HA1 ' Returns ID sector for ATAPI.
Private Const IDE_ID_FUNCTION As Long = &HEC ' Returns ID sector for ATA.
Private Const IDE_EXECUTE_SMART_FUNCTION As Long = &HB0 ' Performs SMART cmd.
Private Type DRIVERSTATUS
bReserved(1) As Byte ' Reserved for future expansion.
dwReserved(1) As Long ' Reserved for future expansion.
End Type
Private Type SENDCMDOUTPARAMS
cBufferSize As Long ' Size of bBuffer in bytes
drvStatus As DRIVERSTATUS ' Driver status structure.
bBuffer(0) As Byte ' Buffer of arbitrary length in which to store the data read from the ' drive.
End Type
Private Type ATTRTHRESHOLD
bAttrID As Byte ' Identifies which attribute
bWarrantyThreshold As Byte ' Triggering value
bReserved(9) As Byte ' ...
End Type
Private Type IDSECTOR
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
sFirmwareRev(7) As Byte
sModelNumber(39) As Byte
End Type
Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" (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 DeviceIoControl Lib "KERNEL32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private m_DiskInfo As IDSECTOR
Private Function OpenSMART(ByVal nDrive As Byte) As Long
Dim hSMARTIOCTL As Long
Dim hd As String
Dim VersionInfo As OSVERSIONINFO
VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx VersionInfo
Select Case VersionInfo.dwPlatformId
Case VER_PLATFORM_WIN32s
OpenSMART = hSMARTIOCTL
Case VER_PLATFORM_WIN32_WINDOWS
hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
Case VER_PLATFORM_WIN32_NT
If nDrive < MAX_IDE_DRIVES Then
hd = "\\.\PhysicalDrive" & nDrive
hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
End If
End Select
OpenSMART = hSMARTIOCTL
End Function
Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
Public Function GetDiskInfo(ByVal nDrive As Byte) As Long
Dim hSMARTIOCTL As Long
Dim cbBytesReturned As Long
Dim VersionParams As GETVERSIONOUTPARAMS
Dim scip As SENDCMDINPARAMS
Dim scop() As Byte
Dim OutCmd As SENDCMDOUTPARAMS
Dim bDfpDriveMap As Byte
Dim bIDCmd As Byte ' IDE or ATAPI IDENTIFY cmd
Dim uDisk As IDSECTOR
m_DiskInfo = uDisk
hSMARTIOCTL = OpenSMART(nDrive)
If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then
ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
CloseHandle hSMARTIOCTL
GetDiskInfo = 1
Exit Function '>---> Bottom
End If
CloseHandle hSMARTIOCTL
GetDiskInfo = 0
End If
End Function
Private Sub Command1_Click()
If GetDiskInfo(0) = 1 Then
pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
MsgBox "硬盘物理系列号" & pSerialNumber
pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
MsgBox "硬盘型号" & pModelNumber
End If
End Sub
’------------------------源代码开始--------------------------------
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Type IDERegs
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
Type InParams
cBufferSize As Long
irDriveRegs As IDERegs
bDriveNumber As Byte
bReserved(0 To 19) As Byte
End Type
Dim inbuff As InParams
Dim outbuff(0 To 528) As Byte
Dim SerialNumber As String
Function ChangeByteOrder(s As Variant, nLen As Long)
Dim i As Long
Dim pi As Long
pi = 0
For i = 0 To nLen / 2 - 1
c = s(pi)
s(pi) = s(pi + 1)
s(pi + 1) = c
pi = pi + 2
Next
End Function
Dim SerialNumber As String
Sub Main()
Dim nBytes As Long
Dim nRet As Long
Dim hVxD As Long
Private Sub wmiBaseBoardInfo()
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Set wmiObjSet = GetObject("winmgmts:\\.").InstancesOf("Win32_BaseBoard")
On Local Error Resume Next
For Each obj In wmiObjSet
MsgBox "主板序列号:" & obj.SerialNumber
Next
End Sub
硬盘的厂商序列号无法在VB中获得,只能获得操作系统格式化时产生的序列号:
下面的这个例子是使用GetVolumeInformation获得磁盘的序列号:
Private Declare Function GetVolumeInformation Lib _
"kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long
Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
GetSerialNumber = SerialNum
End Function
Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Public Function GetDiskID() As String
Dim VolName As String, FSysName As String, Path As String
Dim VolSeri As Long, SysFlag As Long, MaxLen As Long