[分享]用U盘做加密狗,加密Excel文件(108楼有新代码!)

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-6 18:39 编辑 ]

joen168

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

df888888

好厉害啊，

yecdx

这个创意很好，学习了

mytoday2004

如题
那么如果不启用宏是不是就没有作用了没有保护作用

yj304

学习学习!

xinanzhineng

我看看,能不能用!

maillgh

这个想法不错，但如果U盘出了问题，那就会有一些麻烦了

xing979020

用U盘做加密狗，今晚洗澡的时候就有了这个想法，却不知道大家都已经知道怎么写代码了。
学习了。正好用上。

xing979020

我写了大量的LIST程序及VB小程序。这下可用上了。