用VB如何得到硬盘物理(硬件)序列号(不是硬盘逻辑序列号)?

Chengs_bbs 2005-07-04 08:38:28
1、用VB如何得到硬盘物理(硬件)序列号(不是硬盘逻辑序列号)?
2、我想做软件的注册,听说不是每台PC机的硬盘都有序列号,是真的吗?
...全文
745 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
Chengs_bbs 2005-07-05
  • 打赏
  • 举报
回复
小新:
显示的是空的,代码如下:
_____________________
Option Explicit

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
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 Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type IDERegs
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 InParams
cBufferSize As Long
irDriveRegs As IDERegs
bDriveNumber As Byte
bReserved(0 To 19) As Byte
End Type

Dim inbuff As InParams
Dim outbuff(0 To 528) As Byte
Dim SerialNumber As String

Private Function ChangeByteOrder(s As Variant, nLen As Long)
Dim i As Long
Dim pi As Long
pi = 0
For i = 0 To nLen / 2 - 1
c = s(pi)
s(pi) = s(pi + 1)
s(pi + 1) = c
pi = pi + 2
Next
End Function

Private Sub Main()
Dim nBytes As Long
Dim nRet As Long
Dim hVxD As Long

Dim BSerialNumber(0 To 19) As Byte

inbuff.cBufferSize = 512
inbuff.bDriveNumber = 0
inbuff.irDriveRegs.bSectorCountReg = 1
inbuff.irDriveRegs.bSectorNumberReg = 1
inbuff.irDriveRegs.bCylHighReg = 0
inbuff.irDriveRegs.bCylLowReg = 0
inbuff.irDriveRegs.bDriveHeadReg = &HA0
inbuff.irDriveRegs.bCommandReg = &HEC
hVxD = CreateFile("\\.\smartvsd", 0, 0, 0, 1, 0, 0)
nRet = DeviceIoControl(hVxD, &H7C088, inbuff, Len(inbuff) - 1, outbuff(0), 528, nBytes, 0)
If nRet > 0 Then
CopyMemory BSerialNumber(0), outbuff(36), 20
SerialNumber = StrConv(BSerialNumber, vbUnicode)
SerialNumber = Trim(SerialNumber)
End If
Call CloseHandle(hVxD)

Debug.Print SerialNumber
End Sub

Private Sub Command1_Click()
Call Main
End Sub
Hotus 2005-07-04
  • 打赏
  • 举报
回复
方法太多了
w3k 2005-07-04
  • 打赏
  • 举报
回复
VB没实现过!最好用VC或者DELPHI写的DLL
VB调用获取吧,我是这样做的
Chengs_bbs 2005-07-04
  • 打赏
  • 举报
回复
怎么得到?
VsonChow 2005-07-04
  • 打赏
  • 举报
回复
有的啊。不过好像对老硬盘不行。
Chengs_bbs 2005-07-04
  • 打赏
  • 举报
回复
wenhongL(三脚猫) :
你这种是得到硬盘逻辑序列号(格式化后ID改变了),有没有办法得到硬盘物理序列号(格式化ID不变).
wenhongL 2005-07-04
  • 打赏
  • 举报
回复
在模块中加入下列声明:
Public Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
'得到某一磁盘分区的信息,如C:

窗体代码如下:
Option Explicit
Private Regid, Localid As Long

Private Sub CmdLocalID_Click()
'根据C盘序列号得到原ID
Dim Driver, VolName, Fsys As String
Dim volNumber, MCM, FSF As Long
Driver = "c:\"
Dim res As Long
res = GetVolumeInformation(Driver, VolName, 127, volNumber, MCM, FSF, Fsys, 127)
'volNumber是C盘序列号
Localid = volNumber / 2 + 123456789
Text1.Text = Localid
End Sub

Private Sub CmdRegID_Click()
'根据原ID算出注册ID
If IsNumeric(Text1.Text) Then
Regid = CLng(Text1.Text) / 4 * 3 + 987654321
Else
'error
End If
Text2.Text = Regid
End Sub

Private Sub CmndCheckID_Click()
'验证注册ID
Dim Driver, VolName, Fsys As String
Dim volNumber, MCM, FSF As Long
Driver = "c:\"
Dim res As Long
res = GetVolumeInformation(Driver, VolName, 127, volNumber, MCM, FSF, Fsys, 127)
Dim Tid As Long
Tid = volNumber / 2 + 123456789
If Regid = Tid / 4 * 3 + 987654321 Then
MsgBox "正确!"
Else
MsgBox "错误!"
End If
End Sub

为便于演示,我在窗体上用了两个文本框三个按钮,请根据情况灵活使用,可以在用户端算出原ID,发给你,你算出注册ID再发给用户,验证当然是在用户端啦。ID算法很简单,只作示范。此注册ID只能在这一台机器上使用,对于非高手用户来说是足够啦。
注:如用户格式化C:盘后需重新获得ID。
saiko 2005-07-04
  • 打赏
  • 举报
