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
Private Type TGETVERSIONOUTPARAMS
bVersion As Byte
bRevision As Byte
bReserved As Byte
x 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 r As TGETVERSIONOUTPARAMS
Private s As TSENDCMDINPARAMS
Private t As TSENDCMDOUTPARAMS
Private u As Long
Private a As Long
Private v 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)
Sub y(w() As Byte, uscStrSize As Long)
Dim a As Long
Dim g As String
For a = 0 To uscStrSize - 1 Step 2
g = w(a)
w(a) = w(a + 1)
w(a + 1) = g
Next a
End Sub

Private Function z() As String
u = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
If u = 0 Then
z = "open smartvsd.vxd failed"
Exit Function
End If
Dim i As OVERLAPPED
Dim b As Long
b = DeviceIoControl(u, DFP_GET_VERSION, ByVal 0&, 0, r, Len(r), ByVal a, i)
If b = 0 Then
z = "DeviceIoControl failed:DFP_GET_VERSION"
CloseHandle (u)
Exit Function
End If
If (r.fCapabilities And 1) <> 1 Then
z = "Error: IDE identify command not supported."
CloseHandle (u)
Exit Function
End If
Dim k As String
k = a2(r.x)
z = k
v = 0
Dim c As TIDSECTOR
Dim d(40) As Byte
If (v And 1) = 1 Then
s.irDriveRegs.bDriveHeadReg = &HB0
Else
s.irDriveRegs.bDriveHeadReg = &HA0
End If
If (r.fCapabilities And (16 \ (2 ^ v))) = (16 \ (2 ^ v)) Then
z = "Drive " & CStr(v + 1) & " is a ATAPI device, we don't detect it"
Else
s.irDriveRegs.bCommandReg = &HEC
s.bDriveNumber = v
s.irDriveRegs.bSectorCountReg = 1
s.irDriveRegs.bSectorNumberReg = 1
s.cBufferSize = 512
b = DeviceIoControl(u, DFP_RECEIVE_DRIVE_DATA, s, Len(s), t, Len(t), ByVal a, i)
If b = 0 Then
z = "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
CloseHandle (u)
Exit Function
End If
Dim e As String
CopyMemory c, t.bBuffer(0), Len(c)
CopyMemory d(0), c.sModelNumber(0), 40
d(40) = 0
y d, 40
e = a3(d, 40)
z = z & vbCrLf & "Module Number:" & e
CopyMemory d(0), c.sFirmwareRev(0), 8
d(8) = 0
y d, 8
e = a3(d, 8)
z = z & vbCrLf & "Firmware rev:" & e
CopyMemory d(0), c.sSerialNumber(0), 20
d(20) = 0
y d, 20
e = a3(d, 20)
z = z & vbCrLf & "您的硬盘序列号为:" & e
End If
CloseHandle (u)
End Function
Private Function a0() As String
Dim l As String * 80
Dim c As TIDSECTOR
Dim d(40) As Byte
Dim e As String
a0 = ""
v = 0
l = "\\.\PhysicalDrive" & CStr(v)
a0 = a0 & vbCrLf & l
u = CreateFile(l, GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
Dim m As OVERLAPPED
Dim b As Long
b = DeviceIoControl(u, DFP_GET_VERSION, ByVal 0&, 0, r, Len(r), ByVal a, m)
If b = 0 Then
CloseHandle (u)
Else
If (r.fCapabilities And 1) <> 1 Then
a0 = "Error: IDE identify command not supported."
CloseHandle (u)
Exit Function
End If
If (v And 1) = 1 Then
s.irDriveRegs.bDriveHeadReg = &HB0
Else
s.irDriveRegs.bDriveHeadReg = &HA0
End If
If (r.fCapabilities And (16 \ (2 ^ v))) <> 0 Then
a0 = a0 & vbCrLf & "Drive " & CStr(v + 1) & " is a ATAPI device, we don't detect it"
Else
s.irDriveRegs.bCommandReg = &HEC
s.bDriveNumber = v
s.irDriveRegs.bSectorCountReg = 1
s.irDriveRegs.bSectorNumberReg = 1
s.cBufferSize = 512
Dim n As OVERLAPPED
b = DeviceIoControl(u, DFP_RECEIVE_DRIVE_DATA, s, Len(s), t, Len(t), ByVal a, n)
If b <= 0 Then
a0 = a0 & vbCrLf & "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
CloseHandle (u)
Else
CopyMemory c, t.bBuffer(0), Len(c)
CopyMemory d(0), c.sModelNumber(0), 40
d(40) = 0
y d, 40
e = a3(d, 40)
a0 = a0 & vbCrLf & "Module Number:" & e
CopyMemory d(0), c.sFirmwareRev(0), 8
d(8) = 0
y d, 8
e = a3(d, 8)
a0 = a0 & vbCrLf & "Firmware rev:" & e
CopyMemory d(0), c.sSerialNumber(0), 20
d(20) = 0
y d, 20
e = a3(d, 20)
a0 = "您的硬盘序列号为:" & Trim(e)
CloseHandle (u)
End If
End If
End If
End Function
Sub a1()
Dim o As OSVERSIONINFO
Dim p As Long
o.dwOSVersionInfoSize = Len(o)
p = GetVersionEx(o)
Dim q As String
Select Case o.dwPlatformId
Case VER_PLATFORM_WIN32S
MsgBox "Win32s 这程序不支持."
End
Case VER_PLATFORM_WIN32_WINDOWS
q = z
MsgBox q
End
Case VER_PLATFORM_WIN32_NT
q = a0
MsgBox q
End
End Select
End Sub

Private Function a2(x As Byte) As String
If (x And 1) Then
If (x And 16) Then
a2 = a2 & "ATAPI device is attached to primary controller, drive 0."
Else
a2 = a2 & "IDE device is attached to primary controller, drive 0."
End If
End If
If (x And 2) Then
If (x And 32) Then
a2 = a2 & "ATAPI device is attached to primary controller, drive 1."
Else
a2 = a2 & "IDE device is attached to primary controller, drive 1."
End If
End If
If (x And 4) Then
If (x And 64) Then
a2 = a2 & "ATAPI device is attached to secondary controller, drive 0."
Else
a2 = a2 & "IDE device is attached to secondary controller, drive 0."
End If
End If
If (x And 8) Then
If (x And 128) Then
a2 = a2 & "ATAPI device is attached to secondary controller, drive 1."
Else
a2 = a2 & "IDE device is attached to secondary controller, drive 1."
End If
End If
End Function

Private Function a3(f() As Byte, ByVal strlen As Integer) As String
Dim a As Integer
For a = 0 To strlen
If f(a) = 0 Then
Exit For
End If
a3 = a3 & Chr(f(a))
Next a
End Function
Private Function a4(f() As Byte) As Double
Dim a As Integer
For a = 0 To 3
a4 = a4 + CDbl(f(a)) * (256 ^ a)
Next a
End Function

Private Sub Command1_Click()
a1
End Sub