VB取硬盘的物理信息(序列号,容量,转速,型号)
来源:互联网 发布:安卓看片软件哪个好 编辑:程序博客网 时间:2024/06/10 08:49
- Option Explicit
- Option Base 0
- Private Const DFP_GET_VERSION =
- Private Const DFP_SEND_DRIVE_COMMAND =
- Private Const DFP_RECEIVE_DRIVE_DATA =
- Private Type TGETVERSIONOUTPARAMS
- bVersion As Byte
- bRevision As Byte
- bReserved As Byte
- bIDEDeviceMap As Byte
- fCapabilities As Long
- dwReserved(4) As Long
- End Type
- Private Type TIDEREGS
- 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 TSENDCMDINPARAMS
- cBufferSize As Long
- irDriveRegs As TIDEREGS
- bDriveNumber As Byte
- bReserved(2) As Byte
- dwReserved(3) As Long
-
- End Type
- Private Type TDRIVERSTATUS
- bDriverError As Byte
- bIDEStatus As Byte
-
- bReserved(1) As Byte
- dwReserved(1) As Long
- End Type
- Private Type TSENDCMDOUTPARAMS
- cBufferSize As Long
- DRIVERSTATUS As TDRIVERSTATUS
- bBuffer(511) As Byte
-
- End Type
- 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
- wMultSectorStuff As Integer
- ulTotalAddressableSectors(3) As Byte
- 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()
-
- 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 (vers.fCapabilities And 1) <> 1 Then
-
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- GoTo EndFun
- End If
-
-
- Dim sPreOutStr As String
- sPreOutStr = DetectIDE(vers.bIDEDeviceMap)
-
-
-
- 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)
-
- 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
-
- 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
-
-
-
-
- For J = 0 To 3
- RevID = RevID + 1
- ReDim Preserve RevInfo(RevID - 1)
- RevInfo(RevID - 1).Hdid = CStr(J)
-
- hd = "//./PhysicalDrive" & CStr(J)
-
- 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 (vers.fCapabilities And 1) <> 1 Then
-
- RevInfo(RevID - 1).InfoFlag = False
- CloseHandle (h)
- GoTo EndFun
-
- End If
-
- 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
-
- 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
-
- 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
-
- 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)
-
- 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)
-
-
- 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"
-
- 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取硬盘的物理信息(序列号,容量,转速,型号)
- VB取硬盘的物理序列号
- JSP利用JNI获取硬盘信息(型号,序列号,容量...)
- vb获得硬盘物理序列号
- JSP利用JNI获取硬盘信息(型号,序列号,容量...) ,提供固定下载地址
- [转载]纯VB代码取得硬盘的物理序列号
- 纯VB代码取得硬盘的物理序列号
- 纯VB代码取得硬盘的物理序列号
- 纯VB代码取得硬盘的物理序列号
- Window 查看硬盘信息,硬盘序列号,硬盘型号
- vb获取cpuid 硬盘物理序列号和逻辑盘序列号 的方法
- 读取硬盘的物理序列号
- 读取硬盘的物理序列号
- 查看硬盘的型号信息
- 通过WMI获得硬盘和CPU的物理序列号(VB.net)
- 通过WMI获得硬盘和CPU的物理序列号(VB.net)
- 通过WMI获得硬盘和CPU的物理序列号(VB.net)
- 通过WMI获得硬盘和CPU的物理序列号(VB.net)
- VB各种标准对话框
- 连接到SQL Server 2005时,在默认的设置下SQL Server不允许进行远程连接
- VB中自定义一个调色板
- VB 磁盘信息,文件夹,文件操作
- 关闭xp默认共享
- VB取硬盘的物理信息(序列号,容量,转速,型号)
- STL实现集合交集运算
- Trac组件架构
- 马云经典语录
- Web-Based Rich Text Editors Compared
- VB利用API进行媒体播放
- 档案揭秘之野心不死 1959年日本曾密谋造航母
- VB对数字/字符数组的快速排序.查找.
- DispatchAction的流程: