http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v8.4 *** www.dieseyer.de *******************************
'
' Datei: vbsbeimsystemstart.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' (siehe auch "wmi-VBSalsService.vbs")
'
'
' Das Skript erwartet beim Aufruf einen PCNamen und einen
' Programmnamen (mein.vbs oder deine.cmd), auf dem der
' Dienst "1Service" erstellt werden soll, der das Programm
' beim Systemstart starten wird.
' Ist der entfernte PC erreichbar und sind die erforderlichen
' Rechte vorhanden, werden auf diesem
' - der Dienst "1Service" erstellt
' - das Skript 'VBSDienst' geschrieben
' - das Programm (in Variable 'VBSStart') dorthin kopiert
' - eine vorhandene Programmname-.INI-Datei wird auch kopiert
' (Fehlt 'VBSStart' wird als Demo eine VBS-Datei erstellt,
' die sich beim Dienststart meldet.)
' Das Skript erwartet beim Aufruf zwei Parameter: einen
' PC (-Namen) auf dem der Dienst "1Service" erstellt werden
' soll und ein Programm (-Name; z.B. 'mein.vbs' oder
' 'deine.cmd'), das beim Systemstart gestartet werden soll.
' Ist der entfernte PC erreichbar und sind die erforderlichen
' Rechte vorhanden, werden auf diesem
' - der Dienst "1Service" erstellt
' - das Skript 'VBSDienst1' geschrieben
' - das Skript 'VBSDienst' geschrieben
' - das Programm (in Variable 'VBSStart') dorthin kopiert
' - vorhandene Programmname.* - Datei(en) werden kopiert
' (Fehlt 'VBSStart' wird als Demo eine VBS-Datei erstellt,
' die sich beim Dienststart meldet.)
'
' Der Dienst "1Service" starte auf dem entfernten PC bei
' jedem Systemstart (vor einer Benutzeranmeldung) das Skript
' 'VBSDienst'. Dieses prüft, ob der Dienst "1Service"
' entfernt oder ob das Programm 'VBSStart' aufgerufen werden
' soll - diese Steuerung ist in 'VBSDienst' implementiert
' und vom Vorhandensein verschiedener Dateien abhängig:
' Der Dienst "1Service" startet das Skript 'VBSDienst1' auf
' dem entfernten PC (sofort und dann) bei jedem Systemstart
' vor einer Benutzeranmeldung - 'VBSDienst1' ruft 'VBSDienst'
' auf. Dieses prüft, ob der Dienst "1Service" entfernt oder
' ob das Programm 'VBSStart' aufgerufen werden soll - diese
' Steuerung ist in 'VBSDienst' implementiert und vom
' Vorhandensein verschiedener Dateien abhängig:
'
' - es existiert 'VBSStart' mit der Dateiendung (eXtension)
' ".no" (z.B. statt ".vbs"): 'VBSStart' wird nicht
' gestartet; der "1Service" bleibt erhalten.
'
' - es existiert 'VBSStart' mit der Dateiendung ".boot":
' statt 'VBSStart' wird der PC nach 3min neu gestartet;
' der "1Service" bleibt erhalten.
'
' - es existiert 'VBSStart' mit der Dateiendung ".end" oder
' - es fehlt das Skript 'VBSStart':
' Der Dienst "1Service" wird gelöscht bzw. entfernt.
'
' Z.B. wenn 'VBSStart' seine Aufgaben erfüllt hat, löscht
' es sich selbst und beim nächsten Systemstart wird der
' Dienst "1Service" von 'VBSDienst' entfernt. Oder wenn
' 'VBSStart' seine Aufgaben erfüllt hat, schreibt 'VBSStart'
' eine dieser Dateien; beim nächsten Systemstart . . .
'
' Da das Skript 'VBSDienst1' kein richtiger Dienst sein kann,
' wird es vom Dienstmanager nach 30s beendet - mit einem
' Fehlereintrag in der Ereignisanzeige.
' Dieses Skript ist eine Erweiterung bzw. Ablösung von
' "wmi-vbsalsservice.vbs" ab.
'
'************************************************************
Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl
Dim WSHNet : Set WSHNet = WScript.CreateObject("WScript.Network")
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim oArgs : Set oArgs = Wscript.Arguments
Const Dienst1 = "1Service" ' DienstName auf dem ZielPC
Const VBSDienst1 = "VBSdienst1.vbs" ' wird von 'Dienst1' gestartet
Const VBSDienst = "VBSdienst.vbs" ' wird von 'VBSDienst1' gestartet und startet 'VBSDienst'
Const VBSVerz = "DatenVerz" ' dieses Verz. wird auf den entfernten PC kopiert
Dim VBSStart ' das Skript / die Batch / das Programm, das vom Dienst gestartet werden soll
Dim ZielPC
Dim ZielVerz, ZielWinDir, ZielDatei, Txt, Tst
' MsgBox vbTab & "START", , "0097 :: " & WScript.ScriptName
' Parameter auswerten
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Es muss ein PCName als Parameter übergeben werden
If oArgs.Count = 0 Then
SkriptInfo( "0104 :: " ) ' Sub-Prozedur-Aufruf
WScript.Quit
End If
ZielPC = UCase( oArgs.item( 0 ) )
If oArgs.Count > 1 Then VBSStart = LCase( oArgs.item( 1 ) )
If Len( ZielPC ) > 15 Then
SkriptInfo( "Der PCName ist zu lang! " ) ' Sub-Prozedur-Aufruf
WScript.Quit
End If
' LOG-Datei-Namen festlegen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim LogDatei
LogDatei = ""
Trace32Log "Starte: """ & ZielPC & """ " , 1 ' LOG-Datei ist VBS-Name
' Dim aktVerz : aktVerz = WshShell.ExpandEnvironmentStrings("%WinDir%") & "\system32\CCM\Inst.LOG\"
Dim AktVerz : AktVerz = Replace( WScript.ScriptFullName, WScript.ScriptName, "" ) ' mit "\" am Ende!!!
If InStr( VBSStart, "\" ) > 1 Then AktVerz = Mid( VBSStart, 1, InStrRev( VBSStart, "\" ) )
LogDatei = WScript.ScriptFullName
LogDatei = Mid( LogDatei, 1, InStrRev( LogDatei, "." ) - 1 ) ' alles bis zum letzten Punkt
LogDatei = LogDatei & "_" & ZielPC & ".log" ' LogDatei enthält jetzt PCNamen
LogDatei = AktVerz & fso.GetBaseName( WScript.ScriptFullName )& "_" & ZielPC & ".log" ' LogDatei enthält jetzt PCNamen
' Trace32Log "-", 0 ' erstellt neue LogDatei (wegen 0)
Trace32Log " ", 1 ' fügt Leerzeile in LogDatei ein
Trace32Log "0136 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
Trace32Log "0137 :: LogDatei: " & LogDatei, 1
Trace32Log "0138 :: AktVerz: " & AktVerz, 1
Trace32Log "0139 :: PCname: " & WSHNet.ComputerName, 1
Trace32Log "0140 :: Angemeldeter User: " & WSHNet.UserName, 1
Trace32Log "0141 :: ZielPC: " & ZielPC, 1
' ZielPC erreichbar?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not WMIpingOK( ZielPC ) Then
Txt = "ZielPC """ & ZielPC & """ ist nicht erreichbar."
Trace32Log "0148 :: " & Txt, 2
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0149 :: " & WScript.ScriptName
Trace32Log "0150 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0152 :: " & "= = = E N D E = = ="
WScript.Quit
End If
Txt = "ZielPC ist per WMI-Ping erreichbar: " & ZielPC : Trace32Log "0155 :: " & Txt, 1 : ' WSHShell.Popup now() & vbCRLF & Txt, 5, "0155 :: " & "= = = E N D E = = ="
Call VerzZielPC ' prüft Verzeichnisse und erstellt ggf. welche
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call ZielSkripteErstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZielDatei = "wscript.exe " & ZielWinDir & "\Temp\dieseyer.de\" & VBSDienst1
Trace32Log "0168 :: Service auf """ & ZielPC & """ erstellen", 1
Trace32Log "0169 :: Service startet """ & ZielDatei & """ ", 1
'Call ServiceEntfernen( ZielPC, Dienst1 ) : WScript.Quit ' Für Tests
Call ServiceErstellen( ZielPC, Dienst1, Zieldatei )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call ServiceStarten( ZielPC, Dienst1 )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Call ServiceEntfernen( ZielPC, Dienst1 )
' wird 'eigentlich' vom entfernten PC selbst aufgerufen
' Prozedur wird in 'VBSDienst' eingefügt
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = "Dienst ""1Service"" wurde installiert und gestartet auf "
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & vbCRLF & vbTab & ZielPC, 7, "0186 :: " & WScript.ScriptName
Trace32Log "0188 :: " & Txt, 1
Trace32Log "0189 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
LogDatei = "" : Trace32Log "Abgearbeitet: """ & ZielPC & """ " , 1 ' LOG-Datei ist VBS-Name
WScript.Quit
'*********************************************************
Sub VerzZielPC()
'*********************************************************
' %WinDir% auf ZielPC ermitteln
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZielWinDir = RemoteWinDir( ZielPC )
' Trace32Log "0203 :: 'ZielWinDir': " & ZielWinDir, 1
If InStr( ZielWinDir, "FEHLER:" ) = 1 Then
Txt = "'ZielWinDir' auf """ & ZielPC & """ kann nicht ermittelt werden: " & ZielWinDir
Trace32Log "0206 :: " & Txt, 2
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0207 :: " & WScript.ScriptName
Trace32Log "0209 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0211 :: " & "= = = E N D E = = ="
WScript.Quit
End If
Trace32Log "0214 :: 'ZielWinDir' auf """ & ZielPC & """ ist " & ZielWinDir, 1
' Mit ZielPC verbinden
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZielVerz = ZielWinDir
'' Txt = "%WinDIR% des ZielPC ist: """ & ZielVerz & "\"" "
'' Trace32Log "0221 :: " & Txt, 1
'' Txt = Mid( ZielVerz, 3 )
ZielVerz = "\\" & ZielPC & "\" & Mid( ZielVerz, 1, 1 ) & "$" & Mid( ZielVerz, 3 )
If fso.FolderExists( ZielVerz ) Then
Else
Txt = "Verzeichnis ist nicht erreichbar: """ & ZielVerz & "\"" "
Trace32Log "0228 :: " & Txt, 2
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0229 :: " & WScript.ScriptName
Trace32Log "0230 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0232 :: " & "= = = E N D E = = ="
WScript.Quit
End If
Trace32Log "0235 :: Auf """ & ZielPC & """ erreichbar: " & ZielVerz, 1
' Auf ZielPC %WinDir%\Temp erstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZielVerz = ZielVerz & "\Temp"
If fso.FolderExists( ZielVerz ) Then
Trace32Log "0242 :: Verzeichnis existiert: """ & ZielVerz & "\"" " , 1
Else
Trace32Log "0244 :: Verzeichnis wird angelegt: " & ZielVerz & "\"" " , 1
On Error Resume Next
err.Clear
fso.CreateFolder ZielVerz
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then
Txt = "Verzeichnis kann nicht angelegt werden: """ & ZielVerz & "\"" "
Trace32Log "0252 :: " & Txt, 2
Trace32Log "0253 :: " & Tst, 3
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & Tst & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0254 :: " & WScript.ScriptName
Trace32Log "0255 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0257 :: " & "= = = E N D E = = ="
WScript.Quit
End If
End If
Trace32Log "0261 :: Auf """ & ZielPC & """ erreichbar: " & ZielVerz, 1
' Auf ZielPC %WinDir%\Temp\dieseyer.de erstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZielVerz = ZielVerz & "\dieseyer.de"
If fso.FolderExists( ZielVerz ) Then
Trace32Log "0268 :: Verzeichnis existiert: " & ZielVerz & "\"" " , 1
Else
Trace32Log "0270 :: Verzeichnis wird angelegt: " & ZielVerz & "\"" " , 1
On Error Resume Next
err.Clear
fso.CreateFolder ZielVerz
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then
Txt = "Verzeichnis kann nicht angelegt werden: """ & ZielVerz & "\"" "
Trace32Log "0278 :: " & Txt, 2
Trace32Log "0279 :: " & Tst, 3
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & Tst & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0280 :: " & WScript.ScriptName
Trace32Log "0281 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0283 :: " & "= = = E N D E = = ="
WScript.Quit
End If
End If
Trace32Log "0287 :: Auf """ & ZielPC & """ erreichbar: " & ZielVerz & "\"" ", 1
' Schreibtest auf ZielPC
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error Resume Next
err.Clear
fso.OpenTextFile( ZielVerz & "\dummy.tmp", 8, True ).WriteLine ( "TEST" )
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then
Txt = "In Verzeichnis kann nicht geschrieben werden: """ & ZielVerz & "\"" "
Trace32Log "0299 :: " & Txt, 2
Trace32Log "0300 :: " & Tst, 3
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & Tst & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0301 :: " & WScript.ScriptName
Trace32Log "0302 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0304 :: " & "= = = E N D E = = ="
WScript.Quit
End If
fso.DeleteFile ZielVerz & "\dummy.tmp", True
' Schreibtest auf ZielPC - Info-Datei erstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Tst = ZielVerz & "\" & Dienst1 & ".txt" ' : MsgBox Tst, , "0312 :: "
Call TempHilfeTxt( Tst )
End Sub ' VerzZielPC()
'*********************************************************
Sub ZielSkripteErstellen
'*********************************************************
Dim Tst, Txt, Tyt, VBSStartName
' Skript / Programm "VBSStart" auf ZielPC bereitstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Len( VBSStart ) = 0 Then
' wenn kein zu startendes Programm als Parameter an
' dieses Skipt übergeben wurde: VBS für Tests erstellen
VBSStart = "VBSStart.vbs" ' als Beispiel
' ZielDatei = ZielVerz & "\" & VBSStart
Trace32Log "0330 :: Soll erstellt werden: """ & ZielDatei & """ " , 1
Txt = "MsgBox now() & vbTab & "". . . . hier bin ich:"" & vbCRLF & vbCRLF & WScript.ScriptFullName, , WScript.ScriptName"
' fso.OpenTextFile( VBSDienst, 2, True ).Write( Txt ) ' für Tests, ins aktuelle Verz.
fso.OpenTextFile( ZielDatei, 2, True ).Write( Txt ) ' 2: löschen und neu erstellen
Trace32Log "0334 :: Ist erstellt: """ & ZielDatei & """ " , 1
End If
VBSStartName = VBSStart
Trace32Log "0338 :: : """ & VBSStartName & """ ", 1
If InStrRev( VBSStartName, "\" ) > 0 Then VBSStartName = Mid( VBSStartName, InStrRev( VBSStartName, "\" ) + 1 ) ' alles nch dem letzten "\"
Trace32Log "0340 :: : """ & VBSStartName & """ ", 1
VBSStartName = Mid( VBSStartName, 1, InStrRev( VBSStartName, "." ) - 1 ) ' alles vor dem letzten Punkt
Trace32Log "0342 :: VBSStartName: """ & VBSStartName & """ ", 1
' alte Dateien auf ZielPC löschen (u.a. *.end / *.no )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = ZielVerz & "\" & VBSStartName & ".*"
Trace32Log "0348 :: (Alte) Dateien sind zu löschen: """ & Txt, 1
On Error Resume Next
Tst = fso.DeleteFile( Txt ) ' : MsgBox "Gelöscht: " & Txt, , "0350 :: "
On Error Goto 0
' (Neue) Dateien auf ZielPC kopieren
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = VBSStart
Txt = Mid( Txt, 1, InStrRev( Txt, "." ) ) & "*" ' alles bis zum letzten Punkt und um ".*" erweitert
Tst = ZielWinDir & "\Temp\dieseyer.de\" & Mid( VBSStart, 1, InStrRev( VBSStart, "." ) )
Trace32Log "0358 :: Ist zu kopieren: """ & Txt & """ nach """ & ZielVerz & "\"" (" & Tst & ")", 1
Trace32Log "0359 :: Ist zu kopieren: """ & Txt & """ nach """ & ZielVerz & "\"" ", 1
Tst = fso.CopyFile( Txt, ZielVerz & "\" )
Trace32Log "0361 :: Kopiert: """ & Txt & """ nach """ & ZielVerz & "\"" (" & Tst & ")", 1
' Skript "VBSDienst1" auf ZielPC erstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 'nur' zum Start von "VBSDienst" erforderlich
ZielDatei = ZielVerz & "\" & VBSDienst1
Trace32Log "0368 :: Soll erstellt werden: """ & ZielDatei & """ " , 1
Txt = "WScript.CreateObject(""WScript.Shell"").Run """ & ZielWinDir & "\Temp\dieseyer.de\" & VBSDienst & """, , False "
' fso.OpenTextFile( VBSDienst1, 2, True ).Write( Txt ) ' für Tests, ins aktuelle Verz.
fso.OpenTextFile( ZielDatei, 2, True ).Write( Txt ) ' 2: löschen und neu erstellen
Trace32Log "0372 :: Ist erstellt: """ & ZielDatei & """ " , 1
' Skript "VBSDienst" auf ZielPC erstellen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' existiert 'VBSStart' ".no" => WScript.Quit; 'VBSStart' wird nicht gestartet
' existiert 'VBSStart' ".end" => "1Service" entfernen
' existiert 'VBSStart' ".boot" => es folgt "Shutdown -r -f -t 180" - Reboot in 3min
' fehlt 'VBSStart' => "1Service" entfernen
' existiert 'VBSStart' ".leer" => "1Service" entfernen; Dateien löschen
' existiert 'VBSDienst' ".leer" => "1Service" entfernen; Dateien löschen
If InStr( VBSStart, "\" ) > 1 Then VBSStart = Mid( VBSStart, InStrRev( VBSStart, "\" ) + 1 ) : Trace32Log "0384 :: Aus Variable ""VBSStart"" Pfadangabe entfernt / jetzt ohne ""\"" ", 1
Txt = "Set fso = WScript.CreateObject(""Scripting.FileSystemObject"")"
Txt = Txt & vbCRLF & " Trace32Log "" "", 1 "
Txt = Txt & vbCRLF & " Trace32Log ""0388 :: Start . . . "" & WScript.ScriptFullName, 1 "
Txt = Txt & vbCRLF
Tst = ZielWinDir & "\Temp\dieseyer.de\" & Mid( VBSStart, 1, InStrRev( VBSStart, "." ) )
Tst = ZielWinDir & "\Temp\dieseyer.de\" & VBSStartName
Tst = Tst & ".no"
Txt = Txt & vbCRLF & "If fso.FileExists( """ & Tst & """ ) Then"
Txt = Txt & vbCRLF & " Trace32Log ""0394 :: Existiert: " & Tst & """, 1 "
Txt = Txt & vbCRLF & " Trace32Log ""0395 :: Existiert: " & Tst & """, 2 "
Txt = Txt & vbCRLF & " Trace32Log ""0396 :: WScript.Quit folgt . . . "", 1 "
Txt = Txt & vbCRLF & " WScript.Quit"
Txt = Txt & vbCRLF & "End If"
Txt = Txt & vbCRLF & " Trace32Log ""0399 :: Fehlt: " & Tst & """, 1 "
Txt = Txt & vbCRLF
Tst = ZielWinDir & "\Temp\dieseyer.de\" & VBSStartName
Tst = Tst & ".end"
Txt = Txt & vbCRLF & "If fso.FileExists( """ & Tst & """ ) Then"
Txt = Txt & vbCRLF & " Trace32Log ""0404 :: Existiert: " & Tst & """, 1 "
Txt = Txt & vbCRLF & " Call ServiceEntfernen( ""."", """ & Dienst1 & """ ) "
Txt = Txt & vbCRLF & " Trace32Log ""0406 :: Beendet: ServiceEntfernen( """"."""", """"" & Dienst1 & """"" ) "", 1"
Txt = Txt & vbCRLF & " WScript.Quit "
Txt = Txt & vbCRLF & "End If"
Txt = Txt & vbCRLF & " Trace32Log ""0409 :: Fehlt: " & Tst & """, 1 "
Txt = Txt & vbCRLF
Tst = ZielWinDir & "\Temp\dieseyer.de\" & VBSStartName
Tst = Tst & ".boot"
Txt = Txt & vbCRLF & "If fso.FileExists( """ & Tst & """ ) Then"
Txt = Txt & vbCRLF & " Trace32Log ""0414 :: Existiert: " & Tst & """, 1 "
Txt = Txt & vbCRLF & " Trace32Log ""0415 :: Existiert: " & Tst & """, 2 "
Txt = Txt & vbCRLF & " Trace32Log ""0416 :: Reboot wird ausgelöst . . . "", 1 "
Txt = Txt & vbCRLF & " WScript.CreateObject(""WScript.Shell"").Run ""Shutdown -r -f -t 180 -c """"Shutdown wurde von '" & Dienst1 & "' ausgelöst."", , False "
Txt = Txt & vbCRLF & " Trace32Log ""0418 :: Reboot ist angefordert . . . "", 1 "
Txt = Txt & vbCRLF & " WScript.Quit"
Txt = Txt & vbCRLF & "End If"
Txt = Txt & vbCRLF & " Trace32Log ""0421 :: Fehlt: " & Tst & """, 1 "
Txt = Txt & vbCRLF
Tst = ZielWinDir & "\Temp\dieseyer.de\" & VBSStart
Tst = ZielWinDir & "\Temp\dieseyer.de\" & Mid( VBSStart, InStrRev( VBSStart, "\" ) + 1 )
Txt = Txt & vbCRLF & "If not fso.FileExists( """ & Tst & """ ) Then"
Txt = Txt & vbCRLF & " Trace32Log ""0426 :: Fehlt: " & Tst & """, 1 "
Txt = Txt & vbCRLF & " Call ServiceEntfernen( ""."", """ & Dienst1 & """ ) "
Txt = Txt & vbCRLF & " Trace32Log ""0428 :: Beendet: ServiceEntfernen( """"."""", """"" & Dienst1 & """"" ) "", 1"
Txt = Txt & vbCRLF & " WScript.Quit "
Txt = Txt & vbCRLF & "End If"
Txt = Txt & vbCRLF
Txt = Txt & vbCRLF & " Trace32Log ""0432 :: Existiert: " & Tst & """, 1 "
Txt = Txt & vbCRLF
Txt = Txt & vbCRLF & " Trace32Log ""0434 :: Wird gestartet: " & Tst & """, 1 "
Txt = Txt & vbCRLF & "WScript.CreateObject(""WScript.Shell"").Run """ & Tst & """, , False "
Txt = Txt & vbCRLF & " Trace32Log ""0436 :: Wurde gestartet: " & Tst & """, 1 "
Txt = Txt & vbCRLF
Txt = Txt & vbCRLF & " Trace32Log ""0438 :: Ende . . . "", 1 "
Txt = Txt & vbCRLF & "WScript.Quit"
Txt = Txt & vbCRLF
Txt = Txt & vbCRLF & ProzedurInTxt( "Trace32Log" )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = Txt & vbCRLF & ProzedurInTxt( "ServiceEntfernen" )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = Txt & vbCRLF
ZielDatei = ZielVerz & "\" & VBSDienst
Trace32Log "0448 :: Soll erstellt werden: """ & ZielDatei & """ " , 1
' fso.OpenTextFile( VBSDienst, 2, True ).Write( Txt ) ' für Tests, ins aktuelle Verz.
fso.OpenTextFile( ZielDatei, 2, True ).Write( Txt ) ' 2: löschen und neu erstellen
Trace32Log "0452 :: Ist erstellt: """ & ZielDatei & """ " , 1
End Sub ' ZielSkripteErstellen
'*********************************************************
Sub ServiceErstellen( PC, Dienst, Progr )
'*********************************************************
' http://msdn.microsoft.com/library/en-us/wmisdk/wmi/create_method_in_class_win32_baseservice.asp
Trace32Log "0463 :: START: Sub ServiceErstellen( """ & PC & """, """ & Dienst & """, """ & Progr & """ )", 1
Const INTERACTIVE_YES = True
Const INTERACTIVE_NOT = False
Dim objWMIService, colServices, objService
Dim Txt
' Test, ob Dienst existiert
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = ""
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=Impersonate}!\\" & PC & "\root\cimv2")
Set colServices = objWMIService.ExecQuery ("Select * From Win32_Service" )
For Each objService in colServices
If objService.DisplayName = Dienst Then Txt = """" & objService.DisplayName & """ (" & objService.State & ") existiert bereits, muss also nicht erstellt werden."
Next
Set objWMIService = nothing
Set colServices = nothing
' If Len( Txt ) > 5 Then MsgBox now() & vbCRLF & Txt & " existiert bereits.", , "0482 :: " & WScript.ScriptName
If Len( Txt ) > 5 Then Trace32Log "0483 :: " & Txt, 1
If Len( Txt ) > 5 Then Exit Sub
' Dienst installieren
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' "Create Method of the Win32_BaseService Class": http://msdn2.microsoft.com/en-us/library/aa389386(VS.85).aspx
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=Impersonate}!\\" & PC & "\root\cimv2")
Set objService = objWMIService.Get("Win32_BaseService")
Txt = objService.Create( Dienst, Dienst, Progr, 16, 0, "Automatic", INTERACTIVE_YES )
' ServiceType - 16 - 0x10 - Own Process
' ServiceType - 32 - 0x20 - Share Process
' ErrorControl - 0 - "Ignore", User is not notified.
' ErrorControl - 1 - "Normal", User is notified.
' StartMode - "Boot", Device driver started by the operating system loader. This value is valid only for driver services.
' StartMode - "System", Device driver started by the operating system initialization process. This value is valid only for driver services.
' StartMode - "Automatic", Service to be started automatically by the service control manager during system startup.
' StartMode - "Manual", Service to be started by the service control manager when a process calls the StartService method.
' StartMode - "Disabled", Service that can no longer be started.
' DesktopInteract - "True", the service can create or communicate with windows on the desktop.
' StartName - Account name under which the service runs. Depending on the service type, the account name may be in the form of DomainName\Username. The service process is logged using one of these two forms when it runs. If the account belongs to the built-in domain, .\Username can be specified. If NULL is specified, the service is logged on as the LocalSystem account. For a kernel or system-level drivers, StartName contains the driver object name (that is, \FileSystem\Rdr or \Driver\Xns) that the input and output (I/O) system uses to load the device driver. If NULL is specified, the driver runs with a default object name created by the I/O system based on the service name. Example: DWDOM\Admin.
' StartPassword - Password to the account name specified by the StartName parameter. Specify NULL if you are not changing the password. Specify an empty string if the service has no password.
' LoadOrderGroup - Group name associated with the new service. Load order groups . . . HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\ServiceGroupOrder
' LoadOrderGroupDependencies - Array of load-ordering groups that must start before this service . . .
' ServiceDependencies - Array that contains names of services that must start before this service starts . . .
' Return Codes; RC
' 0 - The request was accepted.
' 1 - The request is not supported.
' 2 - The user did not have the necessary access.
' 3 - The service cannot be stopped because other services that are running are dependent on it.
' 4 - The requested control code is not valid, or it is unacceptable to the service.
' 5 - The requested control code cannot be sent to the service because the state of the service (Win32_BaseService State property) is equal to 0, 1, or 2.
' 6 - The service has not been started.
' 7 - The service did not respond to the start request in a timely fashion.
' 8 - Interactive process.
' 9 - The directory path to the service executable file was not found.
' 10 - The service is already running.
' 11 - The database to add a new service is locked.
' 12 - A dependency on which this service relies has been removed from the system.
' 13 - The service failed to find the service needed from a dependent service.
' 14 - The service has been disabled from the system.
' 15 - The service does not have the correct authentication to run on the system.
' 16 - This service is being removed from the system.
' 17 - There is no execution thread for the service.
' 18 - There are circular dependencies when starting the service.
' 19 - There is a service running under the same name.
' 20 - There are invalid characters in the name of the service.
' 21 - Invalid parameters have been passed to the service.
' 22 - The account which this service is to run under is either invalid or lacks the permissions to run the service.
' 23 - The service exists in the database of services available from the system.
' 24 - The service is currently paused in the system.
' MsgBox now() & vbCRLF & "Der Dienst """ & Dienst & """ wurde erstellt: RC=" & Txt, , "0534 :: " & WScript.ScriptName
Trace32Log "0535 :: Der Dienst """ & Dienst & """ wurde erstellt: RC=" & Txt, 1
Set objWMIService = nothing
Set colServices = nothing
WScript.Sleep 15*1000
' Test, ob Dienst existiert
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = ""
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=Impersonate}!\\" & PC & "\root\cimv2")
Set colServices = objWMIService.ExecQuery ("Select * From Win32_Service" )
For Each objService in colServices
If objService.DisplayName = Dienst Then Txt = """" & objService.DisplayName & """ (" & objService.State & ") existiert."
Next
Set objWMIService = nothing
Set colServices = nothing
' If Len( Txt ) > 5 Then MsgBox now() & vbCRLF & Txt & " existiert.", , "0552 :: " & WScript.ScriptName
If Len( Txt ) > 5 Then Trace32Log "0553 :: " & Txt, 1
If Len( Txt ) > 5 Then Exit Sub
Txt = "FEHLER: Der Dienst """ & Dienst & """ konnte auf """ & PC & """ nicht erstellt werden. (" & Txt & ")"
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0557 :: " & WScript.ScriptName
Trace32Log "0558 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0560 :: " & "= = = E N D E = = ="
WScript.Quit
End Sub ' ServiceErstellen( PC, Dienst, Progr )
'*********************************************************
Sub ServiceEntfernen( PC, Dienst )
'*********************************************************
Trace32Log "0570 :: START: Sub ServiceEntfernen( """ & PC & """, """ & Dienst & """ )", 1
Dim objWMIService, colServices, objService
Dim Txt
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & PC & "\root\cimv2")
Set colServices = objWMIService.ExecQuery ("SELECT * FROM Win32_Service WHERE Name = '" & Dienst & "'")
For Each objService in colServices
objService.StopService() : Trace32Log "0578 :: Stopanforderung . . . ", 1
WScript.Sleep 3*1000
objService.Delete() : Trace32Log "0580 :: Löschanforderung . . . ", 1
Next
Set objWMIService = nothing
Set colServices = nothing
Txt = ""
' Test, ob Dienst vorhanden ist
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=Impersonate}!\\" & PC & "\root\cimv2")
Set colServices = objWMIService.ExecQuery ("Select * From Win32_Service" )
For Each objService in colServices
If objService.DisplayName = Dienst Then Txt = """" & objService.DisplayName & """ (" & objService.State & ")"
Next
Txt = "Der Dienst """ & Dienst & """ wurde von """ & PC & """ entfernt."
' If Len( Txt ) > 5 Then MsgBox now() & vbCRLF & Txt , , "0594 :: " & WScript.ScriptName
If Len( Txt ) > 5 Then Trace32Log "0595 :: " & Txt, 1
If Len( Txt ) > 5 Then Exit Sub
Txt = "FEHLER: Der Dienst """ & Dienst & """ konnte nicht von """ & PC & """ entfernt werden."
WSHShell.Popup vbTab & "= = = E N D E = = =" & vbCRLF & vbCRLF & Txt & vbCRLF & vbCRLF & vbTab & ZielPC, 17, "0599 :: " & WScript.ScriptName
Trace32Log "0600 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 3
LogDatei = "" : Trace32Log "Ende: """ & ZielPC & """ - " & Txt, 3 ' LOG-Datei ist VBS-Name
MsgBox now() & vbCRLF & Txt, , "0602 :: " & "= = = E N D E = = ="
WScript.Quit
End Sub ' ServiceEntfernen
'*** v8.3 *** www.dieseyer.de *******************************
Function ServiceStarten( PC, Dienst )
'************************************************************
' Dienst ist der im Dienstmanager angezeigte Dienstname
Dim objWMIService, colListOfServices, objService, colServices
Dim Tst, VielStat
On Error Resume Next : VielStat = VielLog : On Error Goto 0 ' Wenn "VielLog" nicht definiert ist, gibts wenige LOG-Einträge
VielStat = "JA"
ServiceStarten = ""
If VielStat = "JA" Then Trace32Log " ", 1
If VielStat = "JA" Then Trace32Log "--- Start: Function ServiceStarten( """ & Dienst & """ )", 1
If VielStat = "JA" Then Trace32Log "0620 :: von """ & Dienst & """ wird der 'richtige' Name ermittelt . . .", 1
' "richtigen" (Dienst-) Namen suchen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & PC & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery ("Select * From Win32_Service")
Tst = "-OK"
For Each objService in colListOfServices
If InStr( UCase( objService.Name) , UCase( Dienst ) ) = 1 Then If VielStat = "JA" Then Trace32Log "0629 :: " & Dienst & " hat schon den richtigen Namen.", 1
If InStr( UCase( objService.Name) , UCase( Dienst ) ) = 1 Then Dienst = objService.Name : Tst = "OK" : Exit For
If InStr( UCase( objService.DisplayName), UCase( Dienst ) ) = 1 Then If VielStat = "JA" Then Trace32Log "0631 :: " & Dienst & " heisst 'richtig': " & objService.Name, 1
If InStr( UCase( objService.DisplayName), UCase( Dienst ) ) = 1 Then Dienst = objService.Name : Tst = "OK" : Exit For
Next
If not Tst = "OK" Then
ServiceStarten = """" & Dienst & """ existiert nicht."
Trace32Log "0636 :: """ & Dienst & """ existiert nicht - kann also nicht gestartet werden.", 1
If VielStat = "JA" Then Trace32Log "0637 :: Vorzeitiges Ende ""Function ServiceStarten( Dienst )"" ", 1
Exit Function
End If
If VielStat = "JA" Then Trace32Log "0640 :: ==> """ & Dienst & """ soll gestartet werden. . .", 1
' "richtigen" Dienst (-Namen) testen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & PC & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery ("SELECT * FROM Win32_Service WHERE Name = '" & Dienst & "'")
For Each objService in colListOfServices
ServiceStarten = " """ & objService.Name & """ steht auf: " & objService.StartMode & " (" & objService.State & ")": Exit For
Next
Set objWMIService = nothing
Set colListOfServices = nothing
If VielStat = "JA" Then Trace32Log "0652 :: " & ServiceStarten, 1
' "richtigen" (Dienst-) Namen starten
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=Impersonate}!\\" & PC & "\root\cimv2")
Set colServices = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & Dienst & "'")
For Each objService in colServices
ServiceStarten = objService.StartService()
Next
Set objWMIService = nothing
Set colServices = Nothing
Tst = ServiceStarten ' Wenn ServiceStarten Text enthält, gibt es bei "If Tst = 14 Then" einen Fehler
If Tst = 0 Then ServiceStarten = ServiceStarten & ": Dienst erfolgreich gestartet."
If Tst = 7 Then ServiceStarten = ServiceStarten & ": ""Zeitüberschreitung (30s?) beim Startversuch."""
If Tst = 8 Then ServiceStarten = ServiceStarten & ": Für den Start einer VBS durch einen Dienst muss ""wscript.exe"" vor dem Skript stehen!"
If Tst = 10 Then ServiceStarten = ServiceStarten & ": Dienst war bereits gestartet."
If Tst = 14 Then ServiceStarten = ServiceStarten & ": Deaktivierter Dienst wurde nicht gestartet."
If VielStat = "JA" Then Trace32Log "0670 :: " & ServiceStarten, 1
' "richtigen" Dienst (-Namen) testen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & PC & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery ("SELECT * FROM Win32_Service WHERE Name = '" & Dienst & "'")
For Each objService in colListOfServices
ServiceStarten = " """ & objService.Name & """ steht auf: " & objService.StartMode & " (" & objService.State & ")": Exit For
Next
Set objWMIService = nothing
Set colListOfServices = nothing
Trace32Log "0682 :: " & ServiceStarten, 1
If VielStat = "JA" Then Trace32Log "--- Ende: Function ServiceStarten( Dienst )", 1
End Function ' ServiceStarten( Dienst )
'*** v8.3 *** www.dieseyer.de *******************************
Sub SkriptInfo( Ttt )
'************************************************************
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim Txt, Tst
Txt = ""
Txt = Txt & "Das ganze funktioniert so:" & vbCRLF & vbCRLF
Txt = Txt & "Das Skript muss beim Aufruf als Parameter einen PCNamen erhalten -" & vbCRLF
Txt = Txt & "z.B. aus einer CMD-Datei heraus, die nur folgende Zeile enthält:" & vbCRLF
Txt = Txt & """vbsbeimsystemstart.vbs PC001""" & vbCRLF & vbCRLF
Txt = Txt & "[Ok]" & vbTab & vbTab & "Weitere Infos (als Hilfe) ansehen." & vbCRLF
Txt = Txt & "[Abbrechen]" & vbTab & "Bei ""Aaaaaaaangst""." & vbCRLF
If InStr( Ttt, " :" & ": " ) = 0 Then Txt = "FEHLER: """ & Ttt & """ " & vbCRLF & vbCRLF & Txt : Ttt = ""
Txt = WSHShell.Popup (Txt , 30, Ttt & WScript.ScriptName, 4096 + 512 + 32 + 1 )
If vbOK = Txt Then
Call TempHilfeHta ' Sub-Prozedur - Aufruf
WSHShell.Popup WScript.ScriptFullName & vbCRLF & vbCRLF & "hat nichts getan und beendet sich jetzt.", 13, "0808 :: " & WScript.ScriptName, 48 + 4096
WScript.Quit
End If
WSHShell.Popup " . . . dann eben nicht!", 10, "0812 :: " & WScript.ScriptName & " . . . ist zu Ende.", 48 + 4096
WScript.Quit
End Sub ' SkriptInfo( Ttt )
'*** v8.3 *** www.dieseyer.de *******************************
Sub TempHilfeHta
'************************************************************
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim TmpDatei : TmpDatei = fso.GetSpecialFolder( 2 ) & "\" & fso.GetTempName
Dim FileOut, FileIn, Txt, Tst
' TmpDatei als htm-Datei
TmpDatei = Mid( TmpDatei, 1, InStrRev( TmpDatei, "." ) ) & "htm"
' TmpDatei als hta-Datei
TmpDatei = Mid( TmpDatei, 1, InStrRev( TmpDatei, "." ) ) & "hta"
' MsgBox vbTab & "TmpDatei: " & vbCRLF & vbCRLF & TmpDatei, , "0833 :: " & WScript.ScriptName
Txt = ""
' Txt = Txt & vbTab & "0836 :: """ & WScript.ScriptFullName & """, letzte " & vbCRLF
' Txt = Txt & vbTab & "0837 :: " & "Änderung vom " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & ", enthält" & vbCRLF
' Txt = Txt & vbTab & "0838 :: " & "folgende Infos:" & vbCRLF & vbCRLF
Set FileIn = fso.OpenTextFile( WScript.ScriptFullName, 1 )
Do While Not ( FileIn.atEndOfStream )
Tst = FileIn.Readline
Txt = Txt & Mid( Tst, 2 ) & vbCRLF ' entfernt das führende ' (Hochkomma)
If InStr( Tst, "'**********" ) = 1 Then Exit Do
If InStr( Tst, "' **********" ) = 1 Then Exit Do
Loop
Tst = "<head>"
Tst = Tst & vbCRLF & "<title>Info zu """ & WScript.Scriptname & """</title>"
Tst = Tst & vbCRLF & "< HTA:APPLICATION ID=""" & WScript.Scriptname & """ "
' Mein Virenscanner meckert, wenn sich im VBS in "< HT" kein Leerzeichen befindet
Tst = Replace( Tst, "< HT", "<HT" )
Tst = Tst & vbCRLF & "SCROLL=""yes"" "
Tst = Tst & vbCRLF & "SHOWINTASKBAR=""yes"" "
Tst = Tst & vbCRLF & "NAVIGABLE=""yes"" "
Tst = Tst & vbCRLF & "APPLICATIONNAME=""" & WScript.Scriptname & """ >"
Tst = Tst & vbCRLF & "</head><body>"
Tst = Tst & vbCRLF & "</head><body><pre>" ' <pre> sorgt dafür, dass KEINE Proportionalschrift verwendet wird
Txt = Tst & vbCRLF & Txt & vbCRLF & "</pre></head><body>"
Set FileOut = fso.OpenTextFile( TmpDatei, 2, True)
FileOut.Write( Txt )
FileOut.Close
Set FileOut = Nothing
' WSHShell.Run "mshta.exe " & TmpDatei
' WSHShell.Run """" & TmpDatei & """"
WSHShell.Run TmpDatei, , True
' Bei der Anzeige einer HTM(L)-Datei im Browser kann nicht auf
' das Ende der Anwendung / Anzeige gewartet werden - also darf
' auch die Datei, die gerade angezeigt wird, nicht gelöscht
' werden.
' Bei einer HTA-Datei ist das anders . . .
fso.DeleteFile TmpDatei, True
End Sub ' TempHilfeHta
'*** v8.4 *** www.dieseyer.de *******************************
Sub TempHilfeTxt( TxtDatei )
'************************************************************
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim TmpDatei : TmpDatei = fso.GetSpecialFolder( 2 ) & "\" & fso.GetTempName
Dim FileOut, FileIn, Txt, Tst
' TmpDatei als Txt-Datei
TmpDatei = Mid( TmpDatei, 1, InStrRev( TmpDatei, "." ) ) & "txt"
TmpDatei = TxtDatei
' MsgBox vbTab & "TmpDatei: " & vbCRLF & vbCRLF & TmpDatei, , "0897 :: " & WScript.ScriptName
Txt = ""
' Txt = Txt & vbTab & "0900 :: """ & WScript.ScriptFullName & """, letzte " & vbCRLF
' Txt = Txt & vbTab & "0901 :: " & "Änderung vom " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & ", enthält" & vbCRLF
' Txt = Txt & vbTab & "0902 :: " & "folgende Infos:" & vbCRLF & vbCRLF
Set FileIn = fso.OpenTextFile( WScript.ScriptFullName, 1 )
Do While Not ( FileIn.atEndOfStream )
Tst = FileIn.Readline
Txt = Txt & Mid( Tst, 2 ) & vbCRLF ' entfernt das führende ' (Hochkomma)
If InStr( Tst, "'**********" ) = 1 Then Exit Do
If InStr( Tst, "' **********" ) = 1 Then Exit Do
Loop
Set FileOut = fso.OpenTextFile( TmpDatei, 2, True)
FileOut.Write( Txt )
FileOut.Close
Set FileOut = Nothing
' WSHShell.Run TmpDatei, , True
' fso.DeleteFile TmpDatei, True
End Sub ' TempHilfeTxt( TxtDatei )
'*** v6.2 *** www.dieseyer.de *******************************
Function WMIpingOK( PCName ) ' 6.2 - http://dieseyer.de
'************************************************************
' Aufruf z.B.: If not WMIpingOK( ZielPC ) Then MsgBox ZielPC & " ist nicht erreichbar." : WScript.Quit
Dim objPing, objStatus
WMIpingOK = True
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & PCName & "'")
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
' WScript.Echo("PCName " & PCName & " is not reachable")
WMIpingOK = False
End If
Next
Set objPing = Nothing
End Function ' WMIpingOK( PCName ) ' 6.2 - http://dieseyer.de
'*** v10.3 *** www.dieseyer.de *****************************
Function RemoteWinDir( PCName )
'***********************************************************
' http://msdn2.microsoft.com/en-us/library/aa394596(vs.85).aspx
' ermittelt %WINDIR% == %SYSTEMROOT%; häufig C:\Windows
Dim objWMIService, colOperatingSystems, objOperatingSystem, Tst
Dim WindowsDirectory, SystemDirectory
On Error Resume Next
err.Clear
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PCName & "\root\cimv2")
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then : RemoteWinDir = "Fehler: WMI-Sys " & Tst : Exit Function
On Error Resume Next
err.Clear
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then : RemoteWinDir = "Fehler: WMI-SysOS " & Tst : Exit Function
On Error Resume Next
err.Clear
For Each objOperatingSystem in colOperatingSystems
Tst = err.Number & " - " & err.Description
On Error Goto 0
If Len( Tst ) > 4 Then : RemoteWinDir = "Fehler: WMI-SysDir " & Tst : Exit Function
WindowsDirectory = objOperatingSystem.WindowsDirectory
SystemDirectory = objOperatingSystem.SystemDirectory
Next
Set colOperatingSystems = nothing
Set objWMIService = nothing
If WindowsDirectory = "" Then
SystemDirectory = UCase( SystemDirectory )
If InStr( SystemDirectory, "\SYSTEM32" ) Then WindowsDirectory = Replace( SystemDirectory, "\SYSTEM32", "" )
End If
RemoteWinDir = WindowsDirectory
' RemoteWinDir = "%..root%: " & RemoteWinDir
End Function ' RemoteWinDir( PCName )
'*** v8.4 *** www.dieseyer.de ****************************
Function ProzedurInTxt( ProzName )
'*********************************************************
' Übergibt (aus dem aktuellen VBS) den Inhalt einer Prozedur
ProzName = LCase( ProzName )
Dim i
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim Txt, Tst, Tyt, ZeileAkt, ProzOK
ProzOK = "-OK"
Txt = "'*********************************************************"
Dim FileIn : Set FileIn = fso.OpenTextFile( WScript.ScriptFullName, 1 )
Do While Not ( FileIn.atEndOfStream )
ZeileAkt = FileIn.Readline
Tst = LCase( ZeileAkt )
If ProzOK = "-OK" Then
Tyt = InStr( Tst, "function " & ProzName ) : If Tyt > 0 AND Tyt < 4 Then ProzOK = "OK"
Tyt = InStr( Tst, "sub " & ProzName ) : If Tyt > 0 AND Tyt < 4 Then ProzOK = "OK"
End If
If ProzOK = "OK" Then Txt = Txt & vbCRLF & ZeileAkt ' : MsgBox now() & vbCRLF & Txt, , "0989 :: " : i = i + 1 : If i > 10 Then WScript.Quit
If ProzOK = "OK" AND InStr( Tst, "end function" ) > 0 Then Exit Do
If ProzOK = "OK" AND InStr( Tst, "end sub" ) > 0 Then Exit Do
Loop
FileIn.Close : Set FileIn = nothing
Txt = Txt & vbCRLF & "'*********************************************************"
ProzedurInTxt = Txt ' : MsgBox now() & vbCRLF & ProzedurInTxt, , "1000 :: "
End Function ' ProzedurInTxt( ProzName )
'*** v8.4 *** www.dieseyer.de *******************************
Sub TempHilfeTxt( TxtDatei )
'************************************************************
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim TmpDatei : TmpDatei = fso.GetSpecialFolder( 2 ) & "\" & fso.GetTempName
Dim FileOut, FileIn, Txt, Tst
' TmpDatei als Txt-Datei
TmpDatei = Mid( TmpDatei, 1, InStrRev( TmpDatei, "." ) ) & "txt"
TmpDatei = TxtDatei
' MsgBox vbTab & "TmpDatei: " & vbCRLF & vbCRLF & TmpDatei, , "1019 :: " & WScript.ScriptName
Txt = ""
' Txt = Txt & vbTab & "1022 :: """ & WScript.ScriptFullName & """, letzte " & vbCRLF
' Txt = Txt & vbTab & "1023 :: " & "Änderung vom " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & ", enthält" & vbCRLF
' Txt = Txt & vbTab & "1024 :: " & "folgende Infos:" & vbCRLF & vbCRLF
Set FileIn = fso.OpenTextFile( WScript.ScriptFullName, 1 )
Do While Not ( FileIn.atEndOfStream )
Tst = FileIn.Readline
Txt = Txt & Mid( Tst, 2 ) & vbCRLF ' entfernt das führende ' (Hochkomma)
If InStr( Tst, "'**********" ) = 1 Then Exit Do
If InStr( Tst, "' **********" ) = 1 Then Exit Do
Loop
Set FileOut = fso.OpenTextFile( TmpDatei, 2, True)
FileOut.Write( Txt )
FileOut.Close
Set FileOut = Nothing
' WSHShell.Run TmpDatei, , True
' fso.DeleteFile TmpDatei, True
End Sub ' TempHilfeTxt( TxtDatei )
'*** v9.C *** www.dieseyer.de ******************************
Sub Trace32Log( LogTxt, ErrType )
'***********************************************************
' in VBS und HTA verwendbar
' Aufbau einer LOG-Datei für trace32.exe ( SMS Trace;
' ALLES in einer Zeile!):
' <![LOG[...]LOG]!>
' <
' time="08:12:54.309+-60"
' date="03-14-2008"
' component="SrcUpdateMgr"
' context=""
' type="0"
' thread="1812"
' file="productpackage.cpp:97"
' >
'
' "context=" Info wird nicht angezeigt
' type="0" normale Zeie => NEUE LOG-DATEI - ggf. alte überschreiben !!!!!!!!!!!!
' type="1" normale Zeie
' type="2" gelbe Zeie
' type="3" rote Zeie
' type="F" rote Zeie
' "thread=" kann eine Dezimalzahl aufnehmen; trace32 zeigt
' neben der Dezimalzahl in Klammern die entspr.
' Hexadezimalzahl an - z.B. "33 (0x21)"
' "file=" wird in "Source:" angezeigt
'
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim LogDateiX, TitelX, Tst, Nr
On Error Resume Next
Tst = KeineLog
On Error Goto 0
If UCase( Tst ) = "JA" Then Exit Sub
On Error Resume Next
TitelX = Titel ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
TitelX = title ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
If Len( TitelX ) < 2 Then TitelX = document.title ' .hta
If Len( TitelX ) < 2 Then TitelX = WScript.ScriptName ' .vbs
On Error Goto 0
On Error Resume Next
LogDateiX = LogDatei ' wurde die Variable 'LogDatei' nicht außerhalb der Prozedur definiert
If Len( LogDateiX ) < 2 Then LogDateiX = WScript.ScriptFullName & ".log" ' .vbs
If Len( LogDateiX ) < 2 Then LogDateiX = TitelX & ".log" ' .hta
On Error Goto 0
Nr = 0 ' Wenn in Thread die Zeilennummer stehen soll:
Nr = 999999
If Nr = 0 AND InStr( LogTxt, " :" & ": " ) > 0 Then
' Wenn in Thread die Zeilennummer stehen soll - Voraussetzung
' ist eine ZeilenNr. im Format '22 :: '
Nr = LogTxt
Nr = Mid( Nr, 1, InStrRev( Nr, " :" & ": " ) -1 ) ' nach der Zeilennummer
Nr = Mid( Nr, InStrRev( Nr, " " ) + 1 ) ' vor der Zeilennummer
On Error Resume Next : Tst = Int( Nr ) : On Error Goto 0 ' Zeilennummer als (Integer) Zahl
Do ' Tst für Vergleich auf gleiche Länge wie Nr anpassen
If Len( Tst ) = Len( Nr ) Then Exit Do
Tst = "0" & Tst
Loop
If "x" & Tst = "x" & Nr Then
LogTxt = Replace( LogTxt, Tst & " :" & ": ", "" )
Nr = Int( Nr )
End If
End If
If Nr = 999999 Then Nr = 0
' Zwei Nachkommastellen (nach Sekunden) der aktuellen Zeit
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Tst = Timer() ' timer() in USA: 1234.22
Tst = Replace( Tst, "," , ".") ' timer() in Deutschland: 123454,12
If InStr( Tst, "." ) = 0 Then Tst = Tst & ".000"
Tst = Mid( Tst, InStr( Tst, "." ), 4 )
If Len( Tst ) < 3 Then Tst = Tst & "0"
' Zeitzone ermitteln - neu (v9.C) und immer richtig(er)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim AktDMTF : Set AktDMTF = CreateObject("WbemScripting.SWbemDateTime")
AktDMTF.SetVarDate Now(), True : Tst = Tst & Mid( AktDMTF, 22 ) ' : MsgBox Tst, , "205 :: "
' MsgBox "AktDMTF: '" & AktDMTF & "'", , "206 :: "
Set AktDMTF = nothing
LogTxt = "<![LOG[" & LogTxt & "]LOG]!>"
LogTxt = LogTxt & "<"
LogTxt = LogTxt & "time=""" & Hour( Time() ) & ":" & Minute( Time() ) & ":" & Second( Time() ) & Tst & """ "
LogTxt = LogTxt & "date=""" & Month( Date() ) & "-" & Day( Date() ) & "-" & Year( Date() ) & """ "
LogTxt = LogTxt & "component=""" & TitelX & """ "
LogTxt = LogTxt & "context="""" "
LogTxt = LogTxt & "type=""" & ErrType & """ "
LogTxt = LogTxt & "thread=""" & Nr & """ "
LogTxt = LogTxt & "file=""dieseyer.de"" "
LogTxt = LogTxt & ">"
Tst = 8 ' LOG-Datei erweitern
If ErrType = 0 Then Tst = 2 ' LOG-Datei erneuern (alte löschen, neue erstellen)
On Error Resume Next
If LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
If not LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
On Error Goto 0
Set fso = Nothing
End Sub ' Trace32Log( LogTxt, ErrType )
http://dieseyer.de • all rights reserved • © 2011 v11.4