回复
'转贴
'注意:以下代码得到的是硬盘厂商固定的序列号,而不是硬盘的逻辑序列号
’以下代码支持Windows 95 OSR2, Windows 98, Windwos 98 SE, Windows ME
'第一个硬盘必须为IDE接口
’------------------------源代码开始--------------------------------
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
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 Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Type IDERegs
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

Type InParams
cBufferSize As Long
irDriveRegs As IDERegs
bDriveNumber As Byte
bReserved(0 To 19) As Byte
End Type


Dim inbuff As InParams
Dim outbuff(0 To 528) As Byte

Dim SerialNumber As String


Function ChangeByteOrder(s As Variant, nLen As Long)
Dim i As Long
Dim pi As Long
pi = 0
For i = 0 To nLen / 2 - 1
c = s(pi)
s(pi) = s(pi + 1)
s(pi + 1) = c
pi = pi + 2
Next

End Function

Dim SerialNumber As String

Sub Main()
Dim nBytes As Long
Dim nRet As Long
Dim hVxD As Long

Dim BSerialNumber(0 To 19) As Byte

inbuff.cBufferSize = 512
inbuff.bDriveNumber = 0
inbuff.irDriveRegs.bSectorCountReg = 1
inbuff.irDriveRegs.bSectorNumberReg = 1
inbuff.irDriveRegs.bCylHighReg = 0
inbuff.irDriveRegs.bCylLowReg = 0
inbuff.irDriveRegs.bDriveHeadReg = &HA0
inbuff.irDriveRegs.bCommandReg = &HEC
hVxD = CreateFile("\\.\smartvsd", 0, 0, 0, 1, 0, 0)
nRet = DeviceIoControl(hVxD, &H7C088, inbuff, Len(inbuff) - 1, outbuff(0), 528, nBytes, 0)
If nRet > 0 Then
CopyMemory BSerialNumber(0), outbuff(36), 20
SerialNumber = StrConv(BSerialNumber, vbUnicode)
SerialNumber = Trim(SerialNumber)
End If
Call CloseHandle(hVxD)

MsgBox SerialNumber
End Sub

'----------代码结束---------------------------------
  • 打赏
  • 举报
回复
用DISK32.DLL控件就可以实现。去网上找一下就可以搜到例子了。
不过如果机器里有RIAD就会出错了
wenhongL 2005-07-04
  • 打赏
  • 举报
回复

' Metodo GetModelNumber
Public Function GetModelNumber() As String

' Ottiene il ModelNumber
GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)

End Function

' Metodo GetSerialNumber
Public Function GetSerialNumber() As String

' Ottiene il SerialNumber
GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)

End Function

' Metodo GetFirmwareRevision
Public Function GetFirmwareRevision() As String

' Ottiene la FirmwareRevision
GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION)

End Function

' Proprieta' CurrentDrive
Public Property Let CurrentDrive(ByVal vData As Byte)

' Controllo numero di drive fisico IDE
If vData < 0 Or vData > 3 Then
Err.Raise 10000, , "Illegal drive number" ' IDE drive 0..3
End If

' Nuovo drive da considerare
mvarCurrentDrive = vData

End Property

' Proprieta' CurrentDrive
Public Property Get CurrentDrive() As Byte

' Restituisce drive fisico corrente (IDE 0..3)
CurrentDrive = mvarCurrentDrive

End Property

' Proprieta' Platform
Public Property Get Platform() As String

' Restituisce tipo OS
Platform = mvarPlatform

End Property

Private Sub Class_Initialize()

' Individuazione del tipo di OS
Dim OS As OSVERSIONINFO

OS.dwOSVersionInfoSize = Len(OS)
Call GetVersionEx(OS)
mvarPlatform = "Unk"
Select Case OS.dwPlatformId
Case Is = VER_PLATFORM_WIN32S
mvarPlatform = "32S" ' Win32S
Case Is = VER_PLATFORM_WIN32_WINDOWS
If OS.dwMinorVersion = 0 Then
mvarPlatform = "W95" ' Win 95
Else
mvarPlatform = "W98" ' Win 98
End If
Case Is = VER_PLATFORM_WIN32_NT
mvarPlatform = "WNT" ' Win NT/2000
End Select

End Sub

Private Function CmnGetHDData(hdi As HDINFO) As String

' Rilevazione proprieta' IDE

Dim bin As SENDCMDINPARAMS
Dim bout As SENDCMDOUTPARAMS
Dim hdh As Long
Dim br As Long
Dim ix As Long
Dim hddfr As Long
Dim hddln As Long
Dim s As String

Select Case hdi ' Selezione tipo caratteristica richiesta
Case HD_MODEL_NUMBER
hddfr = 55 ' Posizione nel buffer del ModelNumber
hddln = 40 ' Lunghezza nel buffer del ModelNumber
Case HD_SERIAL_NUMBER
hddfr = 21 ' Posizione nel buffer del SerialNumber
hddln = 20 ' Lunghezza nel buffer del SerialNumber
Case HD_FIRMWARE_REVISION
hddfr = 47 ' Posizione nel buffer del FirmwareRevision
hddln = 8 ' Lunghezza nel buffer del FirmwareRevision
Case Else
Err.Raise 10001, "Illegal HD Data type" ' Altre informazioni non disponibili (Evoluzione futura)
End Select

