中国DOS联盟论坛

中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名:www.cn-dos.net  论坛域名:www.cn-dos.net/forum
DOS,代表着自由开放与发展,我们努力起来,学习FreeDOS和Linux的自由开放与GNU精神,共同创造和发展美好的自由与GNU GPL世界吧!

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
作者:
标题: [分享]VBS定时提醒器 上一主题 | 下一主题
newxso
初级用户

l i u s s


积分 73
发帖 101
注册 2008-9-17
来自 GZ
状态 离线
『楼 主』:  [分享]VBS定时提醒器

本定时提醒器虽然技术含量不高,但其中的一些技巧还是值得参照:

'Filename=TimeTip.vbs by newxso(liuss) (2009.12.11)
Set WshShell=WScript.CreateObject("WScript.Shell")
CopyMyToSystem '复制到系统目录并以隐秘方式启动运行(启用)
'CopyMyToStartup '复制到开始菜单中的启动目录(未启用)

'====================================================================
'                    配置信息获取和时间格式转换
'====================================================================
dim StopTime,LenTime,LenTimeHour,SleepTime,SpaceTime,SpaceTip
dim KillProTime,KillProName,TipHour,TipHalfHour
dim BootTimer,NowStart,LastStart,LastExit,LastExitTime

on error resume next '启动容错,避免读取不存在值时终止程序
TimeKey="HKEY_CURRENT_CONFIG\Software\TimeTip\"
ConfigTime=WshShell.RegRead(TimeKey&"ConfigTime"):a=split(ConfigTime,"\"):StopTime=a(0):LenTime=a(1):SleepTime=a(2):SpaceTime=a(3):SpaceTip=a(4):KillProTime=a(5):KillProName=a(6):TipHour=a(7):TipHalfHour=a(8):if TipHalfHour="" then SetTime
'获取本次开机日期和时间
BootTimer=Timer:NowStart=Now
'获取上次开机日期和时间
LastStart=WshShell.RegRead(TimeKey&"StartTime")
'获取上次关机日期和时间
LastExit=WshShell.RegRead(TimeKey&"ExitTime"):a=split(LastExit," "):LastExitTime=a(1)
'把时分秒格式转换为秒数方便运算
a=split(LenTime,":"):LenTimer=(a(0)*3600)+(a(1)*60)
a=split(SleepTime,":"):SleepTimer=(a(0)*3600)+(a(1)*60)
a=split(SpaceTime,":"):SpaceTimer=(a(0)*3600)+(a(1)*60)
a=split(SpaceTip,":"):SpaceTip=(a(0)*3600)+(a(1)*60):SpaceTipTime=SpaceTip
a=split(KillProTime,"-"):b=split(a(0),":"):c=split(a(1),":"):KillProTimeStart=(b(0)*3600)+(b(1)*60):KillProTimeEnd=(c(0)*3600)+(c(1)*60)
a=split(StopTime,"-"):b=split(a(0),":"):c=split(a(1),":"):StopTimeStart=(b(0)*3600)+(b(1)*60):StopTimeEnd=(c(0)*3600)+(c(1)*60)
on error goto 0 '关闭容错

'计算本次开机与上次关机时差(忽略5分钟内,适应注销/重启情况)
NowLast=DateDiff("s",LastExit,NowStart):if (NowLast>300 and NowLast<=SpaceTimer) then:txt="本程序检测到本次开机与上次关机的间隔不够,马上就会关机!":timeout=15:title="现在时间:"&time&"                 上次关机:"&LastExitTime:Tip:Off

'计算上次使用电脑的时间
if (LastExit<>"" and LastStart<>"") then m=DateDiff("s",LastStart,LastExit):n=m\3600:p=right("0"&(m Mod 3600)\60,2):q=right("0"&(m Mod 60),2):LastUsed=n&"小时"&p&"分"&q&"秒"

'计算关机时间
OffTimer=BootTimer+LenTimer:p=OffTimer\3600:if p>=24 then p=p-24 end if:q=right("0"&(OffTimer Mod 3600)\60,2):r=right("0"&(OffTimer Mod 60),2):OffTime=p&":"&q&":"&r:t=LenTimer:UseHour=t\3600:UseMinute=right("0"&(t Mod 3600)\60,2)
'若小于或等于5分钟间隔则使用上次关机时间
if NowLast<=300 then OffTime=WshShell.RegRead(TimeKey&"Off"):a=split(OffTime,":"):OffTimer=(a(0)*3600)+(a(1)*60)+a(2):t=OffTimer-BootTimer:UseHour=t\3600:UseMinute=right("0"&(t Mod 3600)\60,2)
'关机时间超过睡眠时间则以睡眠时间为准
if OffTimer>=SleepTimer then OffTime=SleepTime&":00":t=(SleepTimer-BootTimer):OffTimer=SleepTimer:UseHour=t\3600:UseMinute=right("0"&(t Mod 3600)\60,2)

'记录关机时间
if (NowLast-SpaceTimer)>0 or NowLast="" then WshShell.Regwrite(TimeKey&"Off"),OffTime

'记录本次启动日期和时间
WshShell.Regwrite(TimeKey&"StartTime"),NowStart

'====================================================================
'                              循 环
'====================================================================

While true
  '记录关机日期和时间
  WshShell.Regwrite(TimeKey&"ExitTime"),Now
  '检测限制开机时间
  if StopTime<>"" then if (Timer>=StopTimeStart and Timer<=StopTimeEnd) then txt="警告! "&b(0)&"点"&b(1)&"分~"&c(0)&"点"&c(1)&"分是限制开机的时段,稍后将自动关机!     ":timeout=15:title="现在时间: "&time:Tip:Off
  '检测睡眠时间
  if SleepTime<>"" then if (Timer-SleepTimer)>=0 then txt="警告! 睡眠时间已过,准备关机!     ":timeout=10:title="现在时间: "&time:Tip:Off
  '检测使用时间
  if (Timer-OffTimer)>=0 then txt="电脑的使用时间已到,稍后将自动关机!     ":timeout=20:title="警告!":Tip:Off
  '本程序刚启动的提示
  if (Timer-BootTimer)<1 then:if NowLast<=300 then:txt="请注意,由现在开始你还可以使用这台电脑"&UseHour&"小时"&UseMinute&"分!":timeout=15:title="现在时间:"&time&"           关机时间:"&OffTime:Tip:else:if m>0 then:txt="您好,本程序检测到上一次使用电脑的时间为: "&LastUsed:timeout=15:title="上次开机:"&LastStart&"   上次关机:"&LastExit:Tip:end if:txt="请注意,由现在开始你可以使用这台电脑"&UseHour&"小时"&UseMinute&"分!":timeout=15:title="现在时间:"&time&"           关机时间:"&OffTime:Tip:end if:end if
  '检测整点和半点
  if TipHour="y" then if (Minute(Now)=0 and Second(Now)=0) then txt="整点报时!":timeout=8:title="现在时间: "&time:Tip
if TipHalfHour="y" then if (Minute(Now)=30 and Second(Now)=0) then txt="半点报时!":timeout=5:title="现在时间: "&time:Tip
  '检测使用时间和余下时间(或余下5分钟)
  a=Timer-BootTimer:b=OffTimer-Timer:Wscript.Sleep 500:if (b<=300 and b>298) then:UseTimeTip:else:if a>=SpaceTip then UseTimeTip:SpaceTip=SpaceTip+SpaceTipTime
  '检测限制使用程序时间
  if KillProTime<>"" then if (Timer>=KillProTimeStart and Timer<=KillProTimeEnd) then KillPro
wend

'====================================================================
'                        函 数 (使用时间提示)
'====================================================================

Function UseTimeTip()
c=a\3600:d=right("0"&(a Mod 3600)\60,2)
f=b\3600:g=right("0"&(b Mod 3600)\60,2)
txt="你已经使用了"&c&"小时"&d&"分,还有"&f&"小时"&g&"分的使用时间!":timeout=15:title="现在时间:"&time&"           关机时间:"&OffTime:Tip
End Function

'====================================================================
'                        函 数 (自动启动配置)
'====================================================================

Function CopyMyToSystem() '隐秘启动运行设置程序(下次开机生效)
'获取启动文件夹路径
strFolder=WshShell.SpecialFolders("StartUp")
'删除在启动文件夹中启动本程序(以免出现重复启动本程序)
WshShell.Run "cmd.exe /c attrib -h -r -s """&strFolder&"\TimeTip.vbs""",0,true
WshShell.Run "cmd.exe /c del """&strFolder&"\TimeTip.vbs""",0,true
'自我复制到系统目录下
WshShell.Run "cmd.exe /c attrib -h -r -s %windir%\system32\.vbs",0,true
WshShell.Run "cmd.exe /c copy /y """&Wscript.ScriptFullName&""" %windir%\system32\.vbs",0,true
'修改进程wscript.exe名称为expl0rer.exe(其中0为数字零)与explorer.exe接近
WshShell.Run "cmd.exe /c copy /y %windir%\system32\WScript.exe %windir%\EXPL0RER.EXE",0,true
'隐藏相关文件
WshShell.Run "cmd.exe /c attrib +h +r +s %windir%\system32\.vbs",0,true
WshShell.Run "cmd.exe /c attrib +h +r +s %windir%\EXPL0RER.EXE",0,true
'借助explorer进程来启动本程序,以便隐藏本程序的启动
WshShell.Regwrite("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell"),"EXPLORER.EXE %windir%\EXPL0RER.EXE %windir%\system32\.vbs"
End Function

Function CopyMyToStartup() '复制到开始菜单的启动目录中(若不采用隐秘运行)
strFolder=WshShell.SpecialFolders("StartUp")
'自我复制到启动文件夹下
WshShell.Run "cmd.exe /c copy /y """&Wscript.ScriptFullName&""" """&strFolder&"\TimeTip.vbs""",0,true
'添加只读、系统属性
WshShell.Run "cmd.exe /c attrib +r +s """&strFolder&"\TimeTip.vbs""",0,true
'删除隐秘启动方式(以免出现重复启动本程序)
WshShell.Regwrite("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell"),"explorer.exe"
End Function

'====================================================================
'                        函 数 (使用时间配置)
'====================================================================

Function SetTime() '时间配置程序启动
SetStopTime:SetLenTime:SetSleepTime:SetSpaceTime:SetSpaceTip
SetKillProTime:SetTipHour:SetTipHalfHour
'把配置信息记录到注册表中
WshShell.Regwrite(TimeKey&"ConfigTime"),StopTime&"\"&LenTime&"\"&SleepTime&"\"&SpaceTime&"\"&SpaceTip&"\"&KillProTime&"\"&KillProName&"\"&TipHour&"\"&TipHalfHour
End Function

Function SetStopTime() '限制开机时段配置程序
StopTime=InputBox(vbCrLf&"请输入限制开机时段:"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"( 0:00-5:30 表示0点0分至5点30分)","定时提醒器","0:00-5:30")
if StopTime="x" then Uninstall
if StopTime<>"" then on error resume next:a=split(StopTime,"-"):b=split(a(0),":"):c=split(a(1),":"):if (b(0)="" or b(1)="" or b(0)>=24 or b(1)>=60 or c(0)="" or c(1)="" or c(0)>=24 or c(1)>=60) then ErrSet:SetStopTime
End Function

Function SetLenTime() '使用电脑时长配置程序
LenTime=InputBox(vbCrLf&"请输入允许使用电脑时间长度:"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"( 2:30 表示2小时30分)", "定时提醒器", "2:30")
if LenTime="x" then Uninstall
if LenTime="" then LenTime="24:00"
on error resume next:a=split(LenTime,":"):LenTimeHour=a(0)
if (a(0)="" or a(1)="" or a(0)<0 or a(0)>12 or a(1)<0 or a(1)>=60 or (a(0)=0 and a(1)=0)) then ErrSet:SetLenTime
End Function

Function SetSleepTime() '睡眠时间配置程序
SleepTime=InputBox(vbCrLf&"请输入睡眠关机的时间:"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"( 23:15 表示23点15分)", "定时提醒器", "23:15")
if SleepTime="x" then Uninstall
if SleepTime<>"" then on error resume next:a=split(SleepTime,":"):if (a(0)="" or a(1)="" or a(0)<0 or a(0)>=24 or a(1)<0 or a(1)>=60 or (a(0)=0 and a(1)=0)) then ErrSet:SetSleepTime
End Function

Function SetSpaceTime() '允许时差配置程序(受制于使用电脑时长中的小时长度)
SpaceTime=InputBox(vbCrLf&"请输入上次关机与本次开机允许间隔:"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"( 0:30 表示0小时30分,只能小于"&LenTimeHour&"小时)", "定时提醒器", "0:30")
if SpaceTime="x" then Uninstall
if SpaceTime="" then SpaceTime="0:00"
on error resume next:a=split(SpaceTime,":")
if (a(0)="" or a(1)="" or a(0)<0 or a(0)>=LenTimeHour or a(1)<0 or a(1)>=60 or (a(0)=0 and a(1)=0)) then ErrSet:SetSpaceTime
End Function

Function SetSpaceTip() '每次提醒间隔时间配置程序(受制于使用电脑时长中的小时长度)
SpaceTip=InputBox(vbCrLf&"请输入电脑使用时间每次提醒的间隔时间:"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"( 1:00 表示1小时0分,只能小于"&LenTimeHour&"小时)", "定时提醒器", "1:00")
if SpaceTip="x" then Uninstall
if SpaceTip="" then SpaceTip="24:00"
on error resume next:a=split(SpaceTip,":")
if (a(0)="" or a(1)="" or a(0)<0 or a(0)>=LenTimeHour or a(1)<0 or a(1)>=60 or (a(0)=0 and a(1)=0)) then ErrSet:SetSpaceTip
End Function

Function SetKillProTime() '限制程序在批定时间范围内运行配置程序(此项将增加系统资源占用率)
KillProTime=InputBox(vbCrLf&"请输入限制程序运行时段(不限制按""取消""):"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"( 9:15-10:05 表示9点15分至10点05分)","定时提醒器","9:15-10:05")
if KillProTime="x" then Uninstall
if KillProTime<>"" then   on error resume next:a=split(StopTime,"-"):b=split(a(0),":"):c=split(a(1),":"):if (b(0)="" or b(1)="" or b(0)>=24 or b(1)>=60 or c(0)="" or c(1)="" or c(0)>=24 or c(1)>=60) then ErrSet:SetKillProTime
if KillProTime<>"" then SetKillProName
End Function

Function SetKillProName()
KillProName=InputBox(vbCrLf&"请输入你要限制使用的程序名称:"&vbCrLf&vbCrLf&vbCrLf&vbCrLf&"(可输入多个,并用英文逗号分隔)", "定时提醒器", "jyclient.exe,cmd.exe,notepad.exe,calc.exe")
if KillProName="x" then Uninstall
if KillProName="" then KillProTime=""
End Function

Function SetTipHour()
intAnswer=Msgbox("(如果想减少对你的干扰,可以关闭整点报时)"&vbCrLf&vbCrLf&vbCrLf&"         你想开启整点报时吗?", vbYesNo, "提示")
if intAnswer=vbYes then:TipHour="y":else:TipHour="n"
End Function

Function SetTipHalfHour()
intAnswer=Msgbox("(为了减少对你的干扰,建议关闭半点报时)"&vbCrLf&vbCrLf&vbCrLf&"        你想开启半点报时吗?", vbYesNo, "提示")
if intAnswer=vbYes then:TipHalfHour="y":else:TipHalfHour="n"
End Function

Function ErrSet() '配置时间格式错误提示
WshShell.Popup "你设置的时间格式错误,请按提示重新设置!   ",5,"错误",VbCritical
End Function

Function Uninstall() '退出配置程序并卸载本程序
strFolder=WshShell.SpecialFolders("StartUp")
WshShell.Run "cmd.exe /c attrib -h -r -s """&strFolder&"\TimeTip.vbs""",0,true
WshShell.Run "cmd.exe /c attrib -h -r -s %windir%\system32\.vbs",0,true
WshShell.Run "cmd.exe /c attrib -h -r -s %windir%\EXPL0RER.EXE",0,true
WshShell.Run "cmd.exe /c del """&strFolder&"\TimeTip.vbs""",0,true
WshShell.Run "cmd.exe /c del %windir%\system32\.vbs",0,true
WshShell.Run "cmd.exe /c del %windir%\EXPL0RER.EXE",0,true
WshShell.Run "cmd.exe /c reg delete HKEY_CURRENT_CONFIG\Software\TimeTip /f",0,true
WshShell.Run "cmd.exe /c reg add ""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"" /f /v Shell /d explorer.exe",0,true
Wscript.Quit
End Function

'====================================================================
'                        函 数 (执行)
'====================================================================

Function Tip() '执行屏幕提示
WshShell.Popup txt,timeout,title,VbExclamation
End Function

Function KillPro() '限制指定程序运行(终止指定进程)
KillPros=Split(KillProName,",")
Set objWMIService=GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcesses=objWMIService.ExecQuery("SELECT * FROM Win32_Process")
For Each objProcess in colProcesses
   For Each name in KillPros
      If LCase(objProcess.Name)=LCase(name) Then objProcess.Terminate
   Next
Next
Set objWMIService=Nothing
Set colProcesses=Nothing
End Function

Function Off() '执行关机
Set colOperatingSystems=GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")
  For Each objOperatingSystem in colOperatingSystems
      ObjOperatingSystem.Win32Shutdown(1)
  Next
Wscript.Quit
End Function

说明:
在代码中多处使用把多行代码合拼成单行形式(在每行尾加英文冒号就可合拼多行),除了可简短脚本代码长度外,最重要的是,可以提高一点代码的执行速度。本程序的自动启动是借用 explorer.exe 进程来启动,所以在 msconfig 中没有看到本程序的启动项目,另外,还修改了进程名称 wscript.exe 为 expl0rer.exe (把字母o改成数字0),达到简单的隐秘启动效果。

(由于本程序会修改注册表中的启动项目,杀毒软件会出来抗议。并不是本程序有病毒。当然,自我复制隐秘自动启动等,是病毒惯用的。)

2009.12.11 更新说明:
1)把限制开机时段修改成精确到分钟(以前精确到小时)。
2)增加对注销或重启的判断(小于5分钟为准则),重启后继续上次未用完的时间。
3)添加在指定时段限制指定程序(进程)启动。
4)在执行配置程序时,点击“取消”则取消该项
5)执行配置过程输入 x 退出配置程序并卸载本程序。

