http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** v9.A *** www.dieseyer.de ******************************
' File: Datensicherung.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Gemäß der Verzeichnisliste "Datensicherung.txt" wird auf
' dem ZielLaufwerk (1. zeile in "Datensicherung.txt") eine
' komprimierte Datei (Verzeichnis) mit dem Tagesdatum
' erstellt, in der alle Dateien der Verzeichnisse mit
' Unterverzeichnissen, wie in "Datensicherung.txt" gelistet,
' enthalten sind.
' Zeilen, die mit einem Leerschrit, einem Semikolon oder
' einem Apostroph beginnen werden ignoriert.
'************************************************************

Option Explicit

Dim fso, WSHShell, WSHNetzWerk, WSHLaufWerk, oArgs
Dim i, FileOut, FileOut1, FileIn, TXT, TXT1, Text, ZielOK, VerzOK, Problem, Menge, Pwd
Dim Zeit, ZielVerz, VerzListe, VerzNr

Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP
Set Prog_PP = nothing

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
set oArgs = Wscript.Arguments

Pwd = ""

' Passwort definieren
' => nächste Zeile frei geben
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
PwdAbfrage ' Function Aufruf


LogDatei ( vbCRLF & now() & " - " & UCase(WScript.ScriptName) & " gestartet"& vbCRLF & "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ " )

' Prüfen, ob VerzListe-Datei existiert;
' wenn nicht: anlegen und ausfüllen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' VerzListe = "Datensicherung.txt"
VerzListe = fso.GetBaseName( WScript.ScriptName ) & ".txt"

if not fso.FileExists( VerzListe ) then
Set FileOut = fso.OpenTextFile( VerzListe, 2, true) ' Datei zum Erweitern öffnen (notfals anlegen)
Set FileIn = FSO.OpenTextFile( WScript.ScriptName, 1 ) ' Datei zum Lesen öffnen
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
TXT = FileIn.Readline ' eine Zeile lesen
If not Left ( TXT, 1 ) = "'" then Exit Do
FileOut.WriteLine( TXT )
Loop
FileOut.WriteLine( "' Bitte jetzt vervollständigen:" )
FileOut.WriteLine( "' 1. freie Zeile: Ziel-Verzeichnis für Datensicherung" )
FileOut.WriteLine( "' 2. freie Zeile: zu sicherndes Quell-Verzeichnis für Datensicherung" )
FileOut.WriteLine( "' ?. freie Zeile: zu sicherndes Quell-Verzeichnis für Datensicherung" )
Set FileIn = nothing
Set FileOut = nothing
WSHShell.run VerzListe, 4, True
End If

' Prüfen, ob VerzListe korrekt ist
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' - ermittelt das Zielverzeichnis der Datensicherungen
' - Datensicherung.tmp enthält Liste der zu sichernden Verzichnisse
ParameterAbfrage ' Function Aufruf


' Im Zielverzeichnis wird DatumVerzeichnis mit lfd. Nr. erzeugt
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZielVerz = Datumverzeichnis ( ZielVerz ) ' Function Aufruf


Set FileIn = fso.OpenTextFile( fso.GetBaseName( VerzListe ) & ".tmp", 1 ) ' Datei zum Lesen öffnen

Menge = 0
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
TXT = CStr( FileIn.Readline ) ' eine Zeile lesen
if Len( TXT ) < 8 Then Text = TXT & vbTab
if not Len( TXT ) < 8 Then Text = TXT

if not fso.FolderExists( TXT ) then

LogDatei ( vbCRLF & "!!! " & TXT & " nicht vorhanden. ")

Else
' Menge = Menge + CLng(fso.GetFolder( TXT ).size)
Menge = Menge + fso.GetFolder( TXT ).size
Text = Text & vbTab & FormatNumber( fso.GetFolder( TXT ).size/1024 , 1) & " kByte" & vbTab & " zu sichern"
Text = Text & vbTab & fso.getDrive( Left ( TXT, 2 ) ).VolumeName
Text = Text & vbTab & fso.getDrive( Left ( TXT, 2 ) ).ShareName
LogDatei ( Text )

