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

gljzyp

QUOTE:

以下是引用lhm667788在2008-9-7 12:59:00的发言：

gvntw版主说的极对，下面是按gvntw版主提供的代码整理的，已测试通过。即人性化，又很和谐！

不过由于限制了U盘的类型（d.Drivetype=1），只能用U盘。

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

此段代码在我的2003(XP系统)没有通过,插与不插U盘,点''是"没有反映,''否"也没有退出

wenwen000424

谢谢,很有实用性.

lhm667788

QUOTE:

以下是引用gljzyp在2008-9-7 13:44:00的发言：

此段代码在我的2003(XP系统)没有通过,插与不插U盘,点''是"没有反映,''否"也没有退出

 把下面的65改为66试试看

Set d = fs.GetDrive(Chr(66 + DrivesCount))

gljzyp

QUOTE:

以下是引用lhm667788在2008-9-7 14:18:00的发言：

 把下面的65改为66试试看

Set d = fs.GetDrive(Chr(66 + DrivesCount))

没有改变!点"否"没有退出系统反而进去了

[此贴子已经被作者于2008-9-7 14:32:55编辑过]

lhm667788

QUOTE:

以下是引用gljzyp在2008-9-7 14:29:00的发言：

没有改变!点"否"没有退出系统反而进去了

你到31楼重新下载

gljzyp

31楼解决了"否"退出了系统,"是"还是没有反映进不了系统(我的U盘:L)

kxpc

QUOTE:

以下是引用gljzyp在2008-9-7 15:23:00的发言：
31楼解决了"否"退出了系统,"是"还是没有反映进不了系统(我的U盘:L)

  这就对了，选“是”进入了系统，这是因为程序中退出系统的代码用注释 “ '  " 符标上了，不然的话，因为还没改成你的U盘的序列号，你是无法进去的。

让你进去，是让你修改U盘序列号，及去掉注释符。

gljzyp

QUOTE:

以下是引用kxpc在2008-9-7 15:30:00的发言：

  这就对了，选“是”进入了系统，这是因为程序中退出系统的代码用注释 “ '  " 符标上了，不然的话，因为还没改成你的U盘的序列号，你是无法进去的。

让你进去，是让你修改U盘序列号，及去掉注释符。

U盘序列号是修改过了,,注释符也是去掉的,问题是:点"是"没有反映,点"否"有效

kxpc

QUOTE:

以下是引用gvntw在2008-9-6 14:59:00的发言：

请试试：

Sub dd()
1:
Set fs = CreateObject("Scripting.FileSystemObject")
DrivesCount = fs.drives.Count
Set d = fs.GetDrive(Chr(65 + DrivesCount))   ' 因为没有B盘，所以用65+
dt = d.DriveType
If dt > 1 Then
    MsgBox "没有U盘，请插入U盘再试"
    GoTo 1
End If
s = d.SerialNumber  'U盘SerialNumber
If s=…… Then……
End Sub

Set d = fs.GetDrive(Chr(65 + DrivesCount))   ' 因为没有B盘，所以用65+

我办公室的台式机有软驱A：没软驱B:，加55可以，在我的笔记本电脑上要加66才行。

31楼的代码对判断U盘还需要改进。遇到解决不了的问题只有请gvntw版主解决了，需要说明的是，利用U盘做密钥盘的想法是源于gvntw版主在自杀文件（http://club.excelhome.net/viewthread.php?tid=350992&px=0）中的代码，谢谢gvntw版主。

能否做成轻松制作密钥盘的程序，点一下按钮，U盘序列号和程序一起就写入到被加密的Excel文件。一键搞定！ 期待中！

7楼和14楼应该是没有问题的。

[此贴子已经被作者于2008-9-7 16:58:29编辑过]

dqf10000

是否可以进一步人性化，加上对多个U盘添加和管理的自动程序。