HTA Remote Task Manager

**ShadowLocke** · Apr 18 '08, 02:15 PM

Hi /bytes/,

I had planned on creating this HTA and writing a How To for it, but alas work has gotten the best of me and I have not been able to put the time into it i wanted. I am posting the code I have so far here (which is fully functional) Please run with it!

(To run this, copy the code into a text file and rename it with an .HTA extension)

Code:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
	<head>
	<title>HTA TaskMgr</title>
	<HTA:APPLICATION id="prjIS" MINIMIZEBUTTON="yes" MAXIMIZEBUTTON="no" INNERBORDER="yes" BORDER="thin" SINGLEINSTANCE="yes" APPLICATIONNAME="TaskMgr">
 
	<SCRIPT language="vbscript">
	<!--
	'Global variables
	Option Explicit
 
	Dim strCurrentSort, strDir
	Dim TimerID
	Dim aryProcs()
	Dim strUser, strPass, strIP
	Dim strProcessWQL
 
	Sub Window_onLoad()
 
Dim objWMI, objProcs, objProcess
Dim intTotal
Dim aryTmp()
Dim intLeft, intTop, intWidth, intHeight
Dim tbl, nRow, cName, cCPU, cMem
 
strUser = "username"
strPass = "supersecretpassword"
 
'Set Window Size
		intWidth = window.screen.width
		intHeight = window.screen.height
 
	intLeft = (intWidth - 430) / 2
		intTop = (intHeight - 555) / 2
		window.resizeTo 430,555
		window.MoveTo intLeft, intTop
 
strProcessWQL = "SELECT " & _
"Name, " & _
"IDProcess, " & _
"TimeStamp_Sys100NS, " & _
"PercentProcessorTime, " & _
"WorkingSet " & _
"FROM Win32_PerfRawData_PerfProc_Process"
 
Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set objProcs = objWMI.ExecQuery(strProcessWQL)
 
intTotal = 0 
 
Set tbl = document.getElementById("tblProcess")
 
For Each objProcess in objProcs
If objProcess.Name <> "_Total" And objProcess.Name <> "Idle" Then
Set nRow = tbl.insertRow(-1)
 
		 Set cName = nRow.insertCell(-1)
		 Set cCPU = nRow.insertCell(-1)
		 Set cMem = nRow.insertCell(-1)
 
		 cName.innerText = objProcess.Name
		 cMem.innerText = FormatNumber(objProcess.WorkingSet / 1024, 0) & " K"
		 cCPU.innerText = "0"
 
		 ReDim Preserve aryProcs(intTotal)
		 ReDim aryTmp(1)
 
		 aryTmp(0) = objProcess.PercentProcessorTime
		 aryTmp(1) = objProcess.TimeStamp_Sys100NS
 
		 aryProcs(intTotal) = aryTmp
 
		 intTotal = intTotal + 1
		 End If
		Next		
 
		TimerID = window.setInterval("GetProcs", 1000)
 
	End Sub

Code:

	Function IsValidIp(strIpAddress)'Well..is it?
 
		Dim aryTmp
		Dim strField
 
		IsValidIp = False
		aryTmp = split(strIpAddress,".")
 
		If UBound(aryTmp) <> 3 Then Exit Function
 
		For Each strField In aryTmp
		 If strField > 255 Then Exit Function
		Next
 
		IsValidIp = True
 
	End Function
 
	Function CanPing(strIPAddress)
	 Dim Status
	 Dim objWMI, objWPing
 
	 Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
	 Set objWPing = objWMI.ExecQuery("Select StatusCode from Win32_PingStatus where address='" & strIPAddress & "'")
 
	 For Each Status in objWPing
		 If Status.StatusCode <> 0 then
			 CanPing = False
		 Else
			 CanPing = True
		 End If
	 Next