2010.10.8 更新说明:
修改时间运算方式,方便跨日时间差的运算,例如你可以设置限制电脑开机及禁止某些程序启动的时段为:23:00:00 --- 6:30:00 ,其中后者相对于前者已经是第二天的晨时了。也修改了一些地方,如在设置过程中点击对话框的取消按扭,则自动卸载本程序,增加显示倒数关机。要使用新版本请下载附件。保留旧版本是方便大家研究。

[ Last edited by newxso on 2010-10-8 at 22:27 ]

   此帖被 +4 点积分     点击查看详情   
评分人:【 HAT 分数: +4  时间:2009-2-5 11:08


附件 1: 定时提醒器.rar (2010-10-8 22:27, 10.99 K,下载次数: 16)
2009-2-4 22:26
查看资料  发短消息 网志   编辑帖子  回复  引用回复
yishanju
银牌会员

[b]看你妹啊[/b]


积分 1488
发帖 1357
注册 2006-5-20
状态 离线
『第 2 楼』:  

我正学一下VBS呢,楼主有VBS方面的教程资料不,能给我共享一下吗
谢谢了




有问题请发论坛或者自行搜索,再短消息问我的统统是SB
2009-2-5 10:13
查看资料  发短消息 网志   编辑帖子  回复  引用回复
newxso
初级用户

