限制Excel只能在本机运行,拷贝到其它机器运行时进行限制

gzgis

我的要求是：加载以下代码的Excel文档，如果在本机上运行，则无时间限制，也不要弹出提示还能运行多少天；只有将本Excel文档复制到其它机器运行时，文档将运行3天后将自动停止工作，请问代码将如何修改。

原代码如下：
Sub Auto_Open()
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(ThisWorkbook.Path)))
    s = d.serialnumber    '磁盘序列号
    If s = VFJ161R71TY6XK Then Exit Sub '要使用的电脑磁盘序列号
   
    Dim FirstDate, de, days
    FirstDate = Date
    de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值
    If de = "" Then   '如果取不到值
        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表
        MsgBox "本文件可使用3天，今天是第1次使用", , "提示"
    Else
        days = Date - CDate(de)  '计算文件使用的天数
        If days > 3 Then    '如果文件使用超过3天
            MsgBox "已超过使用期限，本文件将自杀", , "警告"
            ThisWorkbook.ChangeFileAccess xlReadOnly  '改为只读属性
            Kill ThisWorkbook.FullName  '自杀
            ThisWorkbook.Close False  '关闭不保存
        End If
        MsgBox "本文件已使用" & days & "天，还有" & 3 - days & "天可使用", , "提示"
    End If
End Sub

[ 本帖最后由 gzgis 于 2009-11-11 09:10 编辑 ]

fsyyyy

if 序列号正确 then

****你的代码

else

****你的代码

endif

leonsky

这个要求还。。真奇怪。

★书童

如何获得磁盘id

[此贴子已经被作者于2008-9-22 0:02:28编辑过]

gzgis

获取硬盘的序列号: bXXMF3uf.rar (18.51 KB, 下载次数: 1107)

2008-9-22 08:51 上传

点击文件名下载附件
限制Excel只能在本机运行,拷贝到其它机器运行时进行限制

yfxpzq

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

这些是什么意思？盼解

gzgis

本程序的意思是，禁止别人拷贝，望高人帮忙改改。

gzgis

盼望高人指点!

zuo8250

这是获得硬盘的序列号的代码

wolf412

学习了，很强大