http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** v5.1*** www.dieseyer.de *******************************
'
' Datei: LfdProzess-Kill.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Das Skript erwartet 3 oder 4 Parameter
' ( ProzessName MeldungsText AnzahlDerMeldung Kill)
' LfdProzess-Kill.vbs IExplore.exe "Bitte den Internetexplorer beenden!" 3
' LfdProzess-Kill.vbs IExplore.exe "Bitte den Internetexplorer beenden!" 3 KilL
'
' Das Skript prüft alle 30sec, ob die Anwendung noch läuft -
' wenn ja, fordert es den Anwender mit "MeldungsText" auf, die
' Anwendung zu beenden.
' Ist die Anwendung nach "AnzahlDerMeldung" immer noch aktiv,
' beendet sich das Skript ohne Aktion. Enthält der 4. Parameter
' "KILL", wird die Anwendung bzw. sein Prozess beendet
' (ge-kill-t, abgeschossen).
'
'************************************************************

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 WshSysEnv : Set WshSysEnv = WSHShell.Environment("SYSTEM")
Dim oArgs : Set oArgs = Wscript.Arguments

Dim Txt, i
Dim ProzName, ProzMsg, TestAnz, ProzKill

Dim LogDatei

If oArgs.Count < 3 OR oArgs.Count > 4 then
MsgBox "Falsche Anzahl von Argumenten - SkriptEnde", 4096, oArgs.Count & " - " & WScript.ScriptName
WScript.Quit
End If

For i = 0 to oArgs.Count - 1 ' hole alle Argumente
' MsgBox oArgs.item(i), , i
if i = 0 then ProzName = oArgs.item(i)
if i = 1 then ProzMsg = oArgs.item(i)
if i = 2 then TestAnz = oArgs.item(i)
if i = 3 then ProzKill = oArgs.item(i)
Next

LogDatei = "c:\" & fso.GetBaseName( WScript.ScriptName ) & ".log"
LogDatei = "c:\" & ProzName & ".log"

' LogEintrag( "" ) ' neue Log anlegen
LogEintrag( WScript.ScriptFullName & " - Aufruf" )

ProzKill = UCase( ProzKill )
ProzName = UCase( ProzName )
TestAnz = CInt( TestAnz )
i = 1


Do
' MsgBox i & vbTab & LfdProzessTest( ProzName ), , TestAnz

Txt = LfdProzessTest( ProzName ) ' Function Aufruf
If Txt = 0 Then
LogEintrag( ProzName & " läuft z.Z. nicht." )
Exit Do
Else
LogEintrag( ProzName & " (" & Txt & ") läuft z.Z. - angemeldeter User: " & WSHNet.UserName )

If i = TestAnz Then WSHShell.Popup vbTab & vbTab & vbTab & "! ! ! A C H T U N G ! ! !" & vbCRLF & vbCRLF & "Die Anwendung wird in 30sec automatisch geschlossen!" & vbCRLF & vbCRLF & "Durch die Bestaetigung des OK Button wird die Applikation sofort ohne speichern geschlossen" & vbCRLF & vbCRLF & ProzMsg, 30, i & " - " & ProzName, 4096+48

If i <> TestAnz Then MsgBox ProzMsg, 4096, i & " - " & ProzName
End If

i = i + 1
If i > TestAnz Then

If not Txt = 0 AND ProzKill = "KILL" Then
Txt = LfdProzessKill( Txt ) ' Function Aufruf
LogEintrag( Txt )
Else
If not Txt = 0 Then LogEintrag( ProzName & " wurde nicht von " & WSHNet.UserName & " beenedet." )
If Txt = 0 Then LogEintrag( ProzName & " läuft z.Z. nicht." )
End If

Exit Do
End If

WScript.Sleep 1000*3
Loop

LogEintrag( WScript.ScriptFullName & " - beendet" & vbCRLF )

' WSHShell.Run "notepad " & LogDatei

WScript.Quit

'**************************************************************
Sub LogEintrag( LogTxt )
'**************************************************************
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim FileOut

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 )

FileOut.Close
Set FileOut = Nothing
Set fso = Nothing
End Sub ' LogEintrag( LogTxt )



'*** v5.1*** www.dieseyer.de *******************************
Function LfdProzessTest( ProzessName )
'***********************************************************
Dim Txt, objWMIService, colItems, objItem
ProzessName = UCase( ProzessName )

LfdProzessTest = 0

Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Process",,48)
For Each objItem in colItems
Txt = UCase( objItem.Description )
If Txt = ProzessName Then
' LogEintrag( "Description: " & objItem.Description )
' LogEintrag( "Name: " & objItem.Name )
' LogEintrag( "ProcessId: " & objItem.ProcessId )
LfdProzessTest = objItem.ProcessId
' LogEintrag( "Handle: " & objItem.Handle )
' LogEintrag( "SessionId: " & objItem.SessionId )
' LogEintrag( "Status: " & objItem.Status )
' LogEintrag( "WindowsVersion: " & objItem.WindowsVersion )
End If
Next
End Function ' LfdProzessTest( ProzessName )



'*** v5.1*** www.dieseyer.de *******************************
Function LfdProzessKill( ProzessID )
'**************************************************************
Dim oProc, oInstance
Set oProc = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!//." ).ExecQuery ("Select * from Win32_Process " & "Where ProcessID =" & ProzessID)
For Each oInstance in oProc
oInstance.Terminate 0
LfdProzessKill = "ProcessId: " & oInstance.ProcessID & " (" & oInstance.Name & ") wurde beendet."
Next
End Function ' LfdProzessKill( ProzessID )

http://dieseyer.de • all rights reserved • © 2011 v11.4