×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript FAQ

WMI

How can I tell what scripts are running locally/remotely? by dm4ever
Posted: 4 Feb 07 (Edited 4 Feb 07)

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).

Original Version:

CODE

<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 = "" 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">&nbsp;&nbsp;<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.

CODE

<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">&nbsp;&nbsp;
UserName: <input type="text" id="strUserID" value="">&nbsp;&nbsp; Password: <input type="password" id="strPass" value="">&nbsp;&nbsp; <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:

CODE

Function ConvertDT(strDT)
    ConvertDT = _
        CDate(Mid(strDT, 5, 2) &_
        "/" &_
        Mid(strDT, 7, 2) &_
        "/" &_
        Left(strDT, 4) &_
        " " &_
        Mid (strDT, 9, 2) &_
        ":" &_
        Mid(strDT, 11, 2) &_
        ":" &_
        Mid(strDT, 13, 2))
End Function

Back to VBScript FAQ Index
Back to VBScript Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close