各位高手:
       我查一些资料说是可以读取硬盘的物理序列号,做了一个测试程序也可以了,但不是对所有的硬盘都有效,但我从网上下载的一个程序就可以,所以一直很郁闷,这中间还有什么特别的地方吗?请各位高手指点!
       另:CSDN如何上载我的测试程序呢?

解决方案 »

  1.   

    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 LongPrivate Sub Command1_Click()
      Dim mySerial As Long
      Dim mylong As Long
      mystr = String$(255, Chr$(0))
      mytype = String$(255, Chr$(0))
      If Right(Text1.Text, 1) <> "\" Then Text1.Text = Text1.Text & "\"
      sRoot = Text1.Text                                   '设定盘名
      mylong = GetVolumeInformation(sRoot, mystr, Len(mystr), mySerial, 0, 0, mytype, Len(mytype))
      Text2.Text = mySerial                                'TEXT2 存放盘序列号
    End SubPrivate Sub Command3_Click()
      End
    End Sub
      

  2.   

    对WIN,要进入ring0级才能获得物理序列号,像楼上获得的好象是逻辑号
    对一般WINDOWS,要做个驱动才能获得。
      

  3.   

    直接从RING3获取硬盘序列号
    '****************************************************************
    '原作: 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
    '邮件:[email protected]
    '2003.01.23
    '*************************************************************************
    Option Explicit
    '以下这一行是必须的,困为要做结构复制。而结构中有数组。所以,没有它则会错位
    Option Base 0Private 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 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 Type
      

  4.   

    '/*+++
    '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 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 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 LongPrivate 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 & "邮件:[email protected]"
    StrMsg = StrMsg & vbCrLf & "2003.01.23"
    MsgBox StrMsg
    End SubSub 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 SubPrivate 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 IfDim 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
      

  5.   

    接上'Close handle before quit
    CloseHandle (h)
    CopyRightEnd FunctionPrivate Function hdidnt() As String
    Dim hd As String * 80
    Dim phdinfo As TIDSECTOR
    Dim s(40) As Byte
    Dim StrOut As Stringhdidnt = ""
    'We start in NT/Win2000For j = 0 To 3  '这里取四个硬盘的信息,因为正常PC不超过四个硬盘
         hd = "\\.\PhysicalDrive" & CStr(j)
         hdidnt = hdidnt & vbCrLf & 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)
         Else
                'If IDE identify command not supported, fails
                If (vers.fCapabilities And 1) <> 1 Then
                      hdidnt = "Error: IDE identify command not supported."
                      CloseHandle (h)
                      Exit Function
                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.
                    hdidnt = hdidnt & vbCrLf & "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
                      
                      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
                           hdidnt = hdidnt & vbCrLf & "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
                         
                         StrOut = ByteArrToString(s, 40)
                         
                         hdidnt = hdidnt & vbCrLf & "Module Number:" & StrOut
                         CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
                         s(8) = 0
                         ChangeByteOrder s, 8
                         
                         StrOut = ByteArrToString(s, 8)
                         
                         hdidnt = hdidnt & vbCrLf & "Firmware rev:" & StrOut
                         CopyMemory s(0), phdinfo.sSerialNumber(0), 20
                         s(20) = 0
                         ChangeByteOrder s, 20
                         
                         StrOut = ByteArrToString(s, 20)
                         
                         hdidnt = hdidnt & vbCrLf & "Serial Number:" & StrOut
                         
                         CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
                         s(5) = 0
                         Dim dblStrOut As Double
                         dblStrOut = ByteArrToLong(s)
                         
                         hdidnt = hdidnt & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
                         CloseHandle (h)
                      End If
                End If
           End If
    Next j
    CopyRightEnd FunctionSub Main()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
        MsgBox "Win32s is not supported by this programm."
        End
    Case VER_PLATFORM_WIN32_WINDOWS
        OutStr = hdid9x
        MsgBox OutStr
        End
    Case VER_PLATFORM_WIN32_NT
        OutStr = hdidnt
        MsgBox OutStr
        End
    End SelectEnd Sub
    Private 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 Function
    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 Function
      

  6.   

    首先谢谢 xiaoliou(笑看风云淡) ,您的热情帮助,但您所给出的是磁盘的逻辑序列号!
      

  7.   

    我也来关注,3661512(菜鸟一只) 兄的这个方法我用过,只能在2000下用,98下还是取不到,那个vxd文件我也拷到system\IOSUBSYS下了,还是不行,是不是哪个地方处理得不对?
      

  8.   

    在WIN98,WINDOWS ME中,S.M.A.R.T并不缺省安装.请将SMARTVSD.VXD拷贝到%SYSTEM%\IOSUBSYS目录下. 
    在WINDOWS2000下,由于非ADMINISTRATORS组的用户对硬盘连GENERIC_READ的权限也没有,所以请以ADMINISTRATOR登录后使用. 
    没有测试这些系统,有几个前提:
    系统确实不支持。
    硬盘不支持。
    还有就是上面的原因。