直接从RING3获取硬盘序列号
'直接从RING3获取硬盘序列号
Option Explicit
'以下这一行是必须的，困为要做结构复制。而结构中有数组。所以，没有它则会错位
Option Base 0
Private Const DFP_GET_VERSION = &H74080
Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
'#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 = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
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 CopyRight()
'VC原版权代码（再发行时，请注意采用注解的方式，请不要删除的方式侵权，谢谢！）
'****************************************************************************
' cerr<<endl<<"HDD identifier v1.0 for WIN95/98/Me/NT/2000. written by Lu Lin"<<endl
' cerr<<"For more information, please visit Inside Programming: http:'lu0.126.com"<<endl
' cerr<<"2000.11.3"<<endl<<endl
'****************************************************************************
Dim StrMsg As String
StrMsg = StrMsg & "直接从RING3调用API DeviceIoControl()来获取硬盘信息的VB程序 "
StrMsg = StrMsg & vbCrLf & "VC源作板权信息如下："
StrMsg = StrMsg & vbCrLf & "***********************************************************"
StrMsg = StrMsg & vbCrLf & "HDD identifier v1.0 for WIN95/98/Me/NT/2000. written by Lu Lin"
StrMsg = StrMsg & vbCrLf & "For more information, please visit Inside Programming: http://lu0.126.com"
StrMsg = StrMsg & vbCrLf & "2000.11.3"
StrMsg = StrMsg & vbCrLf & "***********************************************************"
StrMsg = StrMsg & vbCrLf & "VB程序编制：BARDO"
StrMsg = StrMsg & vbCrLf & "网站：东方热讯：http://www.easthot.net"
StrMsg = StrMsg & vbCrLf & "邮件：sales@easthot.net"
StrMsg = StrMsg & vbCrLf & "2003.01.23"
MsgBox StrMsg
End Sub
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 String
'We start in 95/98/Me
h = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
If h = 0 Then
hdid9x = "open smartvsd.vxd failed"
Exit Function
End If
Dim olp As OVERLAPPED
Dim lRet As Long
lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olp)
If lRet = 0 Then
hdid9x = "DeviceIoControl failed:DFP_GET_VERSION"
CloseHandle (h)
Exit Function
End If
'If IDE identify command not supported, fails
If (vers.fCapabilities And 1) <> 1 Then
hdid9x = "Error: IDE identify command not supported."
CloseHandle (h)
Exit Function
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
If (j And 1) = 1 Then
in_data.irDriveRegs.bDriveHeadReg = &HB0
Else
in_data.irDriveRegs.bDriveHeadReg = &HA0
End If
If (vers.fCapabilities And (16 \ (2 ^ j))) = (16 \ (2 ^ j)) Then
'We don't detect a ATAPI device.
hdid9x = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
Else
in_data.irDriveRegs.bCommandReg = &HEC
in_data.bDriveNumber = j
in_data.irDriveRegs.bSectorCountReg = 1
in_data.irDriveRegs.bSectorNumberReg = 1
in_data.cBufferSize = 512
lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal i, olp)
If lRet = 0 Then
hdid9x = "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
CloseHandle (h)
Exit Function
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)
hdid9x = hdid9x & vbCrLf & "Module Number:" & StrOut
CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
s(8) = 0
ChangeByteOrder s, 8
StrOut = ByteArrToString(s, 8)
hdid9x = hdid9x & vbCrLf & "Firmware rev:" & StrOut
CopyMemory s(0), phdinfo.sSerialNumber(0), 20
s(20) = 0
ChangeByteOrder s, 20
StrOut = ByteArrToString(s, 20)
hdid9x = hdid9x & vbCrLf & "Serial Number:" & StrOut
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
s(5) = 0
Dim dblStrOut As Double
dblStrOut = ByteArrToLong(s)
hdid9x = hdid9x & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
End If
Next j
'Close handle before quit
CloseHandle (h)
CopyRight
End Function
Private Function hdidnt() As String
Dim hd As String * 80
Dim phdinfo As TIDSECTOR
Dim s(40) As Byte
Dim StrOut As String
hdidnt = ""
'We start in NT/Win2000
For j = 0 To 3 '这里取四个硬盘的信息，因为正常PC不超过四个硬盘
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
CloseHandle (h)
Else
'If IDE identify command not supported, fails
If (vers.fCapabilities And 1) <> 1 Then
hdidnt = "Error: IDE identify command not supported."
CloseHandle (h)
Exit Function
End If
'Identify the IDE drives
If (j And 1) = 1 Then
in_data.irDriveRegs.bDriveHeadReg = &HB0
Else
in_data.irDriveRegs.bDriveHeadReg = &HA0
End If
If (vers.fCapabilities And (16 \ (2 ^ j))) <> 0 Then
'We don't detect a ATAPI device.
hdidnt = hdidnt & vbCrLf & "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
Else
in_data.irDriveRegs.bCommandReg = &HEC
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"
CloseHandle (h)
Else
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)
hdidnt = hdidnt & vbCrLf & "Module Number:" & StrOut
CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
s(8) = 0
ChangeByteOrder s, 8
StrOut = ByteArrToString(s, 8)
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
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
s(5) = 0
Dim dblStrOut As Double
dblStrOut = ByteArrToLong(s)
hdidnt = hdidnt & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
CloseHandle (h)
End If
End If
End If
Next j
CopyRight
End Function
Sub Main()
Dim verinfo As OSVERSIONINFO
Dim Ret As Long
verinfo.dwOSVersionInfoSize = Len(verinfo)
Ret = GetVersionEx(verinfo)
Dim OutStr As String
Select Case verinfo.dwPlatformId
Case VER_PLATFORM_WIN32S
MsgBox "Win32s is not supported by this programm."
End
Case VER_PLATFORM_WIN32_WINDOWS
OutStr = hdid9x
MsgBox OutStr
End
Case VER_PLATFORM_WIN32_NT
OutStr = hdidnt
MsgBox OutStr
End
End Select
End Sub
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
这么好的东西怎能不顶。。。。 顶！顶！顶！ 好东西！！！
页:
[1]