'*** v8.3 *** www.dieseyer.de *******************************
'
' Datei:  wmi-laufendevbs.vbs
' Autor:  dieseyer@gmx.de
' Auf:    www.dieseyer.de
'
' Die Prozedur prüft, welche Skripte durch "wscript.exe" 
' oder "cscript.exe" gerade laufen und fragt, ob eine davon
' beendet werden soll . . . um es dann zu beenden.
'
'************************************************************

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, PCName, Ttt, Tyt, Tst, Txt, i

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

' Call LogEintrag( "" ) ' erstellt neue LogDatei
  Call LogEintrag( " " ) ' fügt Leerzeile in LogDatei ein

  WSHShell.Popup "= = = S T A R T = = =", 2, "026 :: " & WScript.ScriptName
  LogEintrag "027 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"
  LogEintrag "028 :: LogDatei: " & LogDatei
  LogEintrag "029 :: PCname: " & WSHNet.ComputerName
  LogEintrag "030 :: Angemeldeter User: " & WSHNet.UserName


PCName = WSHNet.ComputerName

If not WMIpingOK( PCName ) Then MsgBox PCName & "   ist nicht erreichbar.", , "035 :: " : WSCript.Quit
If not WMIpingOK( PCName ) Then WSCript.Quit

  LogEintrag "038 :: " & PCName & "   ist (per wmi-ping) erreichbar . . . "
  WSHShell.Popup PCName & "   ist (per wmi-ping) erreichbar . . . ", 3, "039 :: " & WScript.ScriptName, 4096

Dim arrVbsLst
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  arrVbsLst = LaufendeSkripte( PCName )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' MsgBox "045 :: UBound( arrVbsLst ): " & UBound( arrVbsLst )
  LogEintrag "046 :: Anzahl der lafenden Skripte: " & UBound( arrVbsLst )

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' ArrayZeigen( arrVbsLst )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


