http://dieseyer.de • all rights reserved • © 2011 v11.4
<html>
<head>
<!--
'v6.1***************************************************
' File: countdown-programmstart.hta
' Autor: dieseyer@gmx.de
' http://dieseyer.de
'
'*******************************************************
-->
<title>Programmstart - Zeitpunkt</title>
<HTA:APPLICATION
ID="HtaID"
APPLICATIONNAME = "CountDown"
SCROLL = "no"
NAVIGABLE = "no"
MAXIMIZEBUTTON = "no"
MINIMIZEBUTTON = "no"
CAPTION = "yes"
SHOWINTASKBAR = "yes"
ICON = "http://dieseyer.de/images/boese32x32.ico"
>
<style type="text/css">
<!--
SYSMENU = "yes"
MINIMIZEBUTTON = "yes" => verhindert bei minimiertem HTA "in den Vordegrund"
background:#601010; bordeaux (weinrot) => negative Info, Achtung, Nein
background:#004030; dunkelgrün => positive Info, OK, Ja
background:#601010; dunkelblau => neutrale Info
-->
<!--
html, body { font-Size:12pt; color:#E0C000; font-family:Verdana; /* font-weight:bold; */
background:#601010;
}
a { font-size:100%; color:#FFFFFF; text-decoration:underline; }
a:active { color:red; }
a:link { color:#FFE000; }
a:visited { color:#E0C000; }
a:hover { color:red; }
a:active { color:#E0C000; }
input, select, textarea
{ color:#1d2160; font-weight:bold; }
-->
</style>
<SCRIPT language=VBScript>
Const ProgrName = "notepad"
Dim vStartZeit : vStartZeit = CDate( now() + CDate( "01:01:00" ) )
Dim vAnzeigeNeu
Dim TastTaste ' um [F5] für HTA neu starten abzufangen
Dim Tst, Txt, Anwendung, i
Dim MsgPop : MsgPop = "5"
'**************************************************************
Sub AnzeigeNeu()
'**************************************************************
' Aufruf durch: vAnzeigeNeu = window.setInterval("AnzeigeNeu()", 250, "VBScript")
' aus vStartZeit die Sekunden auf ":00" setzen
vStartZeit = FormatDateTime( vStartZeit, vbShortDate ) & " " & FormatDateTime( vStartZeit, vbShortTime )
vRestZeit = FormatDateTime( CDate( CDate( vStartZeit ) - now() ) , vbLongTime )
Tst = DateDiff( "s", now(), CDate( vStartZeit ) )
Tst = FormatNumber( Tst, 0, 0, 0, -2 ) ' FormatNumber(Ausdruck[, AnzDezimalstellen[, FührendeNull[, KlammernFürNegativeWerte[, ZiffernGruppieren]]]])
If Tst <= 1 Then : vStartZeit = "" : self.close : Exit Sub
Ttt = "<br>CountDown bis zum Start des Programms => <b>""" & ProgrName & """</b><br>"
Ttt = "<br>CountDown bis zum Programmstart von <br><br><b> => """ & ProgrName & """ <=</b><br>"
document.all.idErsteZeile.innerHTML = Ttt
Ttt = vRestZeit ' vRestZeit zur Anzeige anpassen
If InStr( "x" & vRestZeit, "x00:" ) > 0 Then Ttt = Replace( "x" & vRestZeit, "x00:", "" ) & " min"
top.document.title = Replace( Replace( "x" & vRestZeit, "x00:00:", "00:" ), "x", "" ) & " bis Programmstart"
If Tst > 175 Then ' für unterschiedliche Anzeigeformat
document.all.idStartZeit.innerHTML = "Für den Programmstart ist der <b>" & vStartZeit & "</b> gesetzt - das ist in " & vRestZeit & " h."
document.all.idStartRest.innerHTML = "Programmstart in " & Ttt & "<br>"
Else
document.all.idStartZeit.innerHTML = "Für den Programmstart ist der <b>" & vStartZeit & "</b> gesetzt - das ist in " & Tst & " s."
document.all.idStartRest.innerHTML = "Programmstart in " & Tst & " sec<br>"
'' top.document.title = Tst & " s bis Programmstart"
End If
' In der letzten Stunde vor Ablauf wird diese HTA in den Vordergrund geholt - zur Erinnerung
' ~~~~~~~~~~~~~~~~~~~~~
' 1h, 1/2h, 1/4h, 5min und 1min vor Ablauf
Ttt = "-OK"
Txt = Fix( DateDiff( "n", now(), CDate( vStartZeit ) ) )
If MsgPop = "5" AND Txt < 61 Then MsgPop = "4" : Ttt = "OK" ' : Tst = MsgPop & " - " & Tst & " - " & Ttt
If MsgPop = "4" AND Txt < 31 Then MsgPop = "3" : Ttt = "OK" ' : Tst = MsgPop & " - " & Tst & " - " & Ttt
If MsgPop = "3" AND Txt < 21 Then MsgPop = "2" : Ttt = "OK" ' : Tst = MsgPop & " - " & Tst & " - " & Ttt
If MsgPop = "2" AND Txt < 11 Then MsgPop = "1" : Ttt = "OK" ' : Tst = MsgPop & " - " & Tst & " - " & Ttt
If MsgPop = "1" AND Txt < 4 Then MsgPop = "0" : Ttt = "OK" ' : Tst = MsgPop & " - " & Tst & " - " & Ttt
If DateDiff( "s", now(), CDate( vStartZeit ) ) < 30 Then Ttt = "OK"
i = i + 1 : If i < 20 Then Exit Sub
If not Ttt = "OK" Then Exit Sub
i = 0
window.clearInterval( vAnzeigeNeu ) ' damit die Aktualisierung der Anzeige nicht beim In-Den-Vordergrund-Bringen dazwischen funkt
' In dem VBS wird mit AppActivate das startende HTA in den Vordergrund geholt.
' Dieser Umweg ist notwendig, da folgende Aufrufe nicht das gewünschte Ergebnis brachten:
'' document.focus()
'' self.focus
'' window.focus
'' self.setActive - gibst nicht
Dim progr : progr = top.document.title
Dim Datei : Datei = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\temp-.vbs"
Dim FileOut : Set FileOut = CreateObject("Scripting.FileSystemObject").CreateTextFile( Datei , true)
FileOut.WriteLine "' " & now() & " )"
FileOut.WriteLine "Tst = CreateObject(""WScript.Shell"").AppActivate( ""00:"" )"
FileOut.WriteLine "WScript.Sleep 333"
FileOut.WriteLine "Tst = CreateObject(""WScript.Shell"").AppActivate( ""00:"" )"
FileOut.WriteLine "WScript.Sleep 333"
FileOut.WriteLine "CreateObject(""WScript.Shell"").SendKeys""{F5}"""
FileOut.WriteLine "Set fso = CreateObject(""Scripting.FileSystemObject"")"
FileOut.WriteLine "If fso.FileExists( WScript.ScriptFullName ) Then fso.DeleteFile( WScript.ScriptFullName )"
' FileOut.WriteLine "WScript.Sleep 333"
' FileOut.WriteLine "WScript.Sleep 1000"
' FileOut.WriteLine "MsgBox Tst & "" - E N D E - "", , WScript.ScriptName"
FileOut.Close
Set FileOut = nothing
window.setTimeout "ProgrRun('" & Datei & "')", 333 ' warten bis VBS 'richtig' geschrieben ist
End Sub ' AnzeigeNeu()
'**************************************************************
Sub ProgrRun( DateiX )
'**************************************************************
CreateObject("WScript.Shell").Run DateiX , , True
window.setTimeout "Window_OnLoad()", 333 ' warten bis window.clearInterval 'richtig' wirkt
End Sub ' ProgrRun( DateiX )
'**************************************************************
Sub window_onbeforeunload
'**************************************************************
' window.event.returnValue = "> > > > > Mit dem Schließen dieser Anwendung wird das Programm gestartet! < < < < <"
' sollte [F5] gedrückt worden sein (beendet das HTA und lädt es neu)
If TastTaste = 116 Then Call RegKeySchreiben( vStartZeit ) : Exit Sub
CreateObject("WScript.Shell").Run ProgrName
End Sub ' window_onbeforeunload
'**************************************************************
Sub RegKeySchreiben( Wert ) ' http://dieseyer.de/scr/wmi-regkeywrite.vbs
'**************************************************************
Dim KeyPath : KeyPath = "SOFTWARE\dieseyer.de\Enviroment"
Dim KeyKey : KeyKey = "EndeZeit"
Dim oReg : Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Const HKLM = &H80000002
' Inhalt schreiben
oReg.CreateKey HKLM,KeyPath
oReg.SetStringValue HKLM,KeyPath,KeyKey,Wert
End Sub ' RegKeySchreiben( Wert )
'**************************************************************
Function RegKeyLesen() ' http://dieseyer.de/scr/wmi-regkeywrite.vbs
'**************************************************************
Dim KeyPath : KeyPath = "SOFTWARE\dieseyer.de\Enviroment"
Dim KeyKey : KeyKey = "EndeZeit"
Dim oReg : Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Const HKLM = &H80000002
' Inhalt lesen
oReg.GetExpandedStringValue HKLM,KeyPath,KeyKey,KeyInh
RegKeyLesen = KeyInh
Call RegKeySchreiben( "" )
End Function ' RegKeyLesen
'**************************************************************
Sub Window_OnLoad
'**************************************************************
Dim Tst
' window.moveto Links, Oben
window.moveto 50, 50 ' Position
' window.resizeto Breite, Höhe ' Größe
' window.resizeto 520, screen.height-23
window.resizeto 820, 600
Tst = ""
Tst = RegKeyLesen()
If not Tst = "" Then Call StartZeitTest( Tst ) ' alte vStartZeit aus Reg verwendbar?
Call RegKeySchreiben( "" )
Call AnzeigeNeu()
Call ZeitAuswahl()
vAnzeigeNeu = window.setInterval("AnzeigeNeu()", 222, "VBScript")
End Sub ' Window_OnLoad
'**************************************************************
Sub ZeitAuswahl()
'**************************************************************
TastEing = 13
Dim Txt
Txt = Txt & " <Span style=""font-size:12pt""> "
Txt = Txt & " <fieldset><Legend align=""Center""> Zeit bis Programmstart verkürzen: </legend> "
Txt = Txt & " </Span><Span style=""font-size:10pt""> "
Txt = Txt & " <br> <input Type=""text"" Name=""neueZeit"" Value="" "" > "
Txt = Txt & " <br><br> "
Txt = Txt & " <p align=""Left""> Erlaubte Eingaben: <br> "
Txt = Txt & " <b>3,5h</b> Programmstart in 3 Stunden und 30 Minuten <br> "
Txt = Txt & " <b>120min</b> Programmstart in 120 Minuten <br> "
Txt = Txt & " <b>2:15</b> Programmstart um 2 Uhr und 15 Minuten (oder 14:15) "
Txt = Txt & " <p> "
document.all.AnzeigeHTA.innerHTML = Txt
End Sub ' ZeitAuswahl()
'**************************************************************
Sub document_onKeyDown
'**************************************************************
TastTaste = window.event.keyCode
If TastTaste = 13 Then Call neuesEnde()
End Sub
'**************************************************************
Sub neuesEnde()
'**************************************************************
Call StartZeitTest( UCase( Document.All.neueZeit.Value ) )
End Sub ' neuesEnde()
'**************************************************************
Sub StartZeitTest( Tst )
'**************************************************************
Dim errTst
Dim X : X = "-"
' MsgBox Tst, , "256 :: "
On Error Resume Next
err.Clear : If InStr( Tst, ":" ) > 0 Then Tst = CDate( Tst ) : If err.Number = 0 Then X = "+"
err.Clear : If InStr( Tst, "M" ) > 0 Then Tst = DateAdd( "n", Replace( Tst, "M" , "" ) , now() ) : If err.Number = 0 Then X = "+"
err.Clear : If InStr( Tst, "MIN" ) > 0 Then Tst = DateAdd( "n", Replace( Tst, "MIN" , "" ) , now() ) : If err.Number = 0 Then X = "+"
err.Clear : If InStr( Tst, "H" ) > 0 Then Tst = DateAdd( "n", Replace( Tst, "H" , "" ) * 60 , now() ) : If err.Number = 0 Then X = "+"
If X = "-" Then MsgBox "Ungültige Eingabe!", 48, "267 :: " : Exit Sub
On Error GoTo 0
' MsgBox Tst, , "271 :: "
' If Tst < DateAdd( "d", -2, vStartZeit ) Then MsgBox Tst & vbCRLF & CDate( date() & " " & Tst ): Tst = CDate( date() & " " & Tst )
If Tst < DateAdd( "d", -2, vStartZeit ) Then Tst = CDate( date() & " " & Tst )
If Tst < now() Then Tst = DateAdd( "h", 12 , Tst )
If Tst < now() Then Tst = DateAdd( "h", 12 , Tst )
If Tst < now() Then Tst = DateAdd( "h", 12 , Tst )
' If DateDiff( "h", Tst, now() ) > 12 Then MsgBox Tst & vbCRLF & DateAdd( "h", Tst , -12 ) & vbCRLF & vStartZeit : Tst = DateAdd( "h", Tst , -12 )
If DateDiff( "h", Tst, now() ) > 12 Then Tst = DateAdd( "h", Tst , -12 )
' MsgBox Tst & vbCRLF & vStartZeit
If Tst > CDate( vStartZeit ) Then MsgBox vbTab & "Ungültige Eingabe!" & vbCRLF & vbCRLF & "Die Zeit bis zum Programmstart kann nur verkürzt werden!", 48, "284 :: ==> " & Tst : Call ZeitAuswahl() : Exit Sub
vStartZeit = Tst
Call AnzeigeNeu()
Call ZeitAuswahl()
End Sub ' StartZeitTest( Tst )
</SCRIPT>
</HEAD>
<BODY>
<form>
<center>
<span style="font-size:20pt;" ID=idErsteZeile> </span>
<br><br><span style="font-size:36pt;font-weight:bold;" ID=idStartRest></span><br><br>
<b><u> A C H T U N G</u> =></b> Mit dem Schließen dieses Fensters wird das Programm <u>sofort</u> gestartet!
<br><br>
<span ID=idStartZeit></span>
<br><br>
<table align="Center" border="0" cellspacing="20px" width="066%">
<tr >
<td align="Center" cellspacing="70%" >
<div ID=AnzeigeHTA >
</td>
</tr>
</table>
</form>
</BODY>
</html>
http://dieseyer.de • all rights reserved • © 2011 v11.4