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)
|
|