[求助]自杀的代码(已解决)

luanyu6688

我做一工作薄,只想在一台电脑上使用,如果复制到另一台电脑上,提示使用2个月,2个月后自动启动自杀程序.

请大虾帮我写一下代码,谢谢

在2楼和31楼有两种方式的代码,我上传一个例子和一个提取硬盘号的例了,非常感谢gvntw和figfig两位

ggFNdz2y.rar (32.45 KB, 下载次数: 13318)

2008-9-11 21:57 上传

点击文件名下载附件
[求助]自杀的代码(已解决)

[此贴子已经被作者于2008-9-11 22:01:06编辑过]

gvntw

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 = 要使用的电脑磁盘序列号 Then Exit Sub
   
    Dim FirstDate, de, days
    FirstDate = Date
    de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值
    If de = "" Then   '如果取不到值
        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表
        Else
        days = Date - CDate(de)  '计算文件使用的天数
        If days > 60 Then    '如果文件使用超过60天
            ThisWorkbook.ChangeFileAccess xlReadOnly  '改为只读属性
            Kill ThisWorkbook.FullName  '自杀
            ThisWorkbook.Close False  '关闭不保存
        End If
    End If
End Sub

luanyu6688

 de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值
    If de = "" Then   '如果取不到值
        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表

请问:vntw 上述代码中日期是否需要手工录入吗,

是否能加入在不等于原电脑的硬盘序列号时每次打开提醒还有多少天使用期

谢谢

luanyu6688

现在我说一下我的整体思路:

我做一工作薄,只想在一台电脑上使用,每次打开工作薄时都要检测硬盘号是否与代码中硬盘号是否一致,如果不一致或复制到另一台电脑上,提示使用2个月,2个月后自动启动自杀程序,不过在这2个月中每次工作薄时都提示还有多少天的使用期.

请大虾帮我一下,上传一附件,谢谢

gvntw

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 = 要使用的电脑磁盘序列号 Then Exit Sub 
    
    Dim FirstDate, de, days
    FirstDate = Date
    de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值
    If de = "" Then   '如果取不到值
        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表
        MsgBox "本文件可使用60天，今天是第1次使用", , "提示"
    Else
        days = Date - CDate(de)  '计算文件使用的天数
        If days > 60 Then    '如果文件使用超过60天
            MsgBox "已超过使用期限，本文件将自杀", , "警告"
            ThisWorkbook.ChangeFileAccess xlReadOnly  '改为只读属性
            Kill ThisWorkbook.FullName  '自杀
            ThisWorkbook.Close False  '关闭不保存
        End If
        MsgBox "本文件已使用" & days & "天，还有" & 60 - days & "天可使用", , "提示"
    End If
End Sub

Tu1bBJtc.rar (7.25 KB, 下载次数: 9276)

2008-9-4 13:34 上传

点击文件名下载附件
[求助]自杀的代码

luanyu6688

非常感谢楼上,但我提取的是物理硬盘序号,我改后不能用,我怎么改才能用

 

luanyu6688

  我上传一个显示的图片，请大虾帮我看一下

 s = d.serialnumber    '磁盘序列号
    If s = 4LS4GLHB Then Exit Sub '要使用的电脑磁盘序列号
   
    Dim FirstDate, de, days
    FirstDate = Date
    de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值 z0Ps6Re6.rar (6.87 KB, 下载次数: 453)

2008-9-4 20:30 上传

点击文件名下载附件
[求助]自杀的代码

gvntw

If s = "4LS4GLHB" Then Exit Sub

luanyu6688

不是不行呀,还是提示还有多少天可以使用,我想如果改后不再提示,可永远使用

luanyu6688

请gvntw帮我一下,我的意思是说如果代码中硬盘序列号与实际一致时就不显示还有多少天可以使用,可以永远使用,代码中硬盘序列号与实际不一致时就提示还有多少天可以使用,如果改与实际一致后不再提示,可永远使用............谢谢