End Function
 
	'This was complicated..
	'Sets cursor to end of text when focus is gained
	Sub txtIP_OnFocus 
	 Dim it
		Set it = document.Selection.CreateRange()
		it.moveStart "Character", 15
		it.select
	End Sub
 
	Sub btnGo_OnClick()
	 Dim str
	 Dim div
 
	 str = document.getElementById("txtIP").value
	 Set div = document.getElementById("divTitle")
 
	 If IsValidIp(str) Then
	 If CanPing(str) Then
	 strIP = str
	 div.innerText = "Currently monitoring: " & str
	 Else
	 msgbox "Unable to ping " & str
	 End If
	 Else
	 strIP = ""
	 div.innerText = "Currently monitoring: localhost"
	 End If
	End Sub
 
 
 
 
'The Loop
Sub GetProcs()
On Error Resume Next
 
Dim objWMI, objProcs, objProcess, objSWbemLocator
Dim intTotal
Dim aryTemps(), aryTmp()
Dim tbl, nRow, cName, cCPU, cMem
Dim strCPU
Dim I
 
If strIP <> "" Then
		 Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
		 Set objWMI = objSWbemLocator.ConnectServer(strIP, "root\cimv2", strUser, strPass)
		Else
		 Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
		End If
 
		Set tbl = document.getElementById("tblProcess")
 
		Set objProcs = objWMI.ExecQuery(strProcessWQL)
 
ClearTable
 
intTotal = 0
 
For Each objProcess in objProcs
If objProcess.Name <> "_Total" And objProcess.Name <> "Idle" Then
		 Set nRow = tbl.insertRow(-1)
 
		 Set cName = nRow.insertCell(-1)
		 Set cCPU = nRow.insertCell(-1)
		 Set cMem = nRow.insertCell(-1)
 
nRow.onmousedown = GetRef("RowClick")
nRow.oncontextmenu = GetRef("NoContext")
 
		 nRow.ID = objProcess.IDProcess
 
		 cName.innerText = objProcess.Name
		 cMem.innerText = FormatNumber(objProcess.WorkingSet / 1024, 0) & " K"
 
		 strCPU = ((objProcess.PercentProcessorTime - aryProcs(intTotal)(0)) / (objProcess.TimeStamp_Sys100NS - aryProcs(intTotal)(1))) * 100
		 cCPU.innerText = FormatNumber(strCPU, 0)
 
ReDim Preserve aryTemps(intTotal)
ReDim aryTmp(1)
 
aryTmp(0) = objProcess.PercentProcessorTime
aryTmp(1) = objProcess.TimeStamp_Sys100NS
 
aryTemps(intTotal) = aryTmp
 
intTotal = intTotal + 1
 
		 End If
		Next
 
		ReDim aryProcs(intTotal - 1)
		For I = 0 to intTotal - 1
		 aryProcs(I) = aryTemps(I)
		Next
 
		If strCurrentSort <> "" Then Sort(strCurrentSort)
 
	End Sub

Code:

 
 
	Function NoContext()
	 window.event.returnValue = False
	End Function
 
	Sub RowClick()
	 If window.event.button = 2 Then
	 Dim div, cRow
	 Dim intX, intY, intDivHeight
 
	 Set cRow = window.event.srcElement.parentNode
 
	 Set div = document.getElementById("mnuContext") 	 
 
	 document.getElementById("txtPID").innerText = cRow.ID
	 document.getElementById("txtName").innerText = cRow.cells(0).innerText
 
	 intX = window.event.x - 10
	 intY = window.event.y - 10
 
	 intDivHeight = Cint(Replace(div.style.height, "px", ""))
 
	 If intY + intDivHeight > document.body.offsetHeight Then
	 div.style.Left = intX
	 div.style.top = document.body.offsetHeight - intDivHeight - 5
	 Else
	 div.style.Left = intX
	 div.style.top = intY
	 End If
 
	 div.style.display = ""
	 End If	 
	End Sub
 
	Sub menu_mouseout()
	 Dim div
	 Dim intX, intY, intDivLeft, intDivTop, intDivRight, intDivBottom
 
	 Set div = window.event.srcElement
 
	 If Left(div.ID, 3) <> "mnu" Then Exit Sub
 
	 intX = window.event.X
	 intY = window.event.Y
 
	 intDivLeft = Clng(Replace(div.style.left, "px", ""))
	 intDivTop = Clng(Replace(div.style.top, "px", ""))
	 intDivRight = Clng(Replace(div.style.width, "px", "")) + intDivLeft
	 intDivBottom = Clng(Replace(div.style.height, "px", "")) + intDivTop
 
	 If intY > intDivTop And intY < intDivBottom _
	 And intX > intDivLeft And intX < intDivRight Then
