CODEWITHSUNDEEP
vbscripttimer
user4741152
user4741152

Reputation:

How to Make a VBScript Timer

I need to have a timer appear in a message box, coded in vbs. The message box needs to be in the bottom left corner of the screen, just above the start menu. It needs to not be able to exit, meaning it cannot be listed on the task bar (hopefully) and have no minimise/exit buttons. It needs to stay on top of all the other windows. It also needs to start at 20 minutes, counting down in seconds. I hope someone can help me with this - it's for a computer lab.

Thanks, Matthew

Upvotes: 2

Views: 10542

Answers (1)

Hackoo
Hackoo

Reputation: 18857

Try something like that :

Option Explicit
Dim Title,ws,nMinutes,nSeconds,sMessage
Title = "Counting Down to Shutdown"
Set ws = CreateObject("wscript.Shell")
nMinutes = 20
nSeconds = 0
sMessage = "<font color=Red size=2><b>Counting Down to Shutdown"
'Open a chromeless window with message
with HTABox("lightBlue",100,250,0,630)
    .document.title = "Counting Down Notification to Shutdown"
    .msg.innerHTML = sMessage
    do until .done.value or (nMinutes + nSeconds < 1)
        .msg.innerHTML = sMessage & "<br>" & nMinutes & ":" & Right("0"&nSeconds, 2) _
        & " remaining</b></font><br>"
        wsh.sleep 1000 ' milliseconds
        nSeconds = nSeconds - 1
        if nSeconds < 0 then 
            if nMinutes > 0 then
                nMinutes = nMinutes - 1
                nSeconds = 59
            end if
        end if
    loop
    .done.value = true
    .close
end with
ws.Popup "TIME IS OVER !","5",Title,0+48 'Afficher un Popup durant 5 secondes puis on quitte le script
'Command="cmd /c Shutdown.exe -s -t 30 -c " & DblQuote("Sauvegarder votre Travail car l'ordinateur va rebooter dans 30 secondes")
'Executer = WS.Run(Command,0,False) 
'*****************************************************************
Function HTABox(sBgColor, h, w, l, t)
    Dim IE, HTA, sCmd, nRnd
    randomize : nRnd = Int(1000000 * rnd)
    sCmd = "mshta.exe ""javascript:{new " _
    & "ActiveXObject(""InternetExplorer.Application"")" _
    & ".PutProperty('" & nRnd & "',window);" _
    & "window.resizeTo(" & w & "," & h & ");" _
    & "window.moveTo(" & l & "," & t & ")}"""
    with CreateObject("WScript.Shell")
        .Run sCmd, 1, False
        do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
        end with  'WSHShell
        For Each IE In CreateObject("Shell.Application").windows
            If IsObject(IE.GetProperty(nRnd)) Then
                set HTABox = IE.GetProperty(nRnd)
                IE.Quit
                HTABox.document.title = "HTABox"
                HTABox.document.write _
                "<HTA:Application contextMenu=no border=thin " _
                & "minimizebutton=no maximizebutton=no sysmenu=no SHOWINTASKBAR=no >" _
                & "<body scroll=no style='background-color:" _
                & sBgColor & ";font:normal 10pt Arial;" _
                & "border-Style:inset;border-Width:3px'" _
                & "onbeforeunload='vbscript:if not done.value then " _
                & "window.event.cancelBubble=true:" _
                & "window.event.returnValue=false:" _
                & "done.value=true:end if'>" _
                & "<input type=hidden id=done value=false>" _
                & "<center><span id=msg>&nbsp;</span><br>" _
                & "<input type=button id=btn1 value=' OK ' "_
                & "onclick=done.value=true><center></body>"
                HTABox.btn1.focus
                Exit Function
            End If
        Next
        MsgBox "HTA window not found."
        wsh.quit
End Function
'*****************************************************************

Upvotes: 5

Related Questions