通过硬件编号实现文件加密:仅指定电脑可用!

Function 获取网卡信息() As StringOn Error Resume NextDim objWMIService As Object, colItems As Object, objItem As ObjectDim infoStr As String, i As Integer    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=True"): i = 1    For Each objItem In colItems        infoStr = infoStr & "网卡" & i & "名称：" & IIf(IsNull(objItem.Description), "未知", objItem.Description) & vbCrLf        infoStr = infoStr & "网卡" & i & "MAC地址：" & IIf(IsNull(objItem.MacAddress), "未知", objItem.MacAddress) & vbCrLf        infoStr = infoStr & "网卡" & i & "IP地址：" & IIf(IsNull(objItem.IPAddress), "未知", Join(objItem.IPAddress, ",")) & vbCrLf        i = i + 1    Next    Set objWMIService = Nothing: Set colItems = Nothing    获取网卡信息 = infoStrEnd Function

Function GetMac() As StringDim objItem As Object    On Error Resume Next    For Each objItem In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") _        .ExecQuery("SELECT MacAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=True")        GetMac = objItem.MacAddress        If Len(GetMac) > 0 Then Exit For    Next    Debug.Print GetMacEnd Function

Private Sub Workbook_Open()  If GetMac <> "94:C6:91:71:D9:BB" Then    MsgBox "对不起，文件不能在这台电脑中使用！", vbCritical, "提醒"    ThisWorkbook.Close False  End IfEnd Sub

Private Sub Workbook_Open()  If GetMac <> "94:C6:91:71:D9:BB" Then    MsgBox "对不起，文件不能在这台电脑中使用！", vbCritical, "提醒"    With ThisWorkbook      .Saved = True      .ChangeFileAccess xlReadOnly      Kill .fullName      .Close    End With  End IfEnd Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)Dim sht As Worksheet  ThisWorkbook.Sheets("提醒").Visible = xlSheetVisible  For Each sht In ThisWorkbook.Sheets    If sht.Name <> "提醒" Then sht.Visible = xlSheetVeryHidden  Next shtEnd Sub

Private Sub Workbook_Open()  If GetMac <> "94:C6:91:71:D9:BB" Then    MsgBox "对不起，文件不能在这台电脑中使用！", vbCritical, "提醒"    With ThisWorkbook      .Saved = True      .ChangeFileAccess xlReadOnly      Kill .fullName      .Close    End With  End If  Call showallshtEnd SubSub showallsht()Dim sht As Worksheet  For Each sht In ThisWorkbook.Sheets    sht.Visible = xlSheetVisible  Next sht  ThisWorkbook.Sheets("提醒").Visible = xlSheetVeryHiddenEnd Sub