长运行 VBScript 文件警报

Question

我正在尝试构建一个 VBScript 文件，以提醒我所在学校的老师（一旦他们登录）在需要进行注册时进行注册（在这种情况下，每节课开始 15 分钟） .

我正在尝试无限循环并检查时间然后提醒用户。但是，当运行时，仅当执行时间等于 9:00 或 10:00 等时才满足条件。我希望它在后台有效地运行，并且每当时间等于 9:00 或 10:00 等时发出警报

代码如下：

Do While True
    If Now() = #09:00# Or Now() >= #10:00# Or Now() >= #11:20# Or Now() >= #12:20# Or Now() >= #14:05# Then
        msg = Msgbox ("Have you done your register?",4+48+4096,"")
        If msg = 7 Then
            Msgbox "Please take it immediately.",48+4096,""
            Exit Do
        Else
            Exit Do
        End If
    End If
Loop

我尝试通过 FormatDateTime() 和 Do Until 循环获取不同的时间，结果相同。

显然，如果我要去掉 Exit Do 语句，它会在那一分钟内永远运行。我希望它每次只提醒一次。

请帮忙！

Answer 1

有效！

我设法更改了脚本，以便读取正确的时间并且脚本必须等待一分钟才能退出 msgbox 循环。然后在最后一次阅读时，它显示最后一条消息并结束循环，但是，它仍然会在后台运行直到该人注销（我认为这不会对资源造成压力）。

Do While True
    ctime = FormatDateTime(Now(), 4)
    If ctime = "09:00" Or ctime = "10:00" Or ctime = "11:20" Or ctime = "12:20" Then
        msg = Msgbox ("Have you done your register?",4+32+4096,"")
        If msg = 7 Then
            Msgbox "Please take it immediately.",48+4096,""
            WScript.CreateObject("WScript.Shell").Run(path)
            WScript.Sleep 60000
        Else
            WScript.Sleep 60000
        End If
    ElseIf ctime = "14:05" Then
        msg = Msgbox ("Have you done your register?",4+32+4096,"")
        If msg = 7 Then
            Msgbox "Please take it immediately.",48+4096,""
            WScript.CreateObject("WScript.Shell").Run(path)
            WScript.Quit
            Exit Do
        Else
            WScript.Quit
            Exit Do
        End If
    End If
Loop

Answer 2

你应该这样写:

Do While True
    ctime = FormatDateTime(Now(),4)
    If ctime = "09:00" Or ctime = "10:00" Or ctime = "11:20" Or ctime = "12:20" Then
        msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
        If msg = VbNo Then
            Msgbox "Please take it immediately.",48+4096,Now()
            WScript.Sleep 60000
        Else
            WScript.Sleep 60000
        End If
    ElseIf ctime = "14:05" Then
        msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
        If msg = VbNo Then
            Msgbox "Please take it immediately !",48+4096,Now()
            Exit Do
            WScript.Quit
        Else
            Exit Do
            WScript.Quit
        End If
    End If
Loop

我添加了一些有趣的东西，比如被网络警报吓到，喜欢就试试吧！

Option Explicit
If AppPrevInstance() Then 
    MsgBox "There is an existing proceeding !" & VbCrLF &_
    CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"    
    WScript.Quit   
Else 
    Dim ctime,msg,Time1,Time2,Time3,Time4,LastTime2GoAway,Alarm
    Time1 = "09:00" : Time2 = "10:00" : Time3 = "11:20" : Time4 = "12:20" : LastTime2GoAway = "14:05"
    Alarm = "http://soundbible.com/1080-Airhorn.html"
    Do While True
        ctime = FormatDateTime(Now(),4)
        If ctime = Time1 Or ctime = Time2 Or ctime = Time3 Or ctime = Time4 Then
            If CheckConnectionInternet() = True Then 
                Call Alert(Alarm)
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately.",48+4096,Now()
                    Call Pause(60)
                Else
                    Call Pause(60)
                End If
            Else    
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately.",48+4096,Now()
                    Call Pause(60)
                Else
                    Call Pause(60)
                End If
            End If
        ElseIf ctime = LastTime2GoAway Then
            If CheckConnectionInternet() = True Then 
                Call Alert(Alarm)
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately !",48+4096,Now()
                    Exit Do
                    WScript.Quit
                Else
                    Exit Do
                    WScript.Quit
                End If
            Else
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately !",48+4096,Now()
                    Exit Do
                    WScript.Quit
                Else
                    Exit Do
                    WScript.Quit
                End If
            End If
        End If
    Loop
End If
'**************************************************************************
Sub Alert(WebSite)
    Dim objExplorer
    Set objExplorer = CreateObject("InternetExplorer.Application")
    objExplorer.Navigate WebSite
    objExplorer.Visible = 0 'Invisible
    Do While (objExplorer.Busy)
        Wscript.Sleep 500
    Loop
    Wscript.Sleep 5000
    objExplorer.Quit
End Sub
'**************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function    
'**************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'**************************************************************************
Function CheckConnectionInternet()
    Dim strComputer,objPing,objStatus
        strComputer = "smtp.gmail.com"
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\").ExecQuery _
        ("select * from Win32_PingStatus where address = '" & strComputer & "'")
        For Each objStatus in objPing
            If objStatus.Statuscode = 0 Then
                CheckConnectionInternet = True
            Else
                CheckConnectionInternet = False
            End If
        Next
End Function
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub
'**************************************************************************************

长运行 VBScript 文件警报

Long Running VBScript File Alert

vbscript

time

loops

do-while

长 运行 VBScript 文件警报

Long Running VBScript File Alert

vbscript

time

loops

do-while

长运行 VBScript 文件警报