如何用硬盘的硬盘物理序列号（唯一）进行加密（还有一点疑问，谢谢ldy）

joen168

Private Sub Workbook_Open()
  On Error Resume Next
1:
  Set fs = CreateObject("Scripting.FileSystemObject")
  DrivesCount = fs.drives.Count
' Set d = fs.GetDrive(Chr(66 + DrivesCount))'U盘时用
  Set d = fs.GetDrive("D:")
  dt = d.drivetype
  sn = d.serialnumber
  If dt <> 2 Then
'    If dt <> 1 Then 'U盘时用
    msg = MsgBox("系统检测无密钥盘，单击是，插入密钥盘重试，单击否，退出程序", vbYesNo, "提示")
    If msg = vbYes Then
        GoTo 1
    Else
        ThisWorkbook.Close False
        Exit Sub
    End If
  Else
    If sn = 1955786478 Then    '密钥盘序列号
        Exit Sub
    Else
        MsgBox "找不到密钥盘，系统将退出。"
        ThisWorkbook.Close False
    End If
  End If
End Sub

用这个可以通过硬盘的分区或U盘来加密。那如果用硬盘的硬盘物理序列号（唯一）进行加密，请教应如何设置代码？

链接：获取硬盘物理系列号http://club.excelhome.net/viewth ... p;page=1#pid2875800

[ 本帖最后由 joen168 于 2009-6-16 17:12 编辑 ]

joen168

硬盘分区的序列号并不唯一。电脑与电脑之间的硬盘分区系列号经常是一样的。为防止一些局域网共享文件不想在不授权的电脑使用，希望能通过硬盘的物理系列号进行设置。

joen168

Sub auto_open()
Set WMI = GetObject("winmgmts:")
strCls = "Win32_PhysicalMedia"
strKey = strCls & ".Tag=""\\\\.\\PHYSICALDRIVE0" & """"
s = Trim(WMI.InstancesOf(strCls)(strKey).serialnumber)

    If s = "5PT16AHE" Then '要使用的电脑磁盘序列号,注意加引号
    Exit Sub
    Else
        MsgBox "非授权用户，系统将退出。"
        ThisWorkbook.Close False
    End If
End Sub

s = "5PT16AHE" 这是硬盘的物理序列号。请问工作簿为什么还是要退出呢？

joen168

硬盘型号 ST3160811AS
序列号 5PT16AHE
我用windows优化大师获取以上数据，套进上面的公式，为什么还是不行呢？文件还是要退出呢？

joen168

等待中。。。

joforn

呵呵，我猜主要是你的程序获取不到硬盘的序列号。

joen168

楼上是指3楼的程序代码有误吗？请问那该如何修改？谢谢！

弑君

虽然还不知道怎用，不过代码还是先收藏着。谢了。。。祝楼主的问题能早点解决。

joen168

问题是还没有解决啊

joen168

看来问题并不简单。