<html>
<head>
<script language="vbscript">
Option Explicit
Dim intRefreshRt : intRefreshRt = 30000 '30 Second Refresh Rate in Milliseconds
Sub Window_OnLoad
' On Error Resume Next
Dim iTimerID
window.document.title = "Scripts currently running on: " & GetLocCompName 'set title with local computername by calling function
window.document.getElementById("PCName").InnerHTML = GetLocCompName 'set computername in header <h1> tag
GetScripts
window.document.getElementById("strComputerName").focus 'focus to the inputbox to specify another pc
iTimerID = window.setInterval("GetScripts", intRefreshRt)
End Sub
Sub GetScripts
' On Error Resume Next
Dim wmiQuery, colItems, objItem, strCmdLine, strOutput, intPID, strComputer
strComputer = UCase(window.document.getElementById("strComputerName").Value) 'get computername from input box
If strComputer = "" Or strComputer = GetLocCompName Or strComputer = "LOCALHOST" Or strComputer = "127.0.0.1" Or strComputer = "." Then
strComputer = GetLocCompName 'if input box is empty, use local computer name by calling a Function
window.document.getElementById("strComputerName").Value = strComputer
window.document.getElementById("PCName").innerHTML = strComputer & " (Local)"
Else
window.document.getElementById("PCName").innerHTML = strComputer 'set computer name in header if different from local
End If
If Ping(strComputer) = False Then 'test connectivity with ping Function
alert "Computer specified is unreachable!!"
window.document.getElementById("strComputerName").Value = "" 'reset input box if the machine is unreachable
Exit Sub
End If
window.document.title = "Scripts currently running on: " & strComputer 'set title to new computer name if different from local
window.document.getElementById("TimeStamp").innerHTML = Now()
wmiQuery = "Select * From Win32_Process Where (Name='wscript.exe' Or Name='cscript.exe' Or Name='mshta.exe')" 'define WMI query
' begin building table
strOutput = "<table border=""0"" width=""100%"" id=""table1""><tr>" & _
"<td><b>Script Name:</b></td><td><b>Process ID:</b></td>" & _
"<td><b>Running Since:</b></td><td><b>Action</b></td></tr>"
On Error Resume Next
Set colItems = objWMI(strComputer, wmiQuery) 'retrieve WMI collection by calling the objWMI function
If IsEmpty(colItems) Then
window.document.getElementById("RScripts").innerHTML = ""
Exit Sub
End If
On Error GoTo 0
For Each objItem In colItems 'loop through the collection
strCmdLine = Replace(Replace(objItem.CommandLine, Chr(34), ""), "cscript.exe ", "")
strCmdLine = Trim(strCmdLine) 'format string to pull out the script name being run
intPID = objItem.ProcessID
strOutput = strOutput & "<tr><td title='" & objItem.CommandLine & "'>" & Right(strCmdLine, Len(strCmdLine) - InStrRev(strCmdLine, "\")) & _
"</td><td>" & intPID & "</td><td>" & ConvertDT(objItem.CreationDate) & "</td>" & _
"<td><input type=""button"" value=""Terminate"" onclick=""KillScript('" & intPID & "')""></td></tr>"
Next
window.document.getElementById("RScripts").innerHTML = strOutput & "</table>" 'display data
Set colItems = Nothing
End Sub
Sub KillScript(intPID)
' On Error Resume Next
Dim wmiQuery, colItems, objItem, strResponse, strComputer
strResponse = MsgBox("Are you sure you want to terminate the script with Process ID of: " & intPID & "?", 36, "Confirm Script Termination")
If strResponse = vbNo Then Exit Sub
strComputer = UCase(window.document.getElementById("strComputerName").Value)
If strComputer = "" Or strComputer = GetLocCompName Or strComputer = "LOCALHOST" Or strComputer = "127.0.0.1" Or strComputer = "." Then
strComputer = GetLocCompName 'if input box is empty, use local computer name by calling a function
End If
wmiQuery = "Select * From Win32_Process Where ProcessID = " & intPID 'define WMI query
Set colItems = objWMI(strComputer, wmiQuery)'retrieve WMI collection by calling the objWMI function
For Each objItem In colItems
objItem.Terminate 'terminate process with PID specified
Next
Set colItems = Nothing
GetScripts 'refresh the process list displayed
End Sub
Function GetLocCompName
' On Error Resume Next
Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
GetLocCompName = UCase(objNetwork.ComputerName) 'get local computer name
Set objNetwork = Nothing
End Function
Function Ping(strRmtPC)
' On Error Resume Next
Dim wmiQuery, objPing, objStatus, blnStatus
wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strRmtPC & "'"
Set objPing = objWMI(".", wmiQuery)
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
blnStatus = False 'Not Reachable
Else
blnStatus = True 'Reachable
End If
Next
Ping = blnStatus
Set objPing = Nothing
End Function
Function objWMI(strComputer, strWQL)
' On Error Resume Next
Dim wmiNS, objWMIService, objSWbemLocator, objSWbemServices
Dim strUID, strPwd
wmiNS = "\root\cimv2"
strUID = window.document.getElementById("strUserID").value
strPwd = window.document.getElementById("strPass").value
If strComputer = "." Or strComputer = GetLocCompName Then
strUID = ""
strPwd = ""
End If
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
On Error Resume Next
Set objSWbemServices = objSWbemLocator.ConnectServer _
(strComputer, wmiNS, strUID, strPwd)
Select Case Err.Number
Case -2147024891
window.document.getElementById("accessdenied").innerHTML = "Access Denied! Please check the credentials supplied."
Exit Function
End Select
On Error GoTo 0
window.document.getElementById("accessdenied").innerHTML = ""
Set objWMI = objSWbemServices.ExecQuery(strWQL)
Set objSWbemServices = Nothing
Set objSWbemLocator = Nothing
End Function
Function ConvertDT(strDT)
' On Error Resume Next
Dim objTime: Set objTime = CreateObject("WbemScripting.SWbemDateTime")
objTime.Value = strDT
ConvertDT = objTime.GetVarDate 'convert UTC to Standard Time
Set objTime = Nothing
End Function
</script>
<hta:application
applicationname="Get Running Scripts"
border="dialog"
borderstyle="normal"
caption="Get Running Scripts"
contextmenu="yes"
icon="images\icon.ico"
maximizebutton="yes"
minimizebutton="yes"
navigable="yes"
scroll="no"
selection="yes"
showintaskbar="yes"
singleinstance="yes"
sysmenu="yes"
version="1.0"
windowstate="normal"
>
<style type="text/css">
td {
font-family: "Times New Roman", Times, serif;
font-size: 18px;
font-style: normal;
font-weight: normal;
font-variant: normal;
color: #FFFFFF;
vertical-align: top;
}
.access {
color:#ffffff;
font-size:20px;
font-family:"Times New Roman", Times, serif;
}
</style>
</head>
<body bgcolor="#272936" style="overflow:auto;color:#FFFFFF;">
<div align="left">
<h1>VBScripts Currently Running on: <span id="PCName"></span></h1>
Connect To: <input type="text" id="strComputerName" onKeyPress="if window.event.keycode = 13 then GetScripts">
UserName: <input type="text" id="strUserID" value=""> Password: <input type="password" id="strPass" value=""> <input type="submit" value="Connect" onclick="GetScripts">
<br /><br />
Last Updated: <span id="TimeStamp"></span>
</div>
<div align="center" class="access"><span id="accessdenied"></span></div>
<br />
<span id="RScripts"></span>
</body>
</html>
