- '
- '取硬盘的物理信息(序列号,容量,转速,型号)(smHDinfo)
- '
- '/网站:东方热讯:http://www.easthot.net
- '/邮件:sales@easthot.net
- '/2003.01.23
- '*************************************************************************
- Option Explicit
- '/以下这一行是必须的,困为要做结构复制。而结构中有数组。所以,没有它则会错位
- Option Base 0
- Private Const DFP_GET_VERSION =
- Private Const DFP_SEND_DRIVE_COMMAND =
- Private Const DFP_RECEIVE_DRIVE_DATA =
- '/#pragma pack(1)
- Private Type TGETVERSIONOUTPARAMS '{
- 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(4) As Long '/For future use.
- End Type
- Private Type TIDEREGS
- 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.
- bReserved As Byte '/reserved for future use. Must be zero.
- End Type
- Private Type TSENDCMDINPARAMS
- cBufferSize As Long '/Buffer size in bytes
- irDriveRegs As TIDEREGS '/Structure with drive register values.
- bDriveNumber As Byte '/Physical drive number to send '/command to (0,1,2,3).
- bReserved(2) As Byte '/Reserved for future expansion.
- dwReserved(3) As Long '/For future use.
- '//BYTE bBuffer(1) '/Input buffer.
- End Type
- Private Type TDRIVERSTATUS
- bDriverError As Byte '/Error code from driver, '/or 0 if no error.
- bIDEStatus As Byte '/Contents of IDE Error register.
- '//Only valid when bDriverError '/is SMART_IDE_ERROR.
- bReserved(1) As Byte '/Reserved for future expansion.
- dwReserved(1) As Long '/Reserved for future expansion.
- End Type
- Private Type TSENDCMDOUTPARAMS
- cBufferSize As Long '/Size of bBuffer in bytes
- DRIVERSTATUS As TDRIVERSTATUS '/Driver status structure.
- bBuffer(511) As Byte '/Buffer of arbitrary length
- '//in which to store the data read from the drive.
- End Type
- '/下面的结构是要从另一结构复制数据过来的,所以,必须是字节数与VC的完全一致
- '/而不能用兼容变量,但这里的我们还是用了兼容变量,Integer,因为此结构中这一
- '/类型的的变量程序中没有用到,如果要用到,建议改为Byte类型。因为VB没有USHORT
- Private Type TIDSECTOR
- 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 '/这里只能用byte,因为VB没有无符号的LONG型变量
- wMultSectorStuff As Integer
- ulTotalAddressableSectors(3) As Byte '/这里只能用byte,因为VB没有无符号的LONG型变量
- wSingleWordDMA As Integer
- wMultiWordDMA As Integer
- bReserved(127) As Byte
- End Type
- Private vers As TGETVERSIONOUTPARAMS
- Private in_data As TSENDCMDINPARAMS
- Private out_data As TSENDCMDOUTPARAMS
- Private h As Long
- Private I As Long
- Private J As Byte
- Private Type OSVERSIONINFO
- dwOSVersionInfoSize As Long
- dwMajorVersion As Long
- dwMinorVersion As Long
- dwBuildNumber As Long
- dwPlatformId As Long
- szCSDVersion As String * 128
- End Type
- Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
- (LpVersionInformation As OSVERSIONINFO) As Long
- Private Const VER_PLATFORM_WIN32S = 0
- Private Const VER_PLATFORM_WIN32_WINDOWS = 1
- Private Const VER_PLATFORM_WIN32_NT = 2
- 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 Const CREATE_NEW = 1
- Private Const GENERIC_READ =
- Private Const GENERIC_WRITE =
- Private Const OPEN_EXISTING = 3
- Private Const FILE_SHARE_READ =
- Private Const FILE_SHARE_WRITE =
- Private Type OVERLAPPED
- Internal As Long
- InternalHigh As Long
- offset As Long
- OffsetHigh As Long
- hEvent As Long
- End Type
- 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 OVERLAPPED) As Long
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
- hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
- Private Sub ChangeByteOrder(szString() As Byte, uscStrSize As Long)
- Dim I As Long
- Dim temp As String
- For I = 0 To uscStrSize - 1 Step 2
- temp = szString(I)
- szString(I) = szString(I + 1)
- szString(I + 1) = temp
- Next I
- End Sub
- Private Function hdid9x() As smHdInfoType()
- '/We start in 95/98/Me
- Dim RevInfo() As smHdInfoType
- Dim RevID As Long
- Dim olp As OVERLAPPED
- Dim lRet As Long
- h = CreateFile("//./Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
- If h = 0 Then
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).InfoFlag = False
- GoTo EndFun
- End If
- lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal I, olp)
- If lRet = 0 Then
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- GoTo EndFun
- End If
- '/If IDE identify command not supported, fails
- If (vers.fCapabilities And 1) <> 1 Then
- '/hdid9x = "Error: IDE identify command not supported."
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- GoTo EndFun
- End If
- '/Display IDE drive number detected
- Dim sPreOutStr As String
- sPreOutStr = DetectIDE(vers.bIDEDeviceMap)
- '/hdid9x = sPreOutStr
- '/Identify the IDE drives
- For J = 0 To 3
- Dim phdinfo As TIDSECTOR
- Dim s(40) As Byte
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).Hdid = J
- If (J And 1) = 1 Then
- in_data.irDriveRegs.bDriveHeadReg =
- Else
- in_data.irDriveRegs.bDriveHeadReg =
- End If
- If (vers.fCapabilities And (16 / (2 ^ J))) = (16 / (2 ^ J)) Then
- RevInfo(RevID - 1).InfoFlag = False
- Else
- in_data.irDriveRegs.bCommandReg =
- in_data.bDriveNumber = J
- in_data.irDriveRegs.bSectorCountReg = 1
- in_data.irDriveRegs.bSectorNumberReg = 1
- in_data.cBufferSize = 512
- RevInfo(RevID - 1).InfoFlag = True
- lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal I, olp)
- If lRet = 0 Then
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- GoTo EndFun
- End If
- Dim StrOut As String
- CopyMemory phdinfo, out_data.bBuffer(0), Len(phdinfo)
- CopyMemory s(0), phdinfo.sModelNumber(0), 40
- s(40) = 0
- ChangeByteOrder s, 40
- StrOut = ByteArrToString(s, 40)
- RevInfo(RevID - 1).ModuleNumber = Trim$(StrOut)
- CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
- s(8) = 0
- ChangeByteOrder s, 8
- StrOut = ByteArrToString(s, 8)
- RevInfo(RevID - 1).FirmwareRev = Trim$(StrOut)
- CopyMemory s(0), phdinfo.sSerialNumber(0), 20
- s(20) = 0
- ChangeByteOrder s, 20
- StrOut = ByteArrToString(s, 20)
- '/hdid9x = hdid9x & vbCrLf & "Serial Number:" & StrOut
- RevInfo(RevID - 1).SerialNumber = Trim$(StrOut)
- CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
- s(5) = 0
- Dim dblStrOut As Double
- dblStrOut = ByteArrToLong(s)
- RevInfo(RevID - 1).Capcity = CLng(dblStrOut / 2 / 1024) & "M"
- End If
- Next J
- '/Close handle before quit
- CloseHandle (h)
- EndFun:
- hdid9x = RevInfo
- End Function
- Private Function hdidnt() As smHdInfoType()
- Dim hd As String * 80
- Dim phdinfo As TIDSECTOR
- Dim s(40) As Byte
- Dim StrOut As String
- Dim RevInfo() As smHdInfoType
- Dim RevID As Long
- '/hdidnt = ""
- '/We start in NT/Win2000
- For J = 0 To 3 '/这里取四个硬盘的信息,因为正常PC不超过四个硬盘
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).Hdid = CStr(J)
- hd = "//./PhysicalDrive" & CStr(J)
- '/hdidnt = hdidnt & vbCrLf & hd
- h = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, _
- FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
- Dim olpv As OVERLAPPED
- Dim lRet As Long
- lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal I, olpv)
- If lRet = 0 Then
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- Else
- '/If IDE identify command not supported, fails
- If (vers.fCapabilities And 1) <> 1 Then
- '/hdidnt = "Error: IDE identify command not supported."
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- GoTo EndFun
- '/Exit Function
- End If
- '/Identify the IDE drives
- If (J And 1) = 1 Then
- in_data.irDriveRegs.bDriveHeadReg =
- Else
- in_data.irDriveRegs.bDriveHeadReg =
- End If
- If (vers.fCapabilities And (16 / (2 ^ J))) <> 0 Then
- '/We don't detect a ATAPI device.
- RevInfo(RevID - 1).InfoFlag = False
- '/hdidnt = hdidnt & vbCrLf & "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
- Else
- in_data.irDriveRegs.bCommandReg =
- in_data.bDriveNumber = J
- in_data.irDriveRegs.bSectorCountReg = 1
- in_data.irDriveRegs.bSectorNumberReg = 1
- in_data.cBufferSize = 512
- Dim olpr As OVERLAPPED
- lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal I, olpr)
- If lRet <= 0 Then
- '/hdidnt = hdidnt & vbCrLf & "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- Else
- RevInfo(RevID - 1).InfoFlag = True
- CopyMemory phdinfo, out_data.bBuffer(0), Len(phdinfo)
- CopyMemory s(0), phdinfo.sModelNumber(0), 40
- s(40) = 0
- ChangeByteOrder s, 40
- StrOut = ByteArrToString(s, 40)
- RevInfo(RevID - 1).ModuleNumber = Trim$(StrOut)
- '/hdidnt = hdidnt & vbCrLf & "Module Number:" & StrOut
- CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
- s(8) = 0
- ChangeByteOrder s, 8
- StrOut = ByteArrToString(s, 8)
- RevInfo(RevID - 1).FirmwareRev = Trim$(StrOut)
- '/hdidnt = hdidnt & vbCrLf & "Firmware rev:" & StrOut
- CopyMemory s(0), phdinfo.sSerialNumber(0), 20
- s(20) = 0
- ChangeByteOrder s, 20
- StrOut = ByteArrToString(s, 20)
- '/hdidnt = hdidnt & vbCrLf & "Serial Number:" & StrOut
- RevInfo(RevID - 1).SerialNumber = Trim$(StrOut)
- CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
- s(5) = 0
- Dim dblStrOut As Double
- dblStrOut = ByteArrToLong(s)
- RevInfo(RevID - 1).Capcity = CLng(dblStrOut / 2 / 1024) & "M"
- '/hdidnt = hdidnt & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
- CloseHandle (h)
- End If
- End If
- End If
- Next
- EndFun:
- hdidnt = RevInfo
- End Function
- Private Function DetectIDE(bIDEDeviceMap As Byte) As String
- If (bIDEDeviceMap And 1) Then
- If (bIDEDeviceMap And 16) Then
- DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 0."
- Else
- DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 0."
- End If
- End If
- If (bIDEDeviceMap And 2) Then
- If (bIDEDeviceMap And 32) Then
- DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 1."
- Else
- DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 1."
- End If
- End If
- If (bIDEDeviceMap And 4) Then
- If (bIDEDeviceMap And 64) Then
- DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 0."
- Else
- DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 0."
- End If
- End If
- If (bIDEDeviceMap And 8) Then
- If (bIDEDeviceMap And 128) Then
- DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 1."
- Else
- DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 1."
- End If
- End If
- End Function
- Private Function ByteArrToString(inByte() As Byte, ByVal strlen As Integer) As String
- Dim I As Integer
- For I = 0 To strlen
- If inByte(I) = 0 Then
- Exit For
- End If
- ByteArrToString = ByteArrToString & Chr(inByte(I))
- Next I
- End Function
- Private Function ByteArrToLong(inByte() As Byte) As Double
- Dim I As Integer
- For I = 0 To 3
- ByteArrToLong = ByteArrToLong + CDbl(inByte(I)) * (256 ^ I)
- Next I
- End Function
- Public Function GetHdInfo() As smHdInfoType()
- Dim RevInfo() As smHdInfoType
- Dim verinfo As OSVERSIONINFO
- Dim Ret As Long
- verinfo.dwOSVersionInfoSize = Len(verinfo)
- Ret = GetVersionEx(verinfo)
- Select Case verinfo.dwPlatformId
- Case VER_PLATFORM_WIN32S
- ReDim RevInfo(1)
- RevInfo(0).InfoFlag = False
- Case VER_PLATFORM_WIN32_WINDOWS
- RevInfo = hdid9x()
- Case VER_PLATFORM_WIN32_NT
- RevInfo = hdidnt()
- End Select
- GetHdInfo = RevInfo
- End Function
VB取硬盘的物理信息(序列号,容量,转速,型号)
最新推荐文章于 2021-07-26 08:02:01 发布