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

figfig

QUOTE:

以下是引用cmcc1861在2008-9-11 16:10:00的发言：

对啊。我的也是有提示。修改成了自己电脑的序列号。还是有时间提示。

If s = "000000" Then Exit Sub '要使用的电脑磁盘序列号

还会有那个提示框的，不会EXIT啊？

why？

Sub auto_open()

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

    If s = "要使用的电脑磁盘序列号" Then  '要使用的电脑磁盘序列号,注意加引号
    MsgBox "序列号正确!"
    Exit Sub
    End If
     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

富戈

QUOTE:

以下是引用figfig在2008-9-11 17:01:00的发言：

Sub auto_open()

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

    If s = "要使用的电脑磁盘序列号" Then  '要使用的电脑磁盘序列号,注意加引号
    MsgBox "序列号正确!"
    Exit Sub
    End If
     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

我的天啊，figfig 你就用几行代码就把硬盘的物理系列号查出来，特佩服。红色代码就是查找硬盘的物理系列号。

figfig

QUOTE:

以下是引用富戈在2008-9-11 17:51:00的发言：

我的天啊，figfig 你就用几行代码就把硬盘的物理系列号查出来，特佩服。红色代码就是查找硬盘的物理系列号。

谢谢鼓励.再把红色的代码精简成了一行,呵呵

s = Trim(GetObject("winmgmts:").InstancesOf("Win32_PhysicalMedia")("Win32_PhysicalMedia.Tag=""\\\\.\\PHYSICALDRIVE0""").serialnumber)

[此贴子已经被作者于2008-9-11 18:10:30编辑过]

zjdh

25楼的代码与楼上的代码获得的物理系列号不一样,不知何故?

ni57

在哪里看得到序列号呢？

jpowe

QUOTE:

以下是引用figfig在2008-9-11 18:07:00的发言：

谢谢鼓励.再把红色的代码精简成了一行,呵呵

s = Trim(GetObject("winmgmts:").InstancesOf("Win32_PhysicalMedia")("Win32_PhysicalMedia.Tag=""\\\\.\\PHYSICALDRIVE0""").serialnumber)

这个论坛的人高不可测.厉害.

弱弱的问一句:如果使用的电脑是双硬盘的话,如何取值?

jpowe

QUOTE:

以下是引用ni57在2008-9-12 0:27:00的发言：
在哪里看得到序列号呢？

把此贴从头到尾看一遍，就知道了

figfig

QUOTE:

以下是引用jpowe在2008-9-12 0:40:00的发言：

这个论坛的人高不可测.厉害.

弱弱的问一句:如果使用的电脑是双硬盘的话,如何取值?

s = Trim(GetObject("winmgmts:").InstancesOf("Win32_PhysicalMedia")("Win32_PhysicalMedia.Tag=""\\\\.\\PHYSICALDRIVE1""").serialnumber)

把0改成1,就是第2个硬盘,改2就是第3个硬盘

ni57

QUOTE:

以下是引用jpowe在2008-9-12 0:44:00的发言：

把此贴从头到尾看一遍，就知道了

谢谢jpowe兄，我再看，因为vba方面的知识太缺乏了，其实我学习此贴和关于利用U盘做密钥盘，加密Excel文件那个贴子，已经有1天时间了，看了不下20遍，感觉还是蒙蒙的。看来要准备下载打印，深入猜想了。

[此贴子已经被作者于2008-9-12 3:27:21编辑过]

逗人

QUOTE:

以下是引用figfig在2008-9-11 17:01:00的发言：

Sub auto_open()

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

    If s = "要使用的电脑磁盘序列号" Then  '要使用的电脑磁盘序列号,注意加引号
    MsgBox "序列号正确!"
    Exit Sub
    End If
     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

一台笔记本电脑调试成功，另一台电脑运行时出现“运行时错误'-2147217406（80041002）’：找不到

调试出现s = Trim(WMI.InstancesOf(strCls)(strKey).serialnumber)

这是怎么回事如何解决？