'Do nothing
	 Else
	 div.style.display = "none"
	 End If
 
	End Sub
 
	Sub FindIt()
	 If document.getElementById("chkGoogle").checked Then
	 window.open "http://www.google.com/search?hl=en&q=" & document.getElementById("txtName").innerText
	 Else
	 window.open "http://www.processlibrary.com/directory/?files=" & document.getElementById("txtName").innerText
	 End If
 
	 document.getElementById("mnuContext").style.display = "none"
	End Sub
 
	Sub KillIt()
	 Dim strPID, strRet
	 Dim objSWbemLocator, objWMI, Proc, Procs	 
 
strPID = document.getElementById("txtPID").innerText
document.getElementById("mnuContext").style.display = "none"
 
If msgbox("End this process?", 4) = 6 Then
If strIP <> "" Then
	 Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
	 Set objWMI = objSWbemLocator.ConnectServer(strIP, "root\cimv2", strUser, strPass)
	 Else
	 Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
	 End If
 
		 Set Procs = objWMI.ExecQuery("Select * from Win32_Process Where ProcessID = " & strPID)
 
	 For Each Proc In Procs
	 strRet = Proc.Terminate()
	 Next
 
	 If strRet <> 0 Then msgbox "err - " & strRet
 
	 End If
 
	End Sub
 
 
	'Run program
	Sub RunIt()
 
Dim strExe, strShell
Dim objWMI, objProcess, objProgram
 
strExe = InputBox("Type the name of a program to run.")
 
If trim(strExe) <> "" Then
 
If strIP <> "" Then
RunRemote strExe
Else
Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
End If
 
Set objProcess = objWMI.Get("Win32_Process")
	 Set objProgram = objProcess.Methods_("Create").InParameters.SpawnInstance_
 
objProgram.CommandLine = chr(34) & strExe & chr(34) 
Set strShell = objWMI.ExecMethod("Win32_Process", "Create", objProgram) 
 
End If
 
	End Sub

Code:

 
Function RunRemote(strFile)
 
	 On Error Resume Next
 
	 Dim WshShell
	 Dim RunCode
	 Dim strToRun
 
	 strToRun = Chr(34) & "psexec" & Chr(34) & " \\" & strIP & " -u " & strUser & " -p " & strPass & " -i -e -d " & strFile
 
Set WshShell = CreateObject("WScript.Shell")
RunRemote = WshShell.Run(strToRun, 1, False)
 
End Function
 
 
	'Services
 
	Sub RestartService()
	 Dim strService
 
	 strService = InputBox("Type the name of a service. ('ZFDWM' = Workstation Manager")
 
	 If trim(strService) <> "" Then
	 StopService strService
StartService strService
End If
 
	End Sub
 
	'Start Service
Function StartService(strService)
	 'On Error Resume Next
 
	 Dim objWMI, objService
	 Dim colSer
	 Dim ErrReturn
 
	 StartService = False
 
	If strIP <> "" Then
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMI = objSWbemLocator.ConnectServer(strIP, "root\cimv2", strUser, strPass)
	 Else
Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
End If
 
	 Set colSer = objWMI.ExecQuery("Select * from Win32_Service Where Name = '" & strService & "'")
 
