ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 65405|回复: 145

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

  [复制链接]

TA的精华主题

TA的得分主题

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

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

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

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

ggFNdz2y.rar (32.45 KB, 下载次数: 13313)
[此贴子已经被作者于2008-9-11 22:01:06编辑过]

DAmtVwwJ.rar

15.19 KB, 下载次数: 9214

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

点评

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

TA的精华主题

TA的得分主题

发表于 2008-9-3 11:52 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
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 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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


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

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

谢谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-3 21:33 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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

我做一工作薄,只想在一台电脑上使用,每次打开工作薄时都要检测硬盘号是否与代码中硬盘号是否一致,如果不一致或复制到另一台电脑上,提示使用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, 下载次数: 9271)


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-4 20:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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

 

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


TA的精华主题

TA的得分主题

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

TA的精华主题

TA的得分主题

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-9-5 22:11 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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

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

本版积分规则

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

GMT+8, 2024-3-29 15:08 , Processed in 0.052604 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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