'*** v?.? *** www.dieseyer.de ******************************* ' ' Datei: AAAAA.vbs ' Autor: dieseyer@gmx.de ' Auf: www.dieseyer.de ' ' '*********************************************************** Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl Dim VBSmodTime ' für die Prozedur "Sub VBSneustart()" erforderlich Dim VBSmodTest, VBSmodZahl Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell") Dim WSHNet : Set WSHNet = WScript.CreateObject("WScript.Network") Dim Args : Set Args = Wscript.Arguments Dim LogDatei : LogDatei = WScript.ScriptFullName & ".log" LogDatei = WScript.ScriptFullName & "-" & WSHNet.ComputerName & "-.log" LogDatei = WScript.ScriptFullName & "-" & WSHNet.UserName & "-.log" LogDatei = WScript.ScriptFullName & ".log" ' Call Trace32Log( "", 0 ) ' erstellt neue LogDatei Call Trace32Log( " ", 1 ) ' fügt Leerzeile in LogDatei ein WSHShell.Popup "= = = S T A R T = = =", 2, "028 :: " & WScript.ScriptName Trace32Log "029 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1 Trace32Log "030 :: LogDatei: " & LogDatei, 1 Trace32Log "031 :: PCname: " & WSHNet.ComputerName, 1 Trace32Log "032 :: Angemeldeter User: " & WSHNet.UserName, 1 For i = 0 to Args.Count - 1 ' hole alle Argumente Trace32Log "035 :: Argument " & i & ": >" & Args( i ) & "<", 1 Next Do WScript.Sleep 1000 ' neue Sekunde abwarten Do ' warten, bis eine neue Minute (mit xx:yy:00) anfängt WScript.Sleep 33 * VBSmodTest If InStr( now(), ":00" ) = Len( now() ) - 2 Then Exit Do If InStr( now(), ":10" ) = Len( now() ) - 2 Then Exit Do If InStr( now(), ":20" ) = Len( now() ) - 2 Then Exit Do If InStr( now(), ":30" ) = Len( now() ) - 2 Then Exit Do If InStr( now(), ":40" ) = Len( now() ) - 2 Then Exit Do If InStr( now(), ":50" ) = Len( now() ) - 2 Then Exit Do Loop Trace32Log "051 :: VBSmodTest: " & VBSmodTest, 1 VBSmodTest = VBSmodTest + 1 : VBSbeenden() : VBSneustart() If VBSmodTest > 10 Then Exit Do Loop WSHShell.Popup "= = = E N D E = = =", 2, "058 :: " & WScript.ScriptName Trace32Log "059 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1 Wscript.Quit '*** v?.? *** www.dieseyer.de ******************************* Function XXXX( YYYY, ZZZZ ) '*********************************************************** ' On Error Resume Next End Function ' XXXX( YYYY, ZZZZ ) '*** v5.A *** www.dieseyer.de ******************************* Sub VBSbeenden() '*********************************************************** ' Dim VBSmodTest ' beendet dieses Skript, wenn es gelöscht oder umbenannt wurde Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") On Error Resume Next If fso.FileExists( WScript.ScriptFullName ) Then Exit Sub On Error GoTo 0 WScript.Sleep 100 On Error Resume Next If fso.FileExists( WScript.ScriptFullName ) Then Exit Sub On Error GoTo 0 ' Prozedur-Aufruf für das Schreiben einer Protokolldatei Trace32Log( "092 :: " & WScript.ScriptFullName & " existiert nicht!" ), 1 Trace32Log( "093 :: " & WScript.ScriptFullName & " wird beendet . . . " ), 1 Trace32Log( "094 :: " & WScript.ScriptFullName & " wird nach " & VBSmodTest & " Durchläufen beendet . . . " ), 1 WScript.CreateObject("WScript.Shell").Popup WScript.ScriptFullName & " wird nach " & VBSmodTest & " Durchläufen beendet . . . " , 30, "096 :: " & WScript.ScriptName, 64 + 4096 WScript.Quit End Sub ' VBSbeenden() '*** v9.1 *** www.dieseyer.de ******************************* Sub VBSneustart() '*********************************************************** ' Dim VBSmodTime ' Muss beim Skriptaufruf als erstes ausgeführt werden !!! ' Dim VBSmodZahl ' für die Prozedur "Sub VBSneustart()" erforderlich ' Startet dieses Skript neu, wenn sich das Dateidatum geändert hat Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim SelbstVBS : SelbstVBS = WScript.ScriptFullName On Error Resume Next If not fso.FileExists( SelbstVBS ) Then Exit Sub On Error GoTo 0 If VBSmodTime = "" Then VBSmodTime = fso.GetFile( SelbstVBS ).DateLastModified If VBSmodTime = fso.GetFile( SelbstVBS ).DateLastModified Then Exit Sub ' Prozedur-Aufruf für das Schreiben einer Protokolldatei Trace32Log "123 :: Das Dateidatum von """ & WScript.ScriptName & """ wurde " & VBSmodZahl & "x getestet.", 1 ' WSCript.Sleep 1*1000 ' Prozedur-Aufruf für das Schreiben einer Protokolldatei Trace32Log "128 :: Das NEUE """ & SelbstVBS & """ wird jetzt gestartet . . . ", 1 WScript.CreateObject("WScript.Shell").Run """" & SelbstVBS & """" ' Prozedur-Aufruf für das Schreiben einer Protokolldatei Trace32Log "133 :: Das ALTE """ & SelbstVBS & """ wird jetzt beendet . . . ", 1 WScript.Quit End Sub ' VBSneustart() '*** v8.3 *** www.dieseyer.de ******************************* Sub LogEintrag( LogTxt ) '*********************************************************** Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim FileOut Dim LogDateiX On Error Resume Next LogDateiX = LogDatei ' wurde die Variable LogDatei nicht außerhalb der Prozedur definiert If Err.Number <> 0 Then LogDateiX = WScript.ScriptFullName & ".log" On Error Goto 0 If LogTxt = "" Then ' eine neue .LOG-Datei wird erstellt, eine vorhandene überschrieben Set FileOut = fso.OpenTextFile( LogDateiX, 2, true) FileOut.Close Set FileOut = Nothing Set fso = Nothing Exit Sub End If Set FileOut = fso.OpenTextFile( LogDateiX, 8, true) If LogTxt = vbCRLF Then FileOut.WriteLine ( LogTxt ) ' If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & vbTab & LogTxt ) ' If not LogTxt = vbCRLF Then FileOut.WriteLine ( Timer() & " " & LogTxt ) If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & " " & LogTxt ) FileOut.Close Set FileOut = Nothing Set fso = Nothing End Sub ' LogEintrag( LogTxt ) '*** 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, , "256 :: " ' MsgBox "AktDMTF: '" & AktDMTF & "'", , "257 :: " 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 )