'*** v14.3 *** www.dieseyer.de ****************************** ' File: PopsUp.vbs ' Autor: dieseyer@gmx.de ' dieseyer.de ' ' Function PopsUp ( TxT, Dauer ) ' erstellt ein MSG-VBScript im %TEMP%-Verzeichnis und ' ruft es mit WSHShell.Exec auf. ' Dadurch ist es beim Erneuten Aufruf des MSG-VBscripts ' möglich, das "alte" PopUp (vor Zeitablauf) zu beenden. '*********************************************************** Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl Dim Prog_PP : Set Prog_PP = nothing ' für Function PopsUp ( TxT, Dauer ) Dim i For i = 1 to 7 Step 2 WScript.Sleep i*500 PopsUp "Hallo - Hallo - Hallo - Hallo - Hallo " & vbTab & i, 20 ' eigentlich müsste das PopUp 20s stehen bleiben, wird aber durch ' den erneuten Aufruf vorher geschlossen, bevor ein neues aufgeht ' PopsUp "Hallo" & vbTab & i, 20 Next PopsUp "Ende - Ende - Ende - Ende - Ende - Ende" , 20 WScript.Sleep 10 * 1000 ' Nach 10s (statt 20) kommt: zum löschen des letzten PopsUp PopsUp "" , 0 ' zum löschen des letzten PopsUp WScript.Quit '*** v14.3 *** www.dieseyer.de ****************************** Function PopsUp( TxT, Dauer ) '*********************************************************** ' in VBS und HTA verwendbar ' ACHTUNG! Ausserhalb und vor dem ersten Aufruf dieser Prozedur ' muss einmal "Set Prog_PP = nothing" stehen, sonst wird es ' mit dem "prog.terminate" innerhalb der Prozedur nichts! ' ' ACHTUNG! Alle Variablen müssen ausserhalb dieser Prozedur ' deklariert werden (also folgende Zeilen an den Skript-Anfang): ' Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP ' Set Prog_PP = nothing Dim Tst Tst = "" On Error Resume Next Tst = Titel ' If not err.Number = 0 then MsgBox err.Description On Error GoTo 0 If Tst = "" Then Tst = "PopsUp" Dim Fso_PP : Set Fso_PP = CreateObject("Scripting.FileSystemObject") Dim VBSDatei_PP : VBSDatei_PP = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%Temp%") & "\" & Tst & "-MSG.VBS" Dim FileOut_PP On Error Resume Next Prog_PP.terminate ' If not err.Number = 0 then MsgBox err.Description On Error GoTo 0 If Txt = "" then On Error Resume Next IF Fso_PP.FileExists(VBSDatei_PP) then Fso_PP.DeleteFile(VBSDatei_PP) ' löscht das ggf. vorhandene MSG-VBScript On Error GoTo 0 Exit Function End If Txt = Replace( Txt, vbCRLF, """ & vbCRLF & """ ) ' MSG-VBScript neu anlegen Fso_PP.OpenTextFile(VBSDatei_PP, 2, true).WriteLine "WScript.CreateObject(""WScript.Shell"").Popup """ & Txt & """ , " & Dauer & ", """ & Fso_PP.GetFileName( VBSDatei_PP ) & " "" , vbSystemModal " ' MSG-VBScript starten On Error Resume Next Set Prog_PP = CreateObject("WScript.Shell").exec( "WScript """ & VBSDatei_PP & """" ) ' If not err.Number = 0 then MsgBox err.Description On Error GoTo 0 End Function ' PopsUp( TxT, Dauer )