Text = Replace( Left ( TXT, 1) & "" & Mid ( TXT, 3) , "\" , "²")
'_______________________________________________________________
'Für die Verwendung von XCOPY folgende beiden Zeilen frei geben
' Text = "xcopy """ & TXT & "\*.*"" """ & ZielVerz & "\" & Text & "\*.*"" /S/E/V "

'_______________________________________________________________
'Für die Verwendung von ROBOCOPY folgende Zeile frei geben
' Text = "robocopy """ & TXT & """ """ & ZielVerz & "\" & Text & """ /S /E /sec /w:1 /r:1 /log:" & ZielVerz & "\" & Text & ".log "

'_______________________________________________________________
'Für die Verwendung von RAR zwei Zeilen frei geben
' If Pwd = "" Then Text = "rar.exe a -ad -m5 -ap" & " -sfx """ & ZielVerz & "\" & Text & """ """ & TXT & """"
' If not Pwd = "" Then Text = "rar.exe a -ad -m5 -ap -hp" & Pwd & " -sfx """ & ZielVerz & "\" & Text & """.rar """ & TXT & """"

TXT1 = ""
If fso.FileExists( "7z.sfx" ) Then TXT1 = " -sfx7z.sfx"
'_______________________________________________________________
'Für die Verwendung von 7-Zip zwei Zeilen frei geben
If Pwd = "" Then Text = "7z.exe a" & TXT1 & " -r" & " """ & ZielVerz & "\" & Text & ".exe"" """ & TXT & """"
If not Pwd = "" Then Text = "7z.exe a" & TXT1 & " -r -p" & Pwd & " """ & ZielVerz & "\" & Text & ".exe"" """ & TXT & """"

' MsgBox text, , "115 :: " : WSCript.Quit

'_______________________________________________________________
'Wahlweise die RunBat oder WSHShell.Run Zeile frei geben

' RunBat ( Text ) ' Function Aufruf
WSHShell.run "%comspec% /k " & Text , , True
' WSHShell.run Text , 8, True

' Passwort für LogDatei entfernen
Text = Replace( Text, Pwd, "~-_Pwd_-~" )

LogDatei Text & vbTab & " . . . abgeschlossen. " & vbCRLF

End If
Loop

LogDatei ( now() & " - " & UCase(WScript.ScriptName) & " beendet" )
LogDatei ( FormatNumber( Menge/1024, 1) & " kByte wurden in " & FormatNumber( fso.GetFolder( ZielVerz ).size/1024 , 1) & " kByte gepackt und nach " & ZielVerz & " gesichert. ")

Set FileIn = nothing


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' LogDatei anzeigen (und an das Ende springen)
' => nächste Zeile frei geben
' LogDateiAnzeige

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Erstelltes Zielverzeichnis mit gesicherten Daten anzeigen
' => nächste Zeile frei geben
WSHShell.run ZielVerz, 1

WScript.Quit



' **************************************************************
Function CopyNachA (Datei) ' Anfang
' **************************************************************
' Archiv nach A: kopieren?
Dim TXT, Text
Dim WSHShell, fso

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

TXT = Datei

If not fso.GetFile( Datei ).Size < 1457664-2048 then
Text = Datei & vbCRLF & "ist mit " & Int( fso.GetFile( Datei ).Size/1024/1024 ) & " MB zu groß für eine Diskette!"
WshShell.Popup Text, 10, WScript.ScriptName, 4096
Exit Function
End If


Text = "Soll das erstellte Archiv " & vbCRLF & vbCRLF
Text = Text & LCase( Datei ) & " (" & FormatNumber( fso.GetFile( Datei ).Size,1) & " Byte)" & vbCRLF & vbCRLF
Text = Text & "auf eine Diskette in A: kopiert werden? [N] nach 10 Sekunden."
If not vbYes = WshShell.Popup( Text, 25, WScript.ScriptName, 4096+4+32) Then Exit Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Diskette bereit?
If not fso.GetDrive( "a:" ).IsReady Then WshShell.Popup "Laufwerk A: ist nicht bereit!", 10, WScript.ScriptName, 4096
If not fso.GetDrive( "a:" ).IsReady Then Exit Function

If fso.FileExists ( "A:\" & fso.GetBaseName( Datei ) & ".exe" ) then fso.DeleteFile "A:\" & fso.GetBaseName( Datei ) & ".exe", true

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Diskette mit genügend freien Speicher?
If not fso.GetFile( Datei ).Size < fso.GetDrive( "a:" ).FreeSpace-1024 then
Text = "Auf der Diskette in A: ist nicht genügend Platz!" & vbCRLF
Text = Text & "Soll die Diskette formatiert werden?"
If vbYes = WshShell.Popup( Text, 25, WScript.ScriptName, 4096+4+32) Then
WSHShell.Run "format a: /F:1440 /Q /V:DISK1440", , True
' WSHShell.Run "%comspec% /k format a: /F:1440 /U /V:DISK1440", , True
End If
End If

If not fso.GetFile( Datei ).Size < fso.GetDrive( "a:" ).FreeSpace-1024 then Exit Function

PopsUp Datei & vbCRLF & vbCRLF & "wird z.Z. nach A: kopiert . . .", 90
fso.CopyFile Datei , "A:\" & fso.GetBaseName( Datei ) & ".exe"
PopsUp "", 0


' If fso.FileExists( "A:\" & fso.GetBaseName( Datei ) & ".exe" ) then
' PopsUp "A:\" & fso.GetBaseName( Datei ) & ".exe" & vbCRLF & vbCRLF & "wurde erstellt.!", 10
' End If

End Function ' CopyNachA (Datei)
' **************************************************************



' **************************************************************
Function ParameterAbfrage
' **************************************************************
' VerzeichnisListe zeilenweise lesen und prüfen

i = 0
Problem = ""
ZielOK = ""
VerzOK = ""
VerzNr = 0
Text = ""

Set FileOut = fso.OpenTextFile( fso.GetBaseName( VerzListe) & ".tmp", 2, true) ' Datei zum Erweitern öffnen (notfals anlegen)
Set FileIn = FSO.OpenTextFile( VerzListe, 1 ) ' Datei zum Lesen öffnen
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
TXT = FileIn.Readline ' eine Zeile lesen

' Bemerkungszeilen nicht prüfen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not Left ( TXT, 1 ) = ";" AND not Left ( TXT, 1 ) = " " AND not Left ( TXT, 1 ) = "'" then
' wenn die Zeile nicht mit . . . beginnt
ZielOK = "ok"
i = i + Len(TXT) +2
If not fso.FolderExists( TXT ) Then
ZielOK = "fehlt"
If VerzNr < 1 then FileOut.WriteLine( TXT )
If not VerzNr < 1 then FileOut.WriteLine( ";###" & ZielOk & " " & TXT )
Problem = "ja"
Else
FileOut.WriteLine( TXT )
End If

' Zeilen für MsgBox in Text sammeln; erste Zeile enthält ZielVerzeichnis
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Text = "" Then
ZielVerz = TXT
VerzOK = ZielOK
Text = "Nach " & ZielVerz & " (" & ZielOK & ") werden folgende Verzeichnisse gesichert (kopiert): " & vbTab & vbCRLF

' Zeilen für MsgBox in Text sammeln; jede weitere Zeile enthält zu sichernde Verzeichnisse
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Else
VerzNr = VerzNr +1
if i < 400 then
Text = Text & vbCRLF & VerzNr & vbTab & ZielOK & vbTab & " " & TXT
End If
End If

Else
FileOut.WriteLine( TXT )
End If
Loop
Set FileIn = nothing
Set FileOut = nothing

Text = Text & vbCRLF & " " & VerzNr & " Verzeichnisse insgesamt."

' Problem = "nEIn"

If UCase( left(Problem,2) ) = "JA" Then
Text = Text & vbCRLF & vbCRLF & "Die obigen Parameter sollten angepasst werden, da nicht alle Verzeichnisse " & vbCRLF & "vorhanden sind."
Else
Text = Text & vbCRLF & vbCRLF & "Die obigen Parameter sind soweit ok, können aber angepasst werden."
End If

If not UCase(Left( VerzOK, 2)) = "OK" Then ' Meldung, wenn ZielVerzeichnis nicht vorhanden
Text = Text & vbCRLF & vbCRLF & UCase("Das Zielverzeichnis " & ZielVerz & " zur Datensicherung existiert nicht!")
End If

Text = Text & vbCRLF & vbCRLF & "Parameter korrigieren oder Skript abbrechen? [No] in 10sec."
TXT = WshShell.Popup(Text, 5, WScript.ScriptName, 4096+3+32)


If TXT = -1 AND not UCase(Left( VerzOK, 2)) = "OK" Then ' Meldung, wenn ZielVerzeichnis nicht vorhanden
' wenn keine Taste gedrückt wurde
Text = UCase("Das Zielverzeichnis " & ZielVerz & " zur Datensicherung existiert nicht!")
Text = Text & vbCRLF & vbCRLF & UCase("Das Skript wird ohne Datensicherung beendet!")
LogDatei ( Text ) ' Sub Aufruf
WshShell.Popup Text, 10, WScript.ScriptName, 64+4096
LogDateiAnzeige ' Sub Aufruf
WScript.Quit
End If

If TXT = vbNo AND not UCase(Left( VerzOK, 2)) = "OK" Then ' Meldung, wenn ZielVerzeichnis nicht vorhanden
MsgBox UCase("Das Zielverzeichnis " & ZielVerz & " zur Datensicherung existiert nicht!"), 4096+64, WScript.ScriptName
ParameterAbfrage ' Function Aufruf
End If

If TXT = vbYes then
fso.CopyFile fso.GetBaseName( VerzListe) & ".tmp", VerzListe
WSHShell.run VerzListe, , True
ParameterAbfrage ' Function Aufruf
End If

If TXT = vbCancel then
WshShell.Popup " . . . denn eben nicht!", 10, WScript.ScriptName, 64+4096
Text = UCase("Das Skript wurde abgebrochen = keine Datensicherung!")
LogDatei ( Text ) ' Sub Aufruf
LogDateiAnzeige ' Sub Aufruf
WScript.Quit
End If

i = 0
Set FileOut = fso.OpenTextFile( fso.GetBaseName( VerzListe) & ".tmp", 2, true) ' Datei zum Erweitern öffnen (notfals anlegen)
Set FileIn = FSO.OpenTextFile( VerzListe, 1 ) ' Datei zum Lesen öffnen
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
TXT = FileIn.Readline ' eine Zeile lesen

If not Left ( TXT, 1 ) = ";" AND not Left ( TXT, 1 ) = " " AND not Left ( TXT, 1 ) = "'" then
' wenn die Zeile nicht mit . . . beginnt
If i > 0 then FileOut.WriteLine( TXT )
i = i +1
End If
Loop
Set FileIn = nothing
Set FileOut = nothing

End Function ' ParameterAbfrage
' **************************************************************



' **************************************************************
Function Datumverzeichnis ( ZielVerz )
' **************************************************************
' legt im ZielVerzeichhnis ein Datumverzeichnis mit lfd.
' Nummer an: (k:\siceherer\)02-12-03_0

Zeit = now()

' zweistellige Jahreszahl
Datumverzeichnis = Right(Year(Zeit),2)

' zweistellige Monatszahl
If Len(Month(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-0" & Month(Zeit)
If not Len(Month(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-" & Month(Zeit)

' zweistellige Tageszahl
If Len(Day(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-0" & Day(Zeit)
If not Len(Day(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-" & Day(Zeit)

' zweistellige Stundezahl
' If Len(Hour(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "_0" & Hour(Zeit)
' If not Len(Hour(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "_" & Hour(Zeit)

' zweistellige Minutenzahl
' If Len(Minute(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'0" & Minute(Zeit)
' If not Len(Minute(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'0" & Minute(Zeit)

' zweistellige Sekundenzahl
' If Len(Second(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'0" & Second(Zeit)
' If not Len(Second(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'" & Second(Zeit)

' if not fso.FolderExists( ZielVerz & "\" & Datumverzeichnis ) then
' fso.CreateFolder( ZielVerz & "\" & Datumverzeichnis )
' Exit Function
' End If

for i = 0 to 99
If i < 1 then i = "0"
If i < 10 then i = "0" & CStr(i) ' zweistellig machen
If not i < 10 then i = "" & CStr(i) ' zweistellig lassen
if not fso.FolderExists( ZielVerz & "\" & Datumverzeichnis & "." & i ) then
Datumverzeichnis = ZielVerz & "\" & Datumverzeichnis & "." & i
fso.CreateFolder( Datumverzeichnis )
Exit Function
End If
next

End Function ' Datumverzeichnis ( ZielVerz )
' **************************************************************



' **************************************************************
Function RunBat ( BatTXT )
' **************************************************************
' erzeugt eine .BAT Datei mit 2x Pause und führt diese aus

' MsgBox BatTXT
TXT1 = "bsp.bat"
Set FileOut1 = fso.OpenTextFile( TXT1 , 2, true) ' Datei zum Erweitern öffnen (notfals anlegen)
FileOut1.WriteLine( "@echo off")
FileOut1.WriteLine( "@echo " & BatTXT )
FileOut1.WriteLine( "@" & BatTXT )
FileOut1.WriteLine( "@pause")
FileOut1.WriteLine( "@pause")
Set FileOut1 = nothing

WSHShell.run "%comspec% /c " & TXT1 , , True
End Function ' RunBat ( BatTXT )
' **************************************************************



' **************************************************************
Sub LogDatei (LogTxt)
' **************************************************************
Dim FileOut, fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set FileOut = fso.OpenTextFile( fso.GetBaseName( WScript.ScriptName ) & ".log", 8, true)
' fileOut.WriteLine (vbCRLF & Now() )
fileOut.WriteLine (LogTxt)
Set FileOut = Nothing
End Sub ' LogDatei
' **************************************************************



' **************************************************************
Sub PwdAbfrage
' **************************************************************
For i = 0 to oArgs.Count - 1 ' hole alle Argumente
Pwd = oArgs.item(i)
Exit For ' ein Argument reicht
Next

Text = "Die Dateien der Datensicherung werden " & vbCRLF & vbCRLF & UCase("mit einem Passwort geschützt.")
Text = Text & vbCRLF & vbCRLF & "Ist das so gewollt? <Yes> in 15sec."
' If not Pwd = "" then TXT = WshShell.Popup( Text, 15, WScript.ScriptName, 4096+4+32)

Text = "Die Dateien der Datensicherung werden " & vbCRLF & vbCRLF & UCase("nicht mit einem Passwort geschützt.")
Text = Text & vbCRLF & vbCRLF & "Ist das so gewollt? <Yes> in 15sec."
If Pwd = "" then TXT = WshShell.Popup( Text, 15, WScript.ScriptName, 4096+4+32)

Text = "Mit welchen Passwort sollen die Dateien der Datensicherung geschützt werden?"
Text = Text & vbCRLF & "Das Passwort darf ! KEINE ! Leerzeichen enthalten!"
If TXT = vbNo then Pwd = InputBox (Text, WScript.ScriptName)

End Sub ' PwdAbfrage
' **************************************************************



' **************************************************************
Sub LogDateiAnzeige
' **************************************************************

Dim FileOut, fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

WSHShell.run "notepad " & fso.GetBaseName( WScript.ScriptName ) & ".log"

On Error Resume Next
WScript.Sleep 500
WSHShell.SendKeys "^{End}" ' ans Ende springen

WScript.Sleep 500
WSHShell.SendKeys "{Up}" ' eine Zeile hoch

WScript.Sleep 500
WSHShell.SendKeys "+{Down}" ' mit gedrückter Shift-Taste eine Zeile nach unten
' markiert die letzte Zeile

' WScript.Sleep 20000
' WSHShell.SendKeys "%{F4}" ' schließt das aktuelle Fenster

On Error GoTo 0

WScript.Quit

End Sub ' LogDateiAnzeige
' **************************************************************



' **************************************************************
Function PopsUp ( TxT, Dauer ) ' Aufruf v3.7 - http://dieseyer.de
' **************************************************************
' ACHTUNG! Ausserhalb und ver 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-Anafng):
' Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP
' Set Prog_PP = nothing
'
' Die Vorversion hat (versucht) das PopUp über AppActivate
' zu schließen.

Set Fso_PP = CreateObject("Scripting.FileSystemObject")
' VBSDatei_PP = WSHShell.ExpandEnvironmentStrings("%Temp%") & "\" & Fso_PP.GetBaseName( WScript.ScriptName ) & "-MSG.VBS"
VBSDatei_PP = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%Temp%") & "\" & Fso_PP.GetBaseName( WScript.ScriptName ) & "-MSG.VBS"

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 MSG-VBScript
' On Error GoTo 0
Exit Function
End If

Txt = Replace( Txt, vbCRLF, """ & vbCRLF & """ )

Set FileOut_PP = Fso_PP.OpenTextFile(VBSDatei_PP, 2, true) ' MSG-VBScript öffnen mit neu anlegen
FileOut_PP.WriteLine "WScript.CreateObject(""WScript.Shell"").Popup """ & Txt & """ , " & Dauer & ", """ & Fso_PP.GetFileName( VBSDatei_PP ) & " "" "
FileOut_PP.Close
Set FileOut_PP = Nothing

Set Prog_PP = createObject("WScript.Shell").exec( "WScript " & VBSDatei_PP )

Set Fso_PP = Nothing

End Function ' PopsUp v3.7 - http://dieseyer.de
' **************************************************************

http://dieseyer.de • all rights reserved • © 2011 v11.4