Option Explicit
If RunCountdown(5) Then CreateObject("WScript.Shell").Run """%programfiles%\Internet Explorer\iexplore.exe"" ""http://yandex.ru"""
Function CreateWindow()
' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
Dim sSignature, oShellWnd, oProc
On Error Resume Next
sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
Do
Set oProc = CreateObject("WScript.Shell").Exec("mshta about:""about:<head><script>moveTo(-32000,-32000);document.title=' '</script><hta:application id=app border=thick minimizebutton=no maximizebutton=no scroll=no showintaskbar=yes contextmenu=no selection=no innerborder=no icon=""""/><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""")
Do
If oProc.Status > 0 Then Exit Do
For Each oShellWnd In CreateObject("Shell.Application").Windows
Set CreateWindow = oShellWnd.GetProperty(sSignature)
If Err.Number = 0 Then Exit Function
Err.Clear
Next
Loop
Loop
End Function
Function RunCountdown(lSetTime)
Dim oWnd, sWndType, lInitTime, lRemain
RunCountdown = False
On Error Resume Next
Set oWnd = CreateWindow()
sWndType = TypeName(oWnd)
With oWnd
With .Document
.Title = "Countdown"
.Body.Style.Background = "buttonface"
.Body.Style.Font = "bold 60pt consolas, courier new"
.Body.InnerHTML = "<center><div id='Output' style='margin: 10px;'>00:00</div><button onclick='Clicked=1;' style='width: 85px; margin: 10px;'>Reset</button><button onclick='Clicked=2;' style='width: 85px; margin: 10px;'>Quit</button></center>"
End With
.ResizeTo 350, 230
.MoveTo 400, 400
.ExecScript "window.Clicked=0;"
lInitTime = Timer()
Do
If sWndType <> TypeName(oWnd) Then Exit Function
Select Case .Clicked
Case 1
lInitTime = Timer()
.Clicked = 0
Case 2
.Close
Exit Function
End Select
lRemain = (86400 + lSetTime + lInitTime - Timer()) mod 86400
.Output.InnerHTML = Right("0" & lRemain \ 60, 2) & ":" & Right("0" & lRemain Mod 60, 2)
WScript.Sleep 40
Loop While lRemain > 0
.Close
End With
RunCountdown = True
End Function
http://pastebin.com/h14N0xuB
