'原作: Bardo
'出處: 《東方熱訊》網站
'網址: www.easthot.net
'****************************************************************
'（如需轉載，請不在刪除以上信息，否則視為侵權�。�
'****************************************************************
要這個有什么用？可以生成與硬件相關的注冊碼�？刂栖浖恢貜褪褂�！那么，很多多人認為VB實現不了。自然沒有找到方法，一定是實現不了。然而，感謝WWW，我們能在上面找到VC的源碼，DELPHI的源碼。但是VB的就是見不到。為此，我決定將VC的源碼改成VB的，以下即是：
'VC原作說明部分（再發行時，請注意采用注解的方式，請不要刪除的方式侵權，謝謝�。�
'*************************************************************************
'通常情況下,我們通過=&HEC命令對IDE端口進行監測.獲取硬盤信息.
'一般情況下,我們就寫個VXD或者DRIVER來完成.但是現在,通過MS的S.M.A.R.T.接口,
'我們可以直接從RING3調用API DeviceIoControl()來獲取硬盤信息.下面乃是我的例程:
'另外,也有編譯好的版本供大家平時使用.歡迎下載.
'/*+++
'HDID.CPP
'Written by Lu Lin
'http://lu0.126.com
'2000.11.3
'---*/
'*************************************************************************
'VB程序編制: BARDO
'本來我想寫一個只取盤動物理序列號的。但是考慮到大家學習的方便。還是將原來的代碼
'全部翻譯了出來。如果你需要單一的只查一個主硬盤的序列號的程序，歡迎到本站下載。
'
'網站：東方熱訊：http://www.easthot.net
'郵件：sales@easthot.net
'2003.01.23
'*************************************************************************
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
'/*+++
'Global vars
'---*/
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
文章來源于領測軟件測試網 http://www.kjueaiud.com/
