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

lhm667788

QUOTE:

以下是引用Zamyi在2008-9-18 17:11:00的发言：

下面是获取U盘物理序列号的代码（加密狗也行）：

Public Sub QW()
  Dim objWMIService As Object
  Dim colItems As Object
  Dim objitem As Object
  Dim a, b, c, d, e, U_Dist
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
  For Each objitem In colItems
    a = objitem.DeviceID
    If a Like "*VID*" Then
      b = Split(a, "\")
      c = Split(b(UBound(b) - 1), "&")
      d = Split(c(UBound(c) - 1), "_")
      e = Split(c(UBound(c)), "_")
     'ÒÔÉÏ»ñÈ¡³öÏà¹Ø²ÎÊý
      U_Dist = d(UBound(d)) + e(UBound(e)) + b(UBound(b))
      [A1] = U_Dist
    End If
    Next
End Sub

   真是好东西啊！楼上的辛苦了，谢谢！

kxpc

QUOTE:

以下是引用Zamyi在2008-9-18 17:11:00的发言：

下面是获取U盘物理序列号的代码（加密狗也行）：

Public Sub QW()
  Dim objWMIService As Object
  Dim colItems As Object
  Dim objitem As Object
  Dim a, b, c, d, e, U_Dist
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
  For Each objitem In colItems
    a = objitem.DeviceID
    If a Like "*VID*" Then
      b = Split(a, "\")
      c = Split(b(UBound(b) - 1), "&")
      d = Split(c(UBound(c) - 1), "_")
      e = Split(c(UBound(c)), "_")
     'ÒÔÉÏ»ñÈ¡³öÏà¹Ø²ÎÊý
      U_Dist = d(UBound(d)) + e(UBound(e)) + b(UBound(b))
      [A1] = U_Dist
    End If
    Next
End Sub

    哇噻！这也能弄出来！太感动了！

kxpc

QUOTE:

感谢Zamyi提供获取U盘物理序列号的方法！ 105楼有获取U盘物理序列号的方法

利用U盘作为密钥盘，用U盘的物理序列号作为

密钥，对Excel文件进行加密（已通过测试）。

Private Sub Workbook_Open()
  Dim objWMIService As Object
  Dim colItems As Object
  Dim objitem As Object
  Dim a, b, c, d, e, U_Dist
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
  For Each objitem In colItems
    a = objitem.DeviceID
    If a Like "*VID*" Then
      b = Split(a, "\")
      c = Split(b(UBound(b) - 1), "&")
      d = Split(c(UBound(c) - 1), "_")
      e = Split(c(UBound(c)), "_")
      U_Dist = d(UBound(d)) + e(UBound(e)) + b(UBound(b))
      If U_Dist = "1307016300000000000027" Then Exit Sub  'U盘物理序列号
    End If
  Next
  MsgBox "找不到正确U盘，系统将退出！"
  ThisWorkbook.Close False
End Sub

[此贴子已经被作者于2008-9-18 22:09:51编辑过]

gyzzf

太好了，用物理序列号密级大大增强了。不知“禁用宏”和安全性设置为“很高”的失密问题能否解决，期待中......

lyllc2002

如果禁用宏，文件照样打开，要做成禁用宏后文件不能打开才行。

最好能做成，当我打开文件，另存到指定U盘后，自动将U盘序列号加入到“

If U_Dist = "1307016300000000000027"

”中，那样就方便使用。为另存文件设置口令，只有口令正确，才可以另存。

[此贴子已经被作者于2008-9-19 14:39:17编辑过]

qsgpy

这样是不是整个电脑的excel表格都必须用U盘，能不能指定某一个表使用？

zjdh

说明你还没看懂

yjcel

找到了.谢谢

佳林

先下了，慢慢研究 ，谢谢，非常感谢

lhm667788

QUOTE:

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

如果禁用宏，文件照样打开，要做成禁用宏后文件不能打开才行。

最好能做成，当我打开文件，另存到指定U盘后，自动将U盘序列号加入到“

If U_Dist = "1307016300000000000027"

”中，那样就方便使用。为另存文件设置口令，只有口令正确，才可以另存。

关于禁用宏的问题,请参考BobPan的:

我说“启用宏”，就得启用宏，管你什么安全级

http://club.excelhome.net/viewthread.php?tid=283306&px=0