' Array bearbeit - für eine 'bessere' Anzeige
  For i = LBound( arrVbsLst ) to UBound( arrVbsLst )

	ReDim Preserve arrVbsAnz( i )

	Tst = arrVbsLst( i )
	Tst = Mid( TSt, 1, InStr( Tst, "." ) + 3 ) ' bis ".exe"
	Tst = Mid( Tst, InStrRev( Tst, "\" ) + 1 ) ' ab "\"; müsste jetzt "WScript.exe" sein
	Txt = Tst

	Tst = arrVbsLst( i )
	Tst = Mid( Tst, InStr( Tst, Txt ) + Len( Txt ) + 3 ) ' alles nach "WScript.exe"

	If Len( Tst ) < 55 Then
	  Txt = Txt & " " & Tst
	Else
	  Ttt = Tst : Ttt = Mid( Ttt, 1, 30 ) ' die ersten Zeichen
	  If InStrRev( Ttt, "\" ) > 5 Then Ttt = Mid( Ttt, 1, InStrRev( Ttt, "\" ) )
	  Txt = Txt & " " & Ttt & " . . . "
	  Ttt = Tst : Ttt = Mid( Ttt, 30 ) ' die letzten Zeichen
	  If InStr( Ttt, "\" ) > 0 Then Ttt = Mid( Ttt, InStr( Ttt, "\" ) )
	  Txt = Txt & Ttt
	End If

	arrVbsAnz( i ) = Replace( Txt, """", "" )

  Next


  Tst = "   Welches Skript soll beendet (kill) werden?" & vbCRLF
  For i = LBound( arrVbsAnz ) to UBound( arrVbsAnz )
	Tst = Tst & vbCRLF & i + 1 & ")   " & arrVbsAnz( i )
  Next

i = InputBox( Tst, "087 :: " & WScript.ScriptName )

  On Error Resume Next
  i = Int( i )
  On Error Resume Next
  i = i - 1
  If i < 0 OR i > UBound( arrVbsLst ) Then MsgBox "Falsche Eingabe!" & vbCRLF & vbCRLF & vbTab & "Skript-Ende.", , "093 :: " & WScript.ScriptName : WScript.Quit

  LogEintrag "095 :: Soll beendet werden: " & arrVbsLst( i )

Tst = SkriptBeenden( PCName, arrVbsLst( i ) )

If not Tst Then LogEintrag "099 :: Konnte nicht beendet werden:" & arrVbsLst( i )
If not Tst Then MsgBox "Konnte nicht beendet werden:" & vbCRLF & vbCRLF & arrVbsLst( i ), , "100 :: " & WScript.ScriptName : WScript.Quit
If not Tst Then WScript.Quit

  LogEintrag "103 :: Wurde beendet:" & arrVbsLst( i )
  WSHShell.Popup "Wurde beendet:" & vbCRLF & vbCRLF & arrVbsLst( i ), 3, "104 :: " & WScript.ScriptName, 4096

  WSHShell.Popup "= = = E N D E = = =", 2, "106 :: " & WScript.ScriptName, 4096
  LogEintrag "107 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"

WScript.Quit



'*** v7.A *** www.dieseyer.de *******************************
Function SkriptBeenden( PC, Progr )
'************************************************************
' On Error Resume Next
  SkriptBeenden = False

  Dim objWMIService	: Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PC & "\root\cimv2")
  Dim colProcessList	: Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name Like '" & "%script.exe%" & "'" ) ' : MsgBox colProcessList.Count, , "120 :: "

  Dim objProcess
  For Each objProcess in colProcessList
'	MsgBox objProcess.CommandLine & vbCRLF & Progr, , "124 :: " ' : WScript.Quit
'	If objProcess.CommandLine = Progr Then MsgBox objProcess.CommandLine & vbCRLF & Progr, , "125 :: " ' : WScript.Quit
	If objProcess.CommandLine = Progr Then objProcess.Terminate()  : SkriptBeenden = True
  Next

' MsgBox i & " - PC: " & PC & vbCRLF & "Progr: " & Progr, , "129 :: "

End Function ' SkriptBeenden( PC )



'*** v7.A *** www.dieseyer.de *******************************
Function LaufendeSkripte( PC )
'************************************************************
' On Error Resume Next
  Dim Txt, i

  Const wbemFlagReturnImmediately = &h10
  Const wbemFlagForwardOnly = &h20
  Dim objWMIService :	' Set objWMIService = GetObject("winmgmts:\\" & PC & "\root\CIMV2")

' Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PC & "\root\cimv2")
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PC	 & "\root\cimv2")
  Dim colItems      : Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
  Dim objItem
  For Each objItem In colItems
	If InStr( LCase( objItem.CommandLine ), "script.exe" ) > 0 Then
		ReDim Preserve LaufendeSkripteX(i)
		LaufendeSkripteX(i) = objItem.CommandLine
		i = i + 1
	End If
  Next

  Set colItems = nothing
  Set objWMIService = nothing

  LaufendeSkripte = LaufendeSkripteX

End Function ' LaufendeSkripte( PC )


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



'*** v7.C *** www.dieseyer.de ****************************
Function ArrayZeigen( InArray )
'*********************************************************
' Durch die Prozedur
'    ArrayZeigen( InArray )
' werden von einem Array nur die ersten
' und letzten Elemente angezeigt. Da die MsgBox nur 1024
' Zeichen anzeigen kann, ist die Anzahl der angezeigten
' Elemente von der Länge der einzelnen Elemente abhängig.

  Dim TxtOben, TxtUnten, Tst, i, n, o, u
  Dim Kopf ' für Tests
  ' Kopf = "LBound( InArray )=" & LBound( InArray ) & "   UBound( InArray )=" & UBound( InArray ) & vbCRLF & vbCRLF & Kopf
  ' Kopf = "O=00000" & "   U=00000" & "   Len( TxtOben )=00000" & vbCRLF & Kopf

  For i = LBound( InArray ) to UBound( InArray )

    n = UBound( InArray ) - i
    Tst = Len( TxtOben ) + Len( TxtUnten ) + Len( InArray( i ) ) + Len( Kopf )
    If Tst < 1000 AND n >= i Then
'		TxtOben  = TxtOben  & "i = " & i & vbTab & "n = " & n & vbTab & Tst & vbTab & InArray( i ) & vbCRLF
		TxtOben  = TxtOben  &          i &                                    vbTab & InArray( i ) & vbCRLF
		o = i
    End If

    n = UBound( InArray ) - i
    Tst = Len( TxtOben ) + Len( TxtUnten ) + Len( InArray( n ) )
    Tst = Len( TxtOben ) + Len( TxtUnten ) + Len( InArray( i ) ) + Len( Kopf )
    If Tst < 1000 AND n > i Then
'		TxtUnten  = "n = " & n & vbTab & "i = " & i & vbTab & Tst & vbTab & InArray( n ) & vbCRLF & TxtUnten
		TxtUnten  =          n                                    & vbTab & InArray( n ) & vbCRLF & TxtUnten
		u = n
    End If
    If n <=i then Exit For

  Next

  Tst = ""
  If o <> u AND o + 1 <> u Then Tst = "." & vbCRLF & "." & vbCRLF

  Kopf = Replace( Kopf, "O=00000", "O=" & o )
  Kopf = Replace( Kopf, "U=00000", "U=" & u )
  Kopf = Replace( Kopf, ")=00000", ")=" & Len( Kopf & TxtOben & Tst & TxtUnten ) )

  TxtOben = Kopf & TxtOben & Tst & TxtUnten

' LogEintrag "230 :: " & vbCRLF & TxtOben
  MsgBox TxtOben , , "231 :: " & WScript.ScriptName

End Function ' ArrayZeigen( InArray )



'*** v7.C *** www.dieseyer.de *******************************
Sub LogEintrag( LogTxt )
'************************************************************
  Dim fso         : Set fso       = WScript.CreateObject("Scripting.FileSystemObject")
  Dim FileOut

' Dim LogDatei   : LogDatei = "c:\LOG.s\" & WScript.Scriptname & ".log"

  If LogTxt = "" Then
    Set FileOut = fso.OpenTextFile( LogDatei, 2, true)
        FileOut.Close
    Set FileOut = Nothing
    Set fso     = Nothing
    Exit Sub
  End If

    Set FileOut = fso.OpenTextFile( LogDatei, 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 ( Now() & "   " & LogTxt )

        FileOut.Close
    Set FileOut = Nothing
    Set fso     = Nothing

End Sub ' LogEintrag( LogTxt )