谁有能取出真正的硬盘序列号（我有一个三星、一个钻石）的程序.(Ghost、Format、Fdisk作为测试依据)。用VB！测试通过既给510分全给

VB难点吧。
http://nowcan.yeah.net
编程技术－》BCB－》系统里有C写的。

如果只准用VB，可能用WMI可以。

请关注下面的贴子
http://www.csdn.net/expert/topic/701/701403.xml?temp=.7961542

用VB也可以，调用API函数DeviceIOControl就可以，微软提供C源程序，其实完全可以转换成VB实现。

GetVolumeInformation VB声明
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
说明
获取与一个磁盘卷有关的信息
返回值
Long，非零表示成功，零表示失败。会设置GetLastError
参数表
参数类型及说明
lpRootPathName String，欲获取信息的那个卷的根路径
lpVolumeNameBuffer String，用于装载卷名（卷标）的一个字串
nVolumeNameSize Long，lpVolumeNameBuffer字串的长度
lpVolumeSerialNumber Long，用于装载磁盘卷序列号的变量
lpMaximumComponentLength Long，指定一个变量，用于装载文件名每一部分的长度。例如，在“c:\component1\component2.ext”的情况下，它就代表component1或component2名称的长度
lpFileSystemFlags Long，用于装载一个或多个二进制位标志的变量。对这些标志位的解释如下：
FS_CASE_IS_PRESERVED 文件名的大小写记录于文件系统
FS_CASE_SENSITIVE 文件名要区分大小写
FS_UNICODE_STORED_ON_DISK 文件名保存为Unicode格式
FS_PERSISTANT_ACLS 文件系统支持文件的访问控制列表（ACL）安全机制
FS_FILE_COMPRESSION 文件系统支持逐文件的进行文件压缩
FS_VOL_IS_COMPRESSED 整个磁盘卷都是压缩的
lpFileSystemNameBuffer String，指定一个缓冲区，用于装载文件系统的名称（如FAT，NTFS以及其他）
nFileSystemNameSize Long，lpFileSystemNameBuffer字串的长度

lpVolumeSerialNumber Long，用于装载磁盘卷序列号的变量
返回的lpVolumeSerialNumber就是硬盘序列号

不对啊，各位大哥，在GetVolumeInformation取的不是确切的硬盘序列号，我曾经测试过。假如取完后进行第二次fDisk分区.或进行格式化后，取出的序列号不同！这不是我的初衷，也无法当作加密因子。这本来就是卷标号
我希望的是，取出的卷标号无论分区\Ghost\Format后，都可以取出固定序列号。而且两块硬盘的要不一样
！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！
高分悬赏啦！！！！！！！！！！！！！

