怎样才能获得硬盘的序列号？ 有用来加密的源码最好

Question

怎样才能获得硬盘的序列号？ 有用来加密的源码最好

Answer 1

转摘
《提取使用者机器的硬盘序列号》　　新建一模块文件，并将如下声明的语句和常量添加到module1.bas模块中：　　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　　global getval as long　　编程时需注意的是要将声明语句写在同一行中。
　　窗体设置
　　在form1上添加2个文本框，name属性分别设置为text1、text2；再添加1个按钮，name属性设置为command1。
　　添加代码
　　将如下程序代码添加到form1的form1_load事件中：　　private sub form_load()　　dim tempstr1 as string * 256　　dim tempstr2 as string * 256　　dim templon1 as long　　dim templon2 as long　　………　　‘读取是否注册的信息，如何控制这里不再说明　　………　　call getvolumeinformation("c:\", tempstr1, 256, getval, templon1, templon2, 　　tempstr2, 256)　　text1.text = getval ‘提取本机c盘的序列号至文本框一　　end sub　　将如下程序代码添加到command1的command1_click事件中：　　private sub command1_click()　　if text2 〈〉 cstr(getval) then 　　msgbox "注册码不正确，请认真检查输入是否正确。"　　else　　msgbox "你已经成功注册，请重新启动本软件。"　　………　　（将正确注册的信息写入，使软件功能以后不受限制。具体方法依个人爱好进行设置。）　　………　　end if　　end sub

Answer 2

'模块：
Option Explicit
    DefLng A-Z    Const FILE_CASE_PRESERVED_NAMES = &H2
    Const FILE_CASE_SENSITIVE_SEARCH = &H1
    Const FILE_UNICODE_ON_DISK = &H4
    Const FILE_PERSISTENT_ACLS = &H8
    Const FILE_VOLUME_IS_COMPRESSED = &H8000
    
    Const FS_CASE_IS_PRESERVED = FILE_CASE_PRESERVED_NAMES
    Const FS_CASE_SENSITIVE = FILE_CASE_SENSITIVE_SEARCH
    Const FS_UNICODE_STORED_ON_DISK = FILE_UNICODE_ON_DISK
    Const FS_PERSISTENT_ACLS = FILE_PERSISTENT_ACLS
    Const FS_VOL_IS_COMPRESSED = FILE_VOLUME_IS_COMPRESSED    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
     
    Dim lRet As Long
    Dim sVolName As String
    Dim lVolSN As Long
    Dim lMaxCompLen As Long
    Dim lVolFlags As Long
    Dim sVolFileSys As String
    Const iBufLen = 255Private Const MAX_FILENAME_LEN = 256
'定义用以判断驱动的类型函数
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long'定义用以判断驱动的类型
Private Const DRIVE_REMOVEBLE = 2  '软盘/可移动驱动器
Private Const DRIVE_FIXED = 3      '本地硬盘
Private Const DRIVE_REMOTE = 4     '远程驱动器
Private Const DRIVE_CDROM = 5      '光驱驱动器
Private Const DRIVE_RAMDISK = 6    'RAM驱动器Public Function DriveSerial(ByVal sDrv As String) As Long
 Dim RetVal As Long
 Dim str As String * MAX_FILENAME_LEN
 Dim str2 As String * MAX_FILENAME_LEN
 Dim a As Long
 Dim b As Long
 GetVolumeInformation sDrv & ":\", str, MAX_FILENAME_LEN, RetVal, _
 a, b, str2, MAX_FILENAME_LEN
 DriveSerial = RetVal
End Function
'判断驱动器的类型
Public Function DriveType(ByVal Tdrv As String) As String
   Dim Temp As Long
       Temp = GetDriveType(Tdrv & ":\")
   Select Case Temp
          Case DRIVE_CDROM
            DriveType = "光驱"
          Case DRIVE_FIXED
            DriveType = "硬盘"
          Case DRIVE_RAMDISK
            DriveType = "RAM"
          Case DRIVE_REMOTE
            DriveType = "远程"
          Case DRIVE_REMOVEBLE
            DriveType = "软盘"
          Case Else
            DriveType = "不存在"
   End Select
End Function'窗体：
'一个ComboBox 控件，name属性：Combo1
'一个TextBox 控件，name属性：Text1
'一个CommandButton 控件，name属性：Command1Private Sub Command1_Click()
  If Combo1.ListIndex = -1 Then Exit Sub ' 当没有选择时退出本函数
  aa = Combo1.List(Combo1.ListIndex)
  '为当前选择的驱动器生成序列码
  Text1.Text = DriveSerial(Left(aa, 1))
End SubPrivate Sub Form_Load()
  Dim Dn As Integer
  Dn = 65                 'chr(65)="A"
  For Dn = 65 To 90       '限于驱动器名为A-Z
  If DriveType(Chr(Dn)) <> "不存在" Then _
  Combo1.AddItem (Chr(Dn) & ": (" & DriveType(Chr(Dn)) & ")")
  '查找存在的驱动器并加入列表框中
  Next
End SubPrivate Sub Com_Exit_Click()
  Unload Me
End Sub
'以上代码直接粘贴到指定位置，F5，OK!
'序列码为format后的序列码
'本人也是拿来原作经修改而成，附原作者资料：
'邓刚毅([email protected]/[email protected])
'笔名：Tony(PcG4工作室)
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^