l i u s s


积分 73
发帖 101
注册 2008-9-17
来自 GZ
状态 离线
『第 3 楼』:  

http://www.microsoft.com/china/t ... /qanda/default.mspx
http://www.microsoft.com/china/t ... olumns/default.mspx
http://www.microsoft.com/china/t ... center/default.mspx
http://doc.51windows.net/vbscript/
http://www.jb51.net/

还有很多(包括本论坛),可以自己在网上搜索一下。

[ Last edited by newxso on 2009-2-5 at 10:41 ]

2009-2-5 10:31
查看资料  发短消息 网志   编辑帖子  回复  引用回复
mgq
中级用户





积分 206
发帖 103
注册 2008-5-6
来自 广东 肇庆
状态 离线
『第 4 楼』:  

病毒,我被楼主害惨了.

2009-2-5 10:57
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
523066680
银牌会员

SuperCleaner


积分 2362
发帖 1133
注册 2008-2-2
状态 离线
『第 5 楼』:  

re 2楼

       我这儿收集了一些vbs资料

      http://www.ys168.com
       教程\Script 目录下

三楼贴的好东西,加分,感谢分享!(分不够了 待会儿加。)

[ Last edited by 523066680 on 2009-2-5 at 11:06 ]



综合型编程论坛

我的作品索引
  
