'*** 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 = "" Tst = Tst & vbCRLF & "Info zu """ & WScript.Scriptname & """" Tst = Tst & vbCRLF & "< HTA:APPLICATION ID=""" & WScript.Scriptname & """ " ' Mein Virenscanner meckert, wenn sich im VBS in "< HT" kein Leerzeichen befindet Tst = Replace( Tst, "< HT", "" Tst = Tst & vbCRLF & "" Tst = Tst & vbCRLF & "
" ' 
 sorgt dafür, dass KEINE Proportionalschrift verwendet wird

  Txt = Tst & vbCRLF & Txt & vbCRLF & "
" 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!): ' ' < ' 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 = "" 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 )