ErrReturn = -1
 
	 For Each objService in colSer
		 ErrReturn = objService.StartService()
	 Next 
 
	 If ErrReturn = 0 Then
		 StartService = True
	 End If
End Function
 
 
'Stop Service
Function StopService(strService)
	 'On Error Resume Next
 
	 Dim objWMI, objService
	 Dim colSer
	 Dim ErrReturn
 
	 StopService = False
 
	If strIP <> "" Then
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMI = objSWbemLocator.ConnectServer(strIP, "root\cimv2", strUser, strPass)
	 Else
Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
End If
 
	 Set colSer = objWMI.ExecQuery("Select * from Win32_Service Where Name = '" & strService & "'")
 
ErrReturn = -1
 
	 For Each objService in colSer
		 ErrReturn = objService.StopService()
	 Next 
 
	 If ErrReturn = 0 Then
		 StopService = True
	 End If
End Function

Code:

 
 
	Sub SortClick(strHeader)
 
	 If strHeader = strCurrentSort Then 
	 If strDir = " asc" Then
	 strDir = " desc"
	 Else
	 strDir = " asc"
	 End If
	 Else
	 strDir = " asc"
	 End If
 
	 Sort strHeader
 
	End Sub
 
	Function Sort(strHeader)
	 Dim tbl
	 Dim DataList
	 Dim tehRows, I
	 Dim nRow, cName, cCPU, cMem
	 Dim strMem	 
 
	 Set tbl = document.getElementById("tblProcess")
	 Set DataList = CreateObject("ADOR.Recordset")
 
	 DataList.Fields.Append "PID", 200, 255
	 DataList.Fields.Append "Name", 200, 255
	 DataList.Fields.Append "CPU", 20, 255
	 DataList.Fields.Append "Memory", 20, 255
 
	 DataList.Open	 
 
tehRows = tbl.rows.length - 1
 
For I = 1 to tehRows
DataList.AddNew
 
DataList("PID") = tbl.rows(I).ID
DataList("Name") = tbl.rows(I).cells(0).innerText
DataList("CPU") = Clng(tbl.rows(I).cells(1).innerText)
 
strMem = tbl.rows(I).cells(2).innerText
strMem = Replace(strMem, ",", "")
strMem = Replace(strMem, "K", "")
 
DataList("Memory") = Clng(strMem)
 
DataList.Update 
Next
 
strCurrentSort = strHeader
DataList.Sort = strHeader & strDir
DataList.MoveFirst
 
ClearTable
 
'Fill Table with sorted Data
Do Until DataList.EOF 
Set nRow = tbl.insertRow(-1)
 
	 Set cName = nRow.insertCell(-1)
	 Set cCPU = nRow.insertCell(-1)
	 Set cMem = nRow.insertCell(-1)
 
		 nRow.onmousedown = GetRef("RowClick")
		 nRow.oncontextmenu = GetRef("NoContext")
		 nRow.ID = DataList.Fields.Item("PID")
 
	 cName.innerText = DataList.Fields.Item("Name")
	 cCPU.innerText = DataList.Fields.Item("CPU")
	 cMem.innerText = FormatNumber(DataList.Fields.Item("Memory"), 0) & " K"
 
DataList.MoveNext
Loop
 
	End Function
 
	Sub ClearTable
	 Dim tbl
	 Dim I
 
	 Set tbl = document.getElementById("tblProcess")
 
	 'Clear Table
For I = 0 to tbl.rows.length - 1
tbl.deleteRow(0)
Next
	End Sub
 
	Sub TogglePause()
 
