' --------------------------------------------------------------------
' Script d'affichage détaillé des processus en cours
' sur une machine locale ou distante
' Fait appel à Internet Explorer pour la saisie
' des paramètres et l'affichage des résultats
'
' Jean-Claude BELLAMY © 2002
' --------------------------------------------------------------------
Dim args, network, computer, fso, ts, tparam, tPrint, oIE, fExec, user,domain, system,process
Set network  = Wscript.CreateObject("WScript.Network")
Set Shell = WScript.CreateObject("WScript.Shell")
' Création du fichier HTML qui va servir de formulaire
fichtml=GetPath() & "processlist.html"
ficparam=GetPath() & "processlist.cfg"
ficprint=GetPath() & "processlist.txt"

local=lcase(network.ComputerName)
Set args=Wscript.Arguments
If args.count>0 Then
	computer=lcase(args(0))
Else
	computer=local  
	End If
If computer=local Then typeordi="local" else typeordi="distant" 
RootTitle="Liste des processus sur " & computer & " (" & typeordi & ")"
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set ts  = fso.CreateTextFile(fichtml, True)
isparam=false
If fso.FileExists(ficparam)  Then
	Set tparam=fso.OpenTextFile(ficparam)
	isparam=true
	End If
'================ Choix des paramètres ================
WriteHTMLHeader 
header="Paramètres à afficher dans "
header=header & "<input type=""checkbox"" name=""ie"" value=""ie"" checked >IE"
' test d'existence de Excel
On Error Resume Next
ReadKey=shell.RegRead("HKEY_CLASSES_ROOT\.xls\")
If Err.Number=0 Then header=header & "<input type=""checkbox"" name=""excel"" value=""excel"" >Excel"
On error goto 0
header=header & "<input type=""checkbox"" name=""notepad"" value=""notepad"" >Bloc-notes"
ts.writeline "<b>" & header & "   :</b><p>"
ts.writeline "<table>"
objet="Win32_Process"
Set System = GetObject("winmgmts:" & objet)
n=0
ncol=3
dim prop()
for each Property in System.Properties_
	AddProp Property.Name
	next
' Ajout des méthodes GetOwner et GetOwnerSid"
AddProp "GetOwner"
AddProp "GetOwnerSid"
r=ncol-(n mod ncol)
If r<>ncol Then 
	For i = 1 To r
		ts.writeline "<td></td>"
		Next
	ts.writeline "</tr>"
	end if
ts.writeline "</table>"
WriteHTMLBottom "Afficher","Fermer"

If isParam Then	tParam.Close
RunIE 600,600,true

DisplayIE=false
DisplayExcel=false
DisplayNotepad=false
if oIE.Document.processlistForm.IE.Checked then DisplayIE=true
if oIE.Document.processlistForm.Excel.Checked then DisplayExcel=true
if oIE.Document.processlistForm.Notepad.Checked then DisplayNotepad=true

Set tParam = fso.CreateTextFile(ficparam, True)
' Utilisation de la fonction execute afin de créer dynamiquement 
' des commandes faisant intervenir des noms de champs variables
dim f(), res()
redim f(n), res(n)
lmax=0
for i = 0 to n-1
	f(i) = "function testparam() " & vbcrlf
	f(i) = f(i) & "testparam=0" & vbcrlf
	f(i) = f(i) & "if oIE.Document.processlistForm.param" & i &".Checked then testparam=1" & vbcrlf
	f(i) = f(i) & "end function" & vbcrlf
	execute f(i)
	res(i)=testparam()
	state=""
	If res(i)=1 Then 
		state="Checked"
		l=len(prop(i))
		If lmax<l then lmax=l
		end if
	tParam.writeline state
	next
oIE.Quit
tParam.close

'================ Affichage des résultats ================
Set ts  = fso.CreateTextFile(fichtml, True)
If DisplayExcel Then
	Dim objXL
	Set objXL = WScript.CreateObject("Excel.Application")
	objXL.Workbooks.Add
	objXL.Cells(1,1).Value = Titre
	objXL.Visible = True
	End If

If DisplayNotepad Then 
	Set tPrint = fso.CreateTextFile(ficprint, True)
	tprint.writeline Titre
	tprint.WriteBlankLines(1)
	end if
WriteHTMLHeader
ts.writeline "<b>Liste des processus<b> (" & date & " " & time & ")<br>"
ts.writeline "<table border=""1"" cellspacing=""1"" cellpadding=""2"" style=""border-collapse: collapse"" bordercolor=""#111111"">"
ts.writeline "<tr>"
first=true
nl=2
nc=0
ts.writeline "<td bgcolor=""#C0C0C0"" valign=""top"">Terminer</td>"
For i= 0 To n-1
	If res(i)=1 Then
		If DisplayNotepad then
			If not first Then tprint.write chr(9) else first=false
			tprint.write prop(i) 
			end if
		nc=nc+1
		If DisplayExcel Then objXL.Cells(nl,nc).Value = prop(i)
		comment=""
		If lcase(prop(i))="executablepath" Then 
			comment="<br><i>Cliquer sur un lien pour afficher<br>le fichier dans l'explorateur</i>"
			end if
		ts.writeline "<td bgcolor=""#C0C0C0"" valign=""top"">" & prop(i) & comment & "</td>"
		End If
	Next
ts.writeline "</tr>"
If DisplayNotepad Then tprint.WriteBlankLines(2)

Set System=GetObject ("winmgmts:{impersonationLevel=impersonate}!//" & Computer).InstancesOf(objet)
nl=2
nc=0
nproc=0
dim ProcState(),ProcNum()
for each Process in System
	nl=nl+1
	first=true
	SetKill Process.Handle
	ts.writeline "<tr><a name=""" & Process.Handle & """>"
	ts.writeline "<td align=""center""><input type=""button"" value=""M"" style=""font-family: Wingdings"" name=""" & Process.Handle & """ onClick='Kill("""& Process.Handle & """)'></td>" 
	nc=0
	For i= 0 To n-3
		If res(i)=1 Then
			var ="Process." & prop(i)
			valeur=eval(var)
			If IsNull(valeur) Then valeur=""
			link=""
			If prop(i)="ExecutablePath" and valeur<>"" Then
				filename=valeur
				If computer<>local Then	filename="\\" & computer & "\" & Replace(filename, ":", "$")
				link="<a href=""#" & Process.Handle & """ onClick='Explore("""& filename & """)'>"
				End If
			addProcess 0,valeur,link
			End If
		Next
	If res(n-2)=1 Then
		result=Process.GetOwner(user,domain)
		addProcess result, user & "/" & domain,""
		end if
	If res(n-1)=1 Then
		result=Process.GetOwnerSid(SID)
		addProcess result, SID,""
		end if
	ts.writeline "</tr>"
	If DisplayNotepad Then tprint.writeline ""
	next

If DisplayExcel Then
	objXL.Rows("2:2").Select
	objXL.Selection.Font.Bold = True
	d1=int((nc-1)/26)
	d2=((nc-1) mod 26)
	If d1=0 Then l1max="" else l1max=chr(Asc("A")+d1-1)
	l2max=chr(Asc("A")+d2)
	objXL.Columns("A:" & l1max & l2max).Select
	objXL.Selection.Columns.AutoFit
	objXL.Rows("1:1").Select
	objXL.Selection.Font.Bold = True
	objXL.Selection.Font.Size = 12
	end if

ts.writeline "</table>"

If DisplayNotepad Then 
	tprint.close
	commande=shell.ExpandEnvironmentStrings("%windir%\notepad.exe " & chr(34) & ficprint & chr(34)) 
	shell.Run commande, 1
	end if

If DisplayIE Then
	WriteHTMLBottom "","Fermer"
	RunIE 600,400,false
	End If
	
Wscript.quit

'------------------------------------------------------------
Function FormatStr(ch,lmax)
l=len(ch)
If l<lmax Then 
	For k = l+1 To lmax
		ch=ch & " "
		Next
	End If
FormatStr=ch
End Function
'------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
End Function
'------------------------------------------------------------
Sub WriteHTMLHeader
ts.writeline "<html>"
ts.writeline "<head>"
ts.writeline "<title>" & Titre & "</title>"
ts.writeline "<STYLE TYPE=""text/css"">"
ts.writeline "	body {"
ts.writeline "	font-family: Verdana;"
ts.writeline "	font-size: 8 pt }"
ts.writeline "	h1, h2, h3, h4, h5, h6 { font-family: Verdana }"
ts.writeline "table {"
ts.writeline "	table-border-color-light: rgb(102,204,204);" 
ts.writeline "	table-border-color-dark:  rgb(0,102,102);" 
ts.writeline "	font-size: 8 pt;"
ts.writeline "	font-family: Verdana }"
ts.writeline "</STYLE>"
ts.writeline "</head>"
ts.writeline "<body bgcolor=""#FFFFD2"">"
ts.writeline "<script language=""VBScript""> "
ts.writeline "<!--"
ts.writeline "Dim ready,flagfile,file,flagkill,ID"
ts.writeline "Sub B0_OnClick"
ts.writeline "ready=-1"
ts.writeline "End Sub"
ts.writeline "Sub B1_OnClick"
ts.writeline "ready=1"
ts.writeline "End Sub"

ts.writeline "Sub Window_OnLoad()"
ts.writeline "ready=0"
ts.writeline "flagfile=0"
ts.writeline "flagkill=0"
ts.writeline "file="""""
ts.writeline "ID=0"
ts.writeline "End Sub"

ts.writeline "Public Function CheckVal()"
ts.writeline "CheckVal=ready"
ts.writeline "End function"

ts.writeline "Public Function CheckFile()"
ts.writeline "CheckFile=flagfile"
ts.writeline "End function"

ts.writeline "Public Function CheckID()"
ts.writeline "CheckID=flagkill"
ts.writeline "End function"

ts.writeline "Public Sub ResetFile()"
ts.writeline "flagFile=0"
ts.writeline "End sub"

ts.writeline "Public Sub ResetID()"
ts.writeline "flagkill=0"
ts.writeline "End sub"

ts.writeline "Public Function GetFile()"
ts.writeline "GetFile=file"
ts.writeline "End function"

ts.writeline "Public Function GetID()"
ts.writeline "GetID=ID"
ts.writeline "End function"

ts.writeline "function Explore(filename)"
ts.writeline "flagfile=1"
ts.writeline "file=filename" 
ts.writeline "End function" 

ts.writeline "function Kill(handle)"
ts.writeline "flagkill=1"
ts.writeline "ID=handle" 
ts.writeline "End function" 

ts.writeline "'-->"
ts.writeline "</script>"
ts.writeline "<form name=""processlistForm"">"
ts.writeline "<h3><center>Ordinateur " & typeordi & " " & Computer & "</center></h3><hr>"
End Sub
' -------------------------------------
Sub WriteHTMLBottom(B1,B0)
ts.writeline "<br>"
If B1<>"" Then ts.writeline "<input type=""button"" value=""" & B1 & """ name=""B1"">"
If B0<>"" Then ts.writeline "<input type=""button"" value=""" & B0 & """ name=""B0"">"
ts.writeline "</form>"
ts.writeline "</body>"
ts.writeline "</html>"
ts.Close
End Sub
' -------------------------------------
Sub RunIE(W,H,testclose)
' Ouverture d'Internet Explorer
Set oIE = WScript.CreateObject("InternetExplorer.Application", "IE_")
oIE.Left = 50        
oIE.Top = 100 
oIE.Height = H
oIE.Width = W
oIE.MenuBar = 0         
oIE.ToolBar = 0
oIE.StatusBar = 1
oIE.navigate fichtml  
oIE.Visible = 2      
Do While (oIE.Busy)    
	WScript.Sleep 200  
	Loop
shell.AppActivate Titre

' Attente d'action sur le bouton ou fermeture de la fenêtre
On Error Resume Next 
Do                   
	WScript.Sleep 100
	If oIE.Document.Script.CheckFile()<>0 Then
		path=oIE.Document.Script.GetFile()
		oIE.Document.Script.ResetFile
		If path<>"" Then Shell.run "explorer /select," & path,1
		End If
	If oIE.Document.Script.CheckID()<>0 Then
		ID=oIE.Document.Script.GetID()
		oIE.Document.Script.ResetID
		If ID<>0 Then 
			If GetStateKill(ID)=0 Then
				MsgBox "Le processus " & ID & " n'existe plus", vbExclamation,"Terminaison de processus"
			Else
				rep=MsgBox("Etes-vous sûr de terminer le processus " & ID & "?", vbYesNo + vbQuestion,"Terminaison de processus")
				If rep=vbYes Then 
					result=killprocess(ID)
					If result=0 Then CancelKill(ID)
					end if
				End If
			end if
		End If
	Loop While (oIE.Document.Script.CheckVal() = 0)
' Si on ferme directement IE sans passer par un bouton, 
' cela provoque une erreur qui est détectée et alors
' on quitte le script
If Err <> 0 Then 
	If testclose Then 
		Wscript.quit 
	else 
		On Error goto 0
		exit sub
		end if
	end if
test=oIE.Document.Script.CheckVal()
If test=-1 Then 
	oIE.Quit
	If testclose Then Wscript.quit
	end if
On Error goto 0
End Sub
' -------------------------------------
Sub AddProp(ch)
n=n+1
redim preserve prop(n)
prop(n-1)=ch
state=""
If isParam then If not tParam.AtEndOfStream Then state=tParam.ReadLine
If ((n-1) mod ncol)=0 Then ts.writeline "<tr>"
ts.writeline "<td><input type=""checkbox"" name=""param" & n-1 &""" value=""" & prop(n-1) & """ " & state & ">" & prop(n-1) & "</td>"
If (n mod ncol)=0 Then ts.writeline "</tr>"
End Sub
' -------------------------------------
Sub AddProcess(result,ch, chlink)
tag=""
If IsNumeric(ch) Then tag=" align=""right"""
ts.writeline "<td" & tag & ">" 
If result=0 Then 
	If chlink<>"" Then ts.writeline chlink
	ts.writeline ch
	If chlink<>"" Then ts.writeline "</a>" 
	end if
ts.writeline "</td>"
If DisplayNotepad Then 
	If not first Then tprint.write chr(9) else first=false
	If result=0 Then tprint.write ch  
	end if
nc=nc+1	
If DisplayExcel and result=0 Then objXL.Cells(nl,nc).Value = ch
End Sub
' -------------------------------------
Function Titre
Titre=rootTitle & " " & Date & " " & Time
End Function
' -------------------------------------
Function KillProcess(ID)
Set System=GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).ExecQuery("select * from " _
& objet & " where Handle=" & ID)
result=-1
for each Process in System
	result=Process.terminate(0)
	If result<>0 Then 
		MsgBox "Erreur code " & result, vbExclamation,"Terminaison processus " & ID
	Else
		MsgBox "Processus correctement terminé", vbInformation,"Terminaison processus " & ID
		End If
	next
KillProcess=result
End Function
' -------------------------------------
Sub SetKill(Handle)
nproc=nproc+1
redim preserve ProcNum(nproc),ProcState(nproc)
ProcNum(nproc-1)=handle
ProcState(nproc)=1
End Sub
' -------------------------------------
Function GetStateKill(ID)
GetStateKill=0
For i = 0 To nproc-1
	If ProcNum(i)=ID Then
		GetStateKill=ProcState(i)
		exit function
		End If
	Next
End Function
' -------------------------------------
Sub CancelKill(ID)
For i = 0 To nproc-1
	If ProcNum(i)=ID Then
		ProcState(i)=0
		exit sub
		End If
	Next
End Sub
' -------------------------------------