'*** v8.4 *** www.dieseyer.de ******************************* 

' 

' Datei:  wmi-lfdprogramme.vbs 

' Autor:  dieseyer@gmx.de 

' Auf:    www.dieseyer.de 

' 

' Die Prozedur  

'	LfdProgrList() 

' listet alle laufenden Programme / Prozesse. Die Prozedur 

' ist in eine Do..Loop-Schleife eingebunden und wird dadurch 

' innerhalb von 30min zu jeder vollen Minute aufgerufen. 

' In die LOG-Datei erfolgen nur Einträge, wenn sich die Liste 

' der laufenden Programme geändert hat. 

' 

'************************************************************ 

 

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl 

 

	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 LfdProgrTxt, Tst, Nr, i 

 

' Dim LogDatei			: LogDatei		= WScript.ScriptFullName & ".log" 

 

' Trace32Log " - ", 0 ' erzeugt neue LOG-Datei 

  Trace32Log "026 :: Start "	& WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1 

' Trace32Log "027 :: Log: "	& LogDatei, 1 

  Trace32Log "028 :: PC: "	& WSHNet.ComputerName, 1 

  Trace32Log "029 :: User: "	& WSHNet.UserName, 1 

 

Do 

  Nr = Nr + 1 

 

'	Trace32Log "034 :: " & Timer() & " - " & Timer() / 60 & " - " & FormatNumber( Timer() / 60, 4 ), 1 

  Tst = LfdProgrList() ' Prozedur-Aufruf 

'	Trace32Log "036 :: " & Timer() & " - " & Timer() / 60 & " - " & FormatNumber( Timer() / 60, 4 ), 1 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

 

  If LfdProgrTxt <> Tst Then ' Nur wenn sich die Liste der lfd. Programme geändert hatt 

	LfdProgrTxt = Tst    ' Liste der lfd. Programme in eine LOG-datei schreiben (lassen) 

	Trace32Log "041 ::      " & Nr & ": " & LfdProgrTxt, 1 

  End If 

 

 

  Do 

	Tst = Timer() / 60 

	Tst = FormatNumber( Timer() / 60, 4 ) 

	If InStr( Tst, "0,00" ) > 0 Then Exit Do ' alle vollen 10min 

	If InStr( Tst, "1,00" ) > 0 Then Exit Do 

	If InStr( Tst, "2,00" ) > 0 Then Exit Do 

	If InStr( Tst, "3,00" ) > 0 Then Exit Do 

	If InStr( Tst, "4,00" ) > 0 Then Exit Do 

	If InStr( Tst, "5,00" ) > 0 Then Exit Do 

	If InStr( Tst, "6,00" ) > 0 Then Exit Do 

	If InStr( Tst, "7,00" ) > 0 Then Exit Do 

	If InStr( Tst, "8,00" ) > 0 Then Exit Do 

	If InStr( Tst, "9,00" ) > 0 Then Exit Do 

	WScript.Sleep 500 

  Loop 

	WScript.Sleep 500 

 

  If Nr > 30 Then Exit Do ' nach 30 durchläufen: Skript-Ende 

 

Loop 

 

  Trace32Log "066 :: Ende " & WScript.ScriptFullName , 1 

 

Wscript.Quit 

 

 

 

'*** v8.4 *** www.dieseyer.de ******************************* 

Function LfdProgrList() 

'************************************************************ 

 

  Dim colItems		: Set colItems = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery ("Select * from Win32_Process") 

  Dim objItems, objItem, i 

  For Each objItem in colItems 

	i = i + 1 

'	LfdProgrList = LfdProgrList & objItem.Name & vbTab  

	LfdProgrList = LfdProgrList & objItem.Name & """;""" 

  Next 

 

  LfdProgrList = i & """;""" & LfdProgrList  

 

End Function ' LfdProgrList() 

 

 

'*** 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 )