If document.getElementById("btnPause").value = "Resume" Then
TimerID = window.setInterval("GetProcs", 1000)
document.getElementById("btnPause").value = "Pause"
Else
window.clearInterval(TimerID)
document.getElementById("btnPause").value = "Resume"
End If
 
	End Sub
 
	Sub HighLight(bln)
	 Dim obj
 
	 Set obj = window.event.srcElement
 
	 Do until obj.nodeName = "DIV"
	 Set obj = obj.parentNode
	 Loop
 
	 If bln Then
	 obj.style.backgroundColor = "Highlight"
	 obj.style.Color = "HighlightText"
	 Else
	 obj.style.backgroundColor = ""
	 obj.style.Color = ""
	 End If
 
	End Sub
 
		-->
		</SCRIPT>
	</head>
	<body oncontextmenu="NoContext" bgcolor="ButtonFace">
		<form id="frmExecute">
 
<div id="mnuF" onmouseover='document.getElementById("mnuF").style.borderStyle = "outset"' onmouseout='document.getElementById("mnuF").style.borderStyle = ""' onclick='document.getElementById("mnuFile").style.display = ""' style=" border-width: 1px; position: absolute; cursor: pointer; width: 29px";>File</div>
 
<div id="mnuFile" onmouseout="menu_mouseout" style="border-style: outset; display: none; position: absolute; background-color: Menu; height: 83px; width: 131px; top: 33px; left: 13px; text-align: center;">
<div onmouseout="Highlight(False)" onmouseover="HighLight(True)" style="cursor: pointer" onclick="RunIt"><a>Run</a></div>
<div onmouseout="Highlight(False)" onmouseover="HighLight(True)" style="cursor: pointer" onclick="RestartService"><a>Restart Service</a></div>
<hr />
<div onmouseout="Highlight(False)" onmouseover="HighLight(True)" style="cursor: pointer" onclick="window.close()"><a>Exit</a></div>
</div>
 
			<br />
			<center>			 
			 <div id="divTitle">Currently monitoring: localhost</div>
 
<table id="tblHeader" style="text-align: center; width: 380px;" cellpadding="1" cellspacing="1">
<td onclick='SortClick("Name")' style="cursor: pointer; border-style: outset; background-color: ButtonFace">Process Name</td>
<td onclick='SortClick("CPU")' style="cursor: pointer; border-style: outset; background-color: ButtonFace">CPU</td>
<td onclick='SortClick("Memory")' style="cursor: pointer; border-style: outset; background-color: ButtonFace">Mem Usage</td>
</table>
 
				<div id="divList" style="border-style: inset; background-color: White; height:396px; width:380px; overflow:auto;">
			 <table id="tblProcess" style="background-color: White; text-align: center; width: 350px;" cellpadding="1" cellspacing="1"></table>
				</div>
 
				<input id="txtIP" type="text" value="192.168.1." />
				<input id="btnGo" type="button" value="Go" />
				<input id="btnPause" type="button" value="Pause" onclick="TogglePause" />
</center>
 
<div id="mnuContext" onmouseout="menu_mouseout" style="border-style: outset; display: none; position: absolute; background-color: Menu; top: 502; left: 597; width: 100; height: 90px; text-align: center;">
 
<div onmouseout="Highlight(False)" onmouseover="HighLight(True)" title="Search with Google" style="cursor: pointer;" onclick='document.getElementById("chkGoogle").checked = Not document.getElementById("chkGoogle").checked'>
<input onclick="window.event.cancelBubble = True" id="chkGoogle" type="checkbox"/><a style="font-size: xx-small" >Use Google</a>
</div>
 
<div onmouseout="Highlight(False)" onmouseover="HighLight(True)" onclick="FindIt" title="Look it up" style="cursor: pointer;">
<span style="font-size: xx-small">
Name:<a id="txtName"></a>
<br />
PID:<a id="txtPID"></a>
</span>
</div>
 
<hr />
 
<div id="btnKill" onmouseout="Highlight(False)" title="End the process" style="cursor: pointer;" onmouseover="HighLight(True)" onclick="KillIt">
<a>Kill It</a>
</div>
</div>
		</form>
	</body>
</html>