同意 jdsbjcailei(基度山伯爵）的看法！

请大家听好，我再三申明，要经过Fdisk\format\Ghost。以上的方法我还没有测试完成！（但基度山伯爵的程序无法通过测试！）
Ghost后，取出的结果是相同的！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！

读硬盘序列号的源代码
private Const MAX_FILENAME_LEN = 256
Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" _
   (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)Private Function GetSerialNumber(sDrive As String) As Long
   Dim ser As Long
   Dim s As String * MAX_FILENAME_LEN
   Dim s2 As String * MAX_FILENAME_LEN
   Dim i As Long
   Dim j As Long

   Call GetVolumeInformation(sDrive + ":\" & Chr$(0), s, MAX_FILENAME_LEN, ser, i, j, s2, MAX_FILENAME_LEN)
   GetSerialNumber = ser
End Function

磁盘序列号在每次软盘或硬盘格式化后都重新生成，并且不回重复。许多程序员用此加密。其实也可以修改该函数，可以得到磁盘卷标和文件系统类型信息。声明：
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long代码：Function GetSerialNumber(sRoot As String) As Long
Dim lSerialNum As Long
Dim R As Long
Dim sTemp1 As String, sTemp2 As String
strLabel = String$(255, Chr$(0))
' 磁盘卷标
strType = String$(255, Chr$(0))
' 文件系统类型一般为 FAT
R = GetVolumeInformation(sRoot, strLabel, Len(strLabel), lSerialNum, 0, 0, strType, Len(strType))
GetSerialNumber = lSerialNum
'在 strLabel 中为磁盘卷标
'在 strType 中为文件系统类型
End Function用法：当驱动器不存在时，函数返回 0。如果是个非根目录，也将返回 0：lSerial = GetSerialNumber("c:\")

这个程序一定是对的；须注意的是如果返回的是逻辑驱动器则是Volume
 
 

'even this will bring up same result:
 

'you will get two different serail number for the two drives.
 

'It seems as if logical drives get their own serial number...
 

Private 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
 

Private Sub Form_Load()
 

'KPD-Team 1998
 

'URL: http://www.allapi.net/
 

'E-Mail: [email protected]
 

Dim Serial As Long, VName As String, FSName As String
 

'Create buffers
 

VName = String$(255, Chr$(0))
 

FSName = String$(255, Chr$(0))
 

'get the volume information
 

GetVolumeInformation "C:\", VName, 255, Serial, 0, 0, FSName, 255
 

'Strip the extra chr$(0)'s
 

VName = Left$(VName, InStr(1, VName, Chr$(0)) - 1)
 

FSName = Left$(FSName, InStr(1, FSName, Chr$(0)) - 1)
 

MsgBox "The Volume name of C:\ is '" + VName + "', the File system name of C:\ is '" + FSName + "' and the serial number of C:\ is '" + Trim(Str$(Serial)) + "'", vbInformation + vbOKOnly, App.Title
 

End Sub

磁盘序列号用来加密,每次格式化后生成,而且绝不重复.在vb中我是这样获取它的:
 

 在窗体上放一个label放一个command
 

 然后粘上这一段代码,就可以获得d:盘的序列号:
 

 Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
 


 


 

 Function GetSerialNumber(sRoot As String) As Long
 

 Dim lSerialNum As Long
 

 Dim R As Long
 

 Dim sTemp1 As String, sTemp2 As String
 

 strLabel = String$(255, Chr$(0))
 

 strType = String$(255, Chr$(0))
 

 R = GetVolumeInformation(sRoot, strLabel, Len(strLabel), lSerialNum, 0, 0, strType, Len(strType))
 

 GetSerialNumber = lSerialNum
 

 End Function
 


 

 Private Sub Command1_Click()
 

 i = GetSerialNumber("d:\")
 

 Label1.Caption = "序列号为" + CStr(i)
 

 End Sub

象这样的东西还是做成一个类模块吧！
 'Call Module : CSystem
 Option Explicit
 
 Private Type SYSTEM_INFO
 wProcessorArchitecture As Integer
 wReserved As Integer
 dwPageSize As Long
 lpMinimumApplicationAddress As Long
 lpMaximumApplicationAddress As Long
 dwActiveProcessorMask As Long
 dwNumberOfProcessors As Long
 dwProcessorType As Long
 dwAllocationGranularity As Long
 wProcessorLevel As Integer
 wProcessorRevision As Integer
 End Type
 
 Private Declare Sub GetSystemInfo Lib "KERNEL32" (lpSystemInfo As SYSTEM_INFO)
 
 Private iWinMajor As Integer
 Private iWinMinor As Integer
 Private sMode As String
 Private sys As SYSTEM_INFO
 
 Private Sub Class_Initialize()
 Dim dw As Long, c As Integer
 dw = GetVersion()
 iWinMajor = dw And &HFF&
 iWinMinor = (dw And &HFF00&) / &H100&
 sMode = IIf(dw And &H80000000, "Windows 95", "Windows NT")
 GetSystemInfo sys
 End Sub
 
 Property Get FreePhysicalMemory() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 FreePhysicalMemory = mem.dwAvailPhys \ 1024
 End Property
 
 Property Get TotalPhysicalMemory() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 TotalPhysicalMemory = mem.dwTotalPhys \ 1024
 End Property
 
 Property Get FreeVirtualMemory() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 FreeVirtualMemory = mem.dwAvailVirtual \ 1024
 End Property
 
 Property Get TotalVirtualMemory() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 TotalVirtualMemory = mem.dwTotalVirtual \ 1024
 End Property
 
 Property Get FreePageFile() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 FreePageFile = mem.dwAvailPageFile \ 1024
 End Property
 
 Property Get TotalPageFile() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 TotalPageFile = mem.dwTotalPageFile \ 1024
 End Property
 
 Property Get MemoryLoad() As Long
 Dim mem As MEMORYSTATUS
 mem.dwLength = Len(mem)
 GlobalMemoryStatus mem
 MemoryLoad = mem.dwMemoryLoad
 End Property
 
 Property Get WinMajor() As Integer
 WinMajor = iWinMajor
 End Property
 
 Property Get WinMinor() As Integer
 WinMinor = iWinMinor
 End Property
 
 Property Get WinVersion() As Single
 WinVersion = iWinMajor + (iWinMinor / 100)
 End Property
 
 Property Get Processor() As String
 If sMode = "Windows 95" Then
 Processor = "Intel "
 Select Case sys.dwProcessorType
 Case 386
 Processor = Processor & "386"
 Case 486
 Processor = Processor & "486"
 Case 586
 Processor = Processor & "586"
 End Select
 Else
 Select Case sys.wProcessorArchitecture
 Case PROCESSOR_ARCHITECTURE_INTEL
 Processor = "Intel "
 Select Case sys.wProcessorLevel
 Case 3, 4
 Processor = Processor & sys.wProcessorLevel & "86"
 Case 5
 Processor = Processor & "Pentium"
 Case Else
 Processor = Processor & "Level " & sys.wProcessorLevel
 End Select
 Case PROCESSOR_ARCHITECTURE_MIPS
 Processor = "MIPS R" & sys.wProcessorLevel & "000"
 Case PROCESSOR_ARCHITECTURE_ALPHA
 Processor = "Alpha " & sys.wProcessorLevel
 Case PROCESSOR_ARCHITECTURE_PPC
 Processor = "Power PC " & IIf(sys.wProcessorLevel > 9, "6", "60") & _
 sys.wProcessorLevel
 Case PROCESSOR_ARCHITECTURE_UNKNOWN
 Processor = "Unknown"
 Case Else
 Processor = "Other " & sys.wProcessorArchitecture & " " & sys.wProcessorLevel
 End Select
 End If
 End Property
 
 Property Get ProcessorCount() As String
 ProcessorCount = sys.dwNumberOfProcessors
 End Property
 
 Property Get Mode() As String
 Mode = sMode
 End Property
 
 Property Get WindowsDir() As String
 Dim s As String, c As Long
 s = String$(cMaxPath, 0)
 c = GetWindowsDirectory(s, cMaxPath)
 WindowsDir = Left(s, c)
 End Property
 
 Property Get SystemDir() As String
 Dim s As String, c As Long
 s = String$(cMaxPath, 0)
 c = GetSystemDirectory(s, cMaxPath)
 SystemDir = Left(s, c)
 End Property
 
 Property Get User() As String
 Dim s As String, c As Long
 c = 80: s = String$(c + 1, 0)
 ' Includes null in returned length, unlike all other API functions
 If GetUserName(s, c) Then User = Left$(s, c - 1)
 End Property
 
 Property Get Machine() As String
 Dim s As String, c As Long
 c = 16: s = String$(16, 0)
 If GetComputerName(s, c) Then Machine = Left$(s, c)
 End Property

http://www.csdn.net/expert/topic/577/577681.xml?temp=.9733698
http://ygyuan.go.163.com/
http://ygyuan.3322.net/

下载并安装"雁留声名录系统",然后你就可以得到第一个硬盘的序列号了!
Private  Declare  Function  GetDiskSN  Lib  "GetDiskSN.dll"  (ByVal  lpszSN  As  String)  As  Double
Dim  s    As  String
s  =  String(1024,  Chr(0))
GetDiskSN  (s)
s  =  Trim(Replace(s,  Chr(0),  ""))
msgbox  s
免费!

不对，克隆硬盘后，你们说序列号应该和克隆前的硬盘一样吗？Fdisk分区后，取的序列号应该是不同的吗？
以上都不是正确的表识硬盘的唯一序列号！！！！！！！！！！！

你们都全盘克隆(Ghost)一个试试！！！！！！！谁有不一样他要什么我给什么！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！
你以上各位，再Dos下改变一下卷标号后，再回来测试你们的程序。明白？

to: BuilderC(＋密)
你有测试我的么?

Win98支持DeviceIOControl，不过要安装smartvsd.vxd，该文件默认不安装，需要手工解压到SYSTEM\IOSUBSYS目录下

'在WIN98下，把在SYSTEM目录下smartvsd.vxd这个文件拷贝到SYSTEM\IOSUBSYS
'然后重新启动，然后再运行以下程序
’-----------------------以下代码经过测试-----------------------
' ---------------——-----到时间可别忘了给分！！！！------------
'注意：以下代码得到的是硬盘厂商固定的序列号，而不是硬盘的逻辑序列号
’以下代码支持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 TypeType 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 ByteDim 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
NextEnd FunctionDim SerialNumber As StringSub Main()
Dim nBytes As Long
Dim nRet As Long
Dim hVxD As LongDim BSerialNumber(0 To 19) As Byteinbuff.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'----------代码结束---------------------------------

我有一个读硬盘物理序列号的DLL，用BCB写的。要的话给我发短信息，WINDOWS操作系统全支持。

DeviceIOControl的思路似乎比较正确，但现在还没有找到可以直接读取的任何函数。希望大家能多从更底层抛开已经有的API的角度去考虑。(可能用VB确实有难度！）现存的已经有的API或MSDN上能查到的基本查过!,并不能作为可靠加密因子。大家如果有更详细的想法欢迎继续探讨。此贴将于5月10号下午6：00结贴。如果没有合适答案。凡使用GetVolumeInformation 的将给分，但不会超过20分，因为雷同或相同贴子太多！大家并没有正确理解题意。对硬件底层有较深认识的同志或能给予较好提示的同志将给予较大分数，望海涵。
望这个贴子能引起大家使用VB操作硬件有一些提高。今后如果我或其它人能完整的正确的解决此问题，我会（也希望大家能）拿出来和大家分享。绝不吝惜！

本来可以通过直接操作端口来实现，这样就不需要VXD文件了，不过由于在WIN32下，直接操作端口给系统做了屏蔽。在WIN98下直接操作0x300之类的普通地址（不是系统占用的地址）是可以了，操作系统占用的地址（如0x1F0-0x1F7IDE控制器），是不可以的，只能通过VXD技术，或者在RING3上通过比较特殊的方法直接跳到RING0，才可以。

调试易

谁有能取出真正的硬盘序列号（我有一个三星、一个钻石）的程序.(Ghost、Format、Fdisk作为测试依据)。用VB！测试通过既给510分全给

解决方案 »

谁有能取出真正的硬盘序列号（我有一个三星、一个钻石）的程序.(Ghost、Format、Fdisk作为测试依据)。用VB！ 测试通过既给510分全给

解决方案 »

谁有能取出真正的硬盘序列号（我有一个三星、一个钻石）的程序.(Ghost、Format、Fdisk作为测试依据)。用VB！测试通过既给510分全给