2009-2-5 11:03
查看资料  发送邮件  访问主页  发短消息 网志  OICQ (523066680)  编辑帖子  回复  引用回复
HAT
版主





积分 9023
发帖 5017
注册 2007-5-31
状态 离线
『第 6 楼』:  Re 4楼

哪个是病毒?



2009-2-5 11:07
查看资料  发短消息 网志   编辑帖子  回复  引用回复
yishanju
银牌会员

[b]看你妹啊[/b]


积分 1488
发帖 1357
注册 2006-5-20
状态 离线
『第 7 楼』:  



  Quote:
Originally posted by 523066680 at 2009-2-5 11:03:
re 2楼

       我这儿收集了一些vbs资料

      http://www.ys168.com
       教程\Script 目录下

三楼贴的好东西,加分,感谢分享!(分不够了 待 ...

菜了吧,给我永硕首页我怎么找




有问题请发论坛或者自行搜索,再短消息问我的统统是SB
2009-2-5 13:04
查看资料  发短消息 网志   编辑帖子  回复  引用回复
mgq
中级用户





积分 206
发帖 103
注册 2008-5-6
来自 广东 肇庆
状态 离线
『第 8 楼』:  

sorry 楼主
是我没有看清你写的代码,误认为是病毒,sorry.

2009-2-7 10:48
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复

请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转: