'方法：GetDiskName() '参数类型：Integer '参数： DiskNum '返回值类型：String '返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。 '说明：传入需要查看的磁盘的号码，得到磁盘名称信息。 ' '方法：GetDiskSerial_Number() '参数类型：Integer '参数： DiskNum '返回值类型：String '返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。 '说明：传入需要查看的磁盘的号码，得到磁盘序列号信息。 ' '方法：GetDiskModule_Number() '参数类型：Integer '参数： DiskNum '返回值类型：String '返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。 '说明：传入需要查看的磁盘的号码，得到磁盘模块编号信息。 ' '方法：GetDiskFirmware_rev() '参数类型：Integer '参数： DiskNum '返回值类型：String '返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。 '说明：传入需要查看的磁盘的号码，得到磁盘硬件版本信息。 ' '方法：GetDiskCapacity() '参数类型：Integer '参数： DiskNum '返回值类型：String '返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。 '说明：传入需要查看的磁盘的号码，得到磁盘容量信息。'方法：GetDiskErrStr() '参数类型：Integer '参数： DiskNum '返回值类型：String '返回值：非空表示成功，""表示失败。 '说明：传入需要查看的磁盘的号码，得到关于此磁盘的错误信息。 ' '注意：在本类中，传入的磁盘号码从0到3分别表示普通PC机的4块硬盘。Option Explicit Option Base 0Private Const DFP_GET_VERSION = &H74080 Private Const DFP_SEND_DRIVE_COMMAND = &H7C084 Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088Private 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 TypePrivate 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 TypePrivate 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 TypePrivate 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 TypePrivate 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没有USHORTPrivate 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 TypePrivate vers As TGETVERSIONOUTPARAMS Private in_data As TSENDCMDINPARAMS Private out_data As TSENDCMDOUTPARAMS Private h As Long Private i As Long Private j As BytePrivate Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End TypePrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _ (LpVersionInformation As OSVERSIONINFO) As LongPrivate Const VER_PLATFORM_WIN32S = 0 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2Private 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 LongPrivate 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 = &H2Private Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End TypePrivate Type Diskinfo DiskSerial_Number As String DiskName As String DiskModule_Number As String DiskFirmware_rev As String DiskCapacity As String ErrStr As String End TypePrivate 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 LongPrivate 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 Diskinfo(3) As DiskinfoPrivate Sub Class_Initialize() 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 Diskinfo(0).ErrStr = "Win32s is not supported by this programm." Diskinfo(1).ErrStr = "Win32s is not supported by this programm." Diskinfo(2).ErrStr = "Win32s is not supported by this programm." Diskinfo(3).ErrStr = "Win32s is not supported by this programm." Case VER_PLATFORM_WIN32_WINDOWS hdid9x Case VER_PLATFORM_WIN32_NT hdidnt End Select End SubPublic Function GetDiskSerial_Number(DiskNum As Integer) As String If DiskNum < 4 And DiskNum >= 0 Then GetDiskSerial_Number = Diskinfo(DiskNum).DiskSerial_Number End If End Function
Public Function GetDiskName(DiskNum As Integer) As String If DiskNum < 4 And DiskNum >= 0 Then GetDiskName = Diskinfo(DiskNum).DiskName End If End FunctionPublic Function GetDiskModule_Number(DiskNum As Integer) As String If DiskNum < 4 And DiskNum >= 0 Then GetDiskModule_Number = Diskinfo(DiskNum).DiskModule_Number End If End FunctionPublic Function GetDiskFirmware_rev(DiskNum As Integer) As String If DiskNum < 4 And DiskNum >= 0 Then GetDiskFirmware_rev = Diskinfo(DiskNum).DiskFirmware_rev End If End FunctionPublic Function GetDiskCapacity(DiskNum As Integer) As String If DiskNum < 4 And DiskNum >= 0 Then GetDiskCapacity = Diskinfo(DiskNum).DiskCapacity End If End FunctionPublic Function GetDiskErrStr(DiskNum As Integer) As String If DiskNum < 4 And DiskNum >= 0 Then GetDiskErrStr = Diskinfo(DiskNum).ErrStr End If End FunctionPrivate 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 FunctionPrivate 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 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 FunctionPrivate 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 FunctionPrivate Sub hdid9x() Dim j As Long Dim DiskName As String 'We start in 95/98/Me h = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0) If h = 0 Then Diskinfo(0).ErrStr = "open smartvsd.vxd failed" Diskinfo(1).ErrStr = "open smartvsd.vxd failed" Diskinfo(2).ErrStr = "open smartvsd.vxd failed" Diskinfo(3).ErrStr = "open smartvsd.vxd failed" Exit Sub 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 Diskinfo(0).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION" Diskinfo(1).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION" Diskinfo(2).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION" Diskinfo(3).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION" CloseHandle (h) Exit Sub End If
'If IDE identify command not supported, fails If (vers.fCapabilities And 1) <> 1 Then Diskinfo(0).ErrStr = "Error: IDE identify command not supported." Diskinfo(1).ErrStr = "Error: IDE identify command not supported." Diskinfo(2).ErrStr = "Error: IDE identify command not supported." Diskinfo(3).ErrStr = "Error: IDE identify command not supported." CloseHandle (h) Exit Sub End If
'Display IDE drive number detected ' Dim sPreOutStr As String DiskName = DetectIDE(vers.bIDEDeviceMap) Diskinfo(0).DiskName = DiskName Diskinfo(1).DiskName = DiskName Diskinfo(2).DiskName = DiskName Diskinfo(3).DiskName = DiskName
For j = 0 To 3 'Identify the IDE drives 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. Diskinfo(j).ErrStr = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it" Exit Sub Else in_data.irDriveRegs.bCommandReg = &HEC in_data.bDriveNumber = j in_data.irDriveRegs.bSectorCountReg = 1 in_data.irDriveRegs.bSectorNumberReg = 1 in_data.cBufferSize = 512
s(5) = 0 Dim dblStrOut As Double Diskinfo(j).DiskCapacity = ByteArrToLong(s) / 2 / 1024 & "M"
End IfNext j
CloseHandle (h)End SubPrivate Sub hdidnt() Dim hd As String * 80 Dim phdinfo As TIDSECTOR Dim s(40) As Byte Dim j As Long
For j = 0 To 3 hd = "\\.\PhysicalDrive" & CStr(j) Diskinfo(j).DiskName = 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) Diskinfo(j).ErrStr = "No Such Disk" 'Exit Function Else 'If IDE identify command not supported, fails If (vers.fCapabilities And 1) <> 1 Then Diskinfo(j).ErrStr = "Error: IDE identify command not supported." CloseHandle (h) Exit Sub 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. Diskinfo(j).ErrStr = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it" 'Exit Function Else
CloseHandle (h) End If End If End IfNext j End Sub上面的是类代码 下面的是窗体代码'窗体代码 Option Explicit Dim clsGetDiskNum As New GetDiskInfoPrivate Sub Form_Load() MsgBox "硬盘序列号：" & clsGetDiskNum.GetDiskSerial_Number(0) End Sub SATA硬盘不管用，只有PATA硬盘能行，以前98系统用过，能行。
'参数类型：Integer
'参数： DiskNum
'返回值类型：String
'返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。
'说明：传入需要查看的磁盘的号码，得到磁盘名称信息。
'
'方法：GetDiskSerial_Number()
'参数类型：Integer
'参数： DiskNum
'返回值类型：String
'返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。
'说明：传入需要查看的磁盘的号码，得到磁盘序列号信息。
'
'方法：GetDiskModule_Number()
'参数类型：Integer
'参数： DiskNum
'返回值类型：String
'返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。
'说明：传入需要查看的磁盘的号码，得到磁盘模块编号信息。
'
'方法：GetDiskFirmware_rev()
'参数类型：Integer
'参数： DiskNum
'返回值类型：String
'返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。
'说明：传入需要查看的磁盘的号码，得到磁盘硬件版本信息。
'
'方法：GetDiskCapacity()
'参数类型：Integer
'参数： DiskNum
'返回值类型：String
'返回值：非空表示成功，""表示失败。可以通过ErrStr方法查看详细错误资料。
'说明：传入需要查看的磁盘的号码，得到磁盘容量信息。'方法：GetDiskErrStr()
'参数类型：Integer
'参数： DiskNum
'返回值类型：String
'返回值：非空表示成功，""表示失败。
'说明：传入需要查看的磁盘的号码，得到关于此磁盘的错误信息。
'
'注意：在本类中，传入的磁盘号码从0到3分别表示普通PC机的4块硬盘。Option Explicit
Option Base 0Private Const DFP_GET_VERSION = &H74080
Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088Private 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 TypePrivate 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 TypePrivate 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 TypePrivate 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 TypePrivate 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没有USHORTPrivate 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 TypePrivate vers As TGETVERSIONOUTPARAMS
Private in_data As TSENDCMDINPARAMS
Private out_data As TSENDCMDOUTPARAMS
Private h As Long
Private i As Long
Private j As BytePrivate Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End TypePrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(LpVersionInformation As OSVERSIONINFO) As LongPrivate Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2Private 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 LongPrivate 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 = &H2Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End TypePrivate Type Diskinfo
DiskSerial_Number As String
DiskName As String
DiskModule_Number As String
DiskFirmware_rev As String
DiskCapacity As String
ErrStr As String
End TypePrivate 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 LongPrivate 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 Diskinfo(3) As DiskinfoPrivate Sub Class_Initialize()
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
Diskinfo(0).ErrStr = "Win32s is not supported by this programm."
Diskinfo(1).ErrStr = "Win32s is not supported by this programm."
Diskinfo(2).ErrStr = "Win32s is not supported by this programm."
Diskinfo(3).ErrStr = "Win32s is not supported by this programm."
Case VER_PLATFORM_WIN32_WINDOWS
hdid9x
Case VER_PLATFORM_WIN32_NT
hdidnt
End Select
End SubPublic Function GetDiskSerial_Number(DiskNum As Integer) As String
If DiskNum < 4 And DiskNum >= 0 Then
GetDiskSerial_Number = Diskinfo(DiskNum).DiskSerial_Number
End If
End Function
If DiskNum < 4 And DiskNum >= 0 Then
GetDiskName = Diskinfo(DiskNum).DiskName
End If
End FunctionPublic Function GetDiskModule_Number(DiskNum As Integer) As String
If DiskNum < 4 And DiskNum >= 0 Then
GetDiskModule_Number = Diskinfo(DiskNum).DiskModule_Number
End If
End FunctionPublic Function GetDiskFirmware_rev(DiskNum As Integer) As String
If DiskNum < 4 And DiskNum >= 0 Then
GetDiskFirmware_rev = Diskinfo(DiskNum).DiskFirmware_rev
End If
End FunctionPublic Function GetDiskCapacity(DiskNum As Integer) As String
If DiskNum < 4 And DiskNum >= 0 Then
GetDiskCapacity = Diskinfo(DiskNum).DiskCapacity
End If
End FunctionPublic Function GetDiskErrStr(DiskNum As Integer) As String
If DiskNum < 4 And DiskNum >= 0 Then
GetDiskErrStr = Diskinfo(DiskNum).ErrStr
End If
End FunctionPrivate 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 FunctionPrivate 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 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 FunctionPrivate 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 FunctionPrivate Sub hdid9x()
Dim j As Long
Dim DiskName As String 'We start in 95/98/Me
h = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
If h = 0 Then
Diskinfo(0).ErrStr = "open smartvsd.vxd failed"
Diskinfo(1).ErrStr = "open smartvsd.vxd failed"
Diskinfo(2).ErrStr = "open smartvsd.vxd failed"
Diskinfo(3).ErrStr = "open smartvsd.vxd failed"
Exit Sub
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
Diskinfo(0).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION"
Diskinfo(1).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION"
Diskinfo(2).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION"
Diskinfo(3).ErrStr = "DeviceIoControl failed:DFP_GET_VERSION"
CloseHandle (h)
Exit Sub
End If
If (vers.fCapabilities And 1) <> 1 Then
Diskinfo(0).ErrStr = "Error: IDE identify command not supported."
Diskinfo(1).ErrStr = "Error: IDE identify command not supported."
Diskinfo(2).ErrStr = "Error: IDE identify command not supported."
Diskinfo(3).ErrStr = "Error: IDE identify command not supported."
CloseHandle (h)
Exit Sub
End If
'Display IDE drive number detected
' Dim sPreOutStr As String
DiskName = DetectIDE(vers.bIDEDeviceMap)
Diskinfo(0).DiskName = DiskName
Diskinfo(1).DiskName = DiskName
Diskinfo(2).DiskName = DiskName
Diskinfo(3).DiskName = DiskName
For j = 0 To 3
'Identify the IDE drives
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.
Diskinfo(j).ErrStr = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
Exit Sub
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
Diskinfo(j).ErrStr = "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
CloseHandle (h)
Exit Sub
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
Diskinfo(j).DiskModule_Number = ByteArrToString(s, 40)
CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
s(8) = 0
ChangeByteOrder s, 8
Diskinfo(j).DiskFirmware_rev = ByteArrToString(s, 8)
CopyMemory s(0), phdinfo.sSerialNumber(0), 20
s(20) = 0
ChangeByteOrder s, 20
Diskinfo(j).DiskSerial_Number = ByteArrToString(s, 20)
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
s(5) = 0
Dim dblStrOut As Double
Diskinfo(j).DiskCapacity = ByteArrToLong(s) / 2 / 1024 & "M"
End IfNext j
CloseHandle (h)End SubPrivate Sub hdidnt()
Dim hd As String * 80
Dim phdinfo As TIDSECTOR
Dim s(40) As Byte
Dim j As Long
For j = 0 To 3
hd = "\\.\PhysicalDrive" & CStr(j)
Diskinfo(j).DiskName = 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)
Diskinfo(j).ErrStr = "No Such Disk"
'Exit Function
Else
'If IDE identify command not supported, fails
If (vers.fCapabilities And 1) <> 1 Then
Diskinfo(j).ErrStr = "Error: IDE identify command not supported."
CloseHandle (h)
Exit Sub
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.
Diskinfo(j).ErrStr = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
'Exit Function
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
Diskinfo(j).ErrStr = "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
Diskinfo(j).DiskModule_Number = ByteArrToString(s, 40)
CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
s(8) = 0
ChangeByteOrder s, 8
Diskinfo(j).DiskFirmware_rev = ByteArrToString(s, 8)
CopyMemory s(0), phdinfo.sSerialNumber(0), 20
s(20) = 0
ChangeByteOrder s, 20
Diskinfo(j).DiskSerial_Number = ByteArrToString(s, 20)
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
s(5) = 0
Diskinfo(j).DiskCapacity = ByteArrToLong(s) / 2 / 1024 & "M"
CloseHandle (h)
End If
End If
End IfNext j
End Sub上面的是类代码
下面的是窗体代码'窗体代码
Option Explicit
Dim clsGetDiskNum As New GetDiskInfoPrivate Sub Form_Load()
MsgBox "硬盘序列号：" & clsGetDiskNum.GetDiskSerial_Number(0)
End Sub
SATA硬盘不管用，只有PATA硬盘能行，以前98系统用过，能行。