Seems there are some admins that have scripts running in the background monitoring or gathering information they need or want. I've seen some posts where people want to know what scripts are running since you really can't tell by looking in task manager; all you see is wscript.exe or cscript.exe and maybe the PID. So I was at the end of running a fever and wanted to do something to take my mind off feeling ill and so I put this HTA together. I apologize if someone has already posted something like this. Also, forgive me if I didn't comment it well or didn't format it in the manner you are accustomed to (I have my preferred method of structuring my scripts that makes it easy for me to read).
Save the code below into a HTA file (i.e. "Get Running Scripts.hta") It uses WMI so you need to have Admin rights on the machine you run it on or query. I've only tested the HTA on an XP & 2003 Server box. ConvertDT Function in the example below only work on XP or higher. Look at the end for a replacement function that should work on Win2k.
NOTE: The commandline property of the Win32_Process class was introduced with WinXP/Win2k3 so you can only see the name of the script running on those boxes. Also, the commandline property will return NULL if the HTA is launched using the RUNAS command (thanks to kirrilian at visualbasicscript.com for discovering this bug).
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 = "" Then strComputer = GetLocCompName 'if input box is empty, use local computer name by calling a function 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("PCName").innerHTML = strComputer 'set computer name in header if different from local window.document.getElementById("TimeStamp").innerHTML = Now()
wmiQuery = "Select * From Win32_Process Where (Name='wscript.exe' Or Name='cscript.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>"
Set colItems = objWMI(strComputer, wmiQuery) 'retrieve WMI collection by calling the objWMI function
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 = "" Then strComputer = GetLocCompName 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
wmiNS = "\root\cimv2"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & wmiNS) 'connect to WMI Set objWMI = objWMIService.ExecQuery(strWQL) 'execute query Set objWMIService = 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; } </style> </head> <body bgcolor="#272936" style="overflow:auto;color:#FFFFFF;"> <div align="center"> <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"> <input type="button" value="Connect" onclick="GetScripts"> <br /><br /> Last Updated: <span id="TimeStamp"></span> </div> <br /> <span id="RScripts"></span> </body> </html>
Version that accepts alternate credentials (thanks to NssB's at visualbasicscript.com for his contribution): NOTE: You can NOT provide alternate credentials for the local machine. Queries will be executed using your credentials (impersonate) if no username/password is provided.
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
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>
UPDATED: 1/12/2007 Date/Time Conversition Function for Win2k, just replace the ConverDT function in the example above with this one: