ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 43963|回复: 141

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

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2008-9-3 10:40 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:保护和加密编程

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

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

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

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

DAmtVwwJ.rar

15.19 KB, 下载次数: 1376

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

点评

知识树内容索引:虽然不赞成,实用意义也不大,但可以看看  发表于 2013-9-28 20:17

TA的精华主题

TA的得分主题

发表于 2008-9-3 11:52 | 显示全部楼层
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

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-3 20:49 | 显示全部楼层

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


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

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

谢谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-3 21:33 | 显示全部楼层

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

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

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

TA的精华主题

TA的得分主题

发表于 2008-9-4 13:34 | 显示全部楼层

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, 下载次数: 1310)

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-4 20:26 | 显示全部楼层

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

 

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-4 20:32 | 显示全部楼层

[求助]自杀代码

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

 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, 下载次数: 420)

TA的精华主题

TA的得分主题

发表于 2008-9-5 09:42 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-5 14:10 | 显示全部楼层

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-5 22:11 | 显示全部楼层

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

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-12-16 09:46 , Processed in 0.421485 second(s), 19 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表