Select Case mvarPlatform
Case "WNT"
' Per Win NT/2000 apertura handle al drive fisico
hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _
GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _
0, OPEN_EXISTING, 0, 0)
Case "W95", "W98"
' Per Win 9X apertura handle al driver SMART
' (in \WINDOWS\SYSTEM da spostare in \WINDOWS\SYSTEM\IOSUBSYS)
' che comunica con il driver IDE
hdh = CreateFile("\\.\Smartvsd", _
0, 0, 0, CREATE_NEW, 0, 0)
Case Else
' Piattaforma non supportata (Win32S)
Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)" ' Altre piattaforme non gestite
End Select
' Controllo validit?handle
If hdh = 0 Then
Err.Raise 10003, , "Error on CreateFile"
End If

' Azzeramento strutture per l'I/O da driver
ZeroMemory bin, Len(bin)
ZeroMemory bout, Len(bout)

' Preparazione parametri struttura di richiesta al driver
With bin
.bDriveNumber = mvarCurrentDrive
.cBufferSize = 512
With .irDriveRegs
If (mvarCurrentDrive And 1) Then
.bDriveHeadReg = &HB0
Else
.bDriveHeadReg = &HA0
End If
.bCommandReg = &HEC
.bSectorCountReg = 1
.bSectorNumberReg = 1
End With
End With

' Richiesta al driver
DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _
bin, Len(bin), bout, Len(bout), br, 0

' Formazione stringa di risposta
' da buffer di uscita
' L'ordine dei byte e' invertito
s = ""
For ix = hddfr To hddfr + hddln - 1 Step 2
If bout.bBuffer(ix + 1) = 0 Then Exit For
s = s & Chr(bout.bBuffer(ix + 1))
If bout.bBuffer(ix) = 0 Then Exit For
s = s & Chr(bout.bBuffer(ix))
Next ix

' Chiusura handle
CloseHandle hdh

' Restituzione informazione richiesta
CmnGetHDData = Trim(s)

End Function

wenhongL 2005-07-04
  • 打赏
  • 举报
回复
'****************************************************************************
'人人为我,我为人人
'枕善居汉化收藏整理
'发布日期:05/04/23
'描 述:IDE 磁盘序列号读取程序
'网 站:http://www.mndsoft.com/
'e-mail:mnd@mndsoft.com
'OICQ : 88382850
'****************************************************************************
Option Explicit

' Antonio Giuliana, 2001-2003

' Costanti per l'individuazione della versione di OS
Private Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

' Costanti per la comunicazione con il driver IDE
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

' Costanti per la CreateFile
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1

' Enumerazione dei comandi per la CmnGetHDData
Private Enum HDINFO
HD_MODEL_NUMBER
HD_SERIAL_NUMBER
HD_FIRMWARE_REVISION
End Enum

' Struttura per l'individuazione della versione di OS
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' Struttura per il campo irDriveRegs della struttura SENDCMDINPARAMS
Private Type IDEREGS
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

' Struttura per l'I/O dei comandi al driver IDE
Private Type SENDCMDINPARAMS
cBufferSize As Long
irDriveRegs As IDEREGS
bDriveNumber As Byte
bReserved(1 To 3) As Byte
dwReserved(1 To 4) As Long
End Type

' Struttura per il campo DStatus della struttura SENDCMDOUTPARAMS
Private Type DRIVERSTATUS
bDriveError As Byte
bIDEStatus As Byte
bReserved(1 To 2) As Byte
dwReserved(1 To 2) As Long
End Type

' Struttura per l'I/O dei comandi al driver IDE
Private Type SENDCMDOUTPARAMS
cBufferSize As Long
DStatus As DRIVERSTATUS ' ovvero DriverStatus
bBuffer(1 To 512) As Byte
End Type

' Per ottenere la versione del SO
Private Declare Function GetVersionEx _
Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

' Per ottenere un handle al device IDE
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

' Per chiudere l'handle del device IDE
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long

' Per comunicare con il driver IDE
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, _
ByVal lpOverlapped As Long) As Long

' Per azzerare buffer di scambio dati
Private Declare Sub ZeroMemory _
Lib "kernel32" Alias "RtlZeroMemory" _
(dest As Any, _
ByVal numBytes As Long)

' Per copiare porzioni di memoria
Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Declare Function GetLastError _
Lib "kernel32" () As Long

Private mvarCurrentDrive As Byte ' Drive corrente
Private mvarPlatform As String ' Piattaforma usata

Public Property Get Copyright() As String

' Copyright
Copyright = "HDSN Vrs. 1.00, 枕善居收藏整理"

End Property
Chengs_bbs 2005-07-04
  • 打赏
  • 举报
回复
怎么大家都没有具体讲呢?方法太多了等全部是屁话.

7,765

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