http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** 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 )
http://dieseyer.de • all rights reserved • © 2011 v11.4