Remote PC Viewer

Author	Message

Wakawaka

Total Posts : 456
Scores: 23
Reward points : 0
Joined: 8/27/2009
Status: offline

Remote PC Viewer Thursday, April 15, 2010 2:39 AM (permalink)

0

So bored one day, looking through these fourms I found a decent amount of good information for an overall "manager" script. Just thought I would share what I have now and see if anyone has anything to add to anything to make it more effiecent.

<html>
     <head>
     <title>Remote Manager</title>
     <HTA:APPLICATION
         APPLICATIONNAME = "Null"
   BORDER = "thin"
   CONTEXTMENU = "no"
   SHOWINTASKBAR = "yes"
   SINGLEINSTANCE = "yes"
   SYSMENU = "yes"
   SCROLL = "no"
   >

<style type="text/css">
   body{
    background-color: #D3D3D3;
   }
   button{
    width: 100%;
   }
   div.Wrapper{
    position: absolute;
    width: 100%;
    height: 100%;
    overflow: auto;
   }
   div.Tasks{
    overflow: visible;
    float: left;
    width: 29%;
   }
   div.Info{
    float: right;
    width: 70%;
   }
   label{
    font-weight: bold;
   }
   label.stats, td.stats, legend.stats{
    color: blue;
   }
   td.monitor{
    color: red;
   }
</style>

<script language = "vbscript">
   Const RETURN_IMMEDIATELY = &H10
   Const FORWARD_ONLY = &H20
   Const HKEY_LOCAL_MACHINE = &H80000002
   Const NO_USER = "No logged on user"
   Const WS_SHOW = 1
   Const FOR_WRITING = 2

   Dim iNumberOfProcessors 'As Integer
   Dim iTotalRAM 'As Integer
   Dim bTimersActive 'As Boolean
   Dim aTimerIDs() 'As Array

   '*************************************************************
   '*Subprocedure Window_OnLoad()
   '*Summary:  The code contained in this sub will execute
   '*    automatically when the .HTA is opened
   '*************************************************************
   Sub Window_OnLoad()
    CenterWindow 825, 480
    Call DisableOptions()
    txtComputerOrIP.Focus()
    bTimersActive = False
   End Sub


   '*************************************************************
   '*Subprocedure CenterWindow(iWidth, iHeight)
   '*Summary:  Centers and resizes the window with the
   '*    given parameters
   '*
   '*Input:  iWidth, iHeight
   '*************************************************************
   Sub CenterWindow(iWidth, iHeight)
    self.ResizeTo iWidth, iHeight
    self.MoveTo (screen.Width - iWidth)/2, (screen.Height - iHeight)/2
   End Sub


   '*************************************************************
   '*Subprocedure DisableOptions()
   '*Summary:  Disables all button options
   '*************************************************************
   Sub DisableOptions()
    BrowseDrive.Disabled = True
    DisplayServices.Disabled = True
    DisplayProcesses.Disabled = True
    DisplayPrograms.Disabled = True
    SMSLoad.Disabled = True
    Export.Disabled = True
   End Sub


   '*************************************************************
   '*Subprocedure EnableOptions()
   '*Summary:  Enables options based on the system query
   '*************************************************************
   Sub EnableOptions()
    BrowseDrive.Disabled = False
    DisplayServices.Disabled = False
    DisplayProcesses.Disabled = True
    DisplayPrograms.Disabled = False
    SMSLoad.Disabled = False
    Export.Disabled = False
   End Sub


   '*************************************************************
   '*Subprocedure QuerySystem(sComputer)
   '*Summary:  Queries the remote system for information
   '*    and writes the results to the screen
   '*
   '*Input:  sComputer
   '*************************************************************
   Sub QuerySystem(sComputer)
    Dim oWMI, oReg 'As Object
    Dim isPingable 'As Boolean
    Dim sUser, sSessionType, sPwrStatus, sNowVersion 'As String
    Dim cHardware, cNetwork 'As Class

    Call ClearResults()
    document.title = "Remote Manager - " & sComputer
    isPingable = Ping(sComputer)

    If isPingable Then
     On Error Resume Next
     Set oWMI = GetWMIConnection(sComputer)

     If Err.Number = 0 Then
      Set oReg = GetRegConnection(sComputer)

      sUser = GetUser(oWMI)
      sSessionType = GetSessionType(oReg, oWMI, sUser)
      Set cHardware = QueryHardware(oWMI)
      Set cNetwork = QueryNetworkInfo(oWMI)
      sNowVersion = GetNowVersion(oReg)

      ComputerName.InnerHTML = cHardware.mComputer
      PowerStatus.InnerHTML = "<font color='green'>█</font> On-Line"
      User.InnerHTML = sUser
      SessionType.InnerHTML = sSessionType

      With cHardware
       CPU.InnerHTML = .mCPU
       RAM.InnerHTML = .mRAM
       HDD.InnerHTML = .mDisks
       Model.InnerHTML = .mModel
       Serial.InnerHTML = .mSerial
      End With

      With cNetwork
       ConnectionType.InnerHTML = .mConnectionType
       DHCP.InnerHTML = .mDHCP
       IPAddress.InnerHTML = .mIPAddresses
       MACAddress.InnerHTML = .mMACAddresses
      End With

      Call EnableOptions()
     Else
      ComputerName.InnerHTML = sComputer
      PowerStatus.InnerHTML = "<font color='black'>█</font> Access Denied"

      Err.Clear
      Call DisableOptions()
     End If
    ElseIf Err.Number <> 0 Then
     ComputerName.InnerHTML = sComputer
     PowerStatus.InnerHTML = "<font color='black'>█</font> Unknown"

     Err.Clear
     Call DisableOptions()
    Else
     ComputerName.InnerHTML = sComputer
     PowerStatus.InnerHTML = "<font color='red'>█</font> Off-Line"

     Call DisableOptions()
    End If
   End Sub


   '*************************************************************
   '*Subprocedure ClearResults()
   '*Summary:  Removes all data from the screen of previous
   '*    scans
   '*************************************************************
   Sub ClearResults()
    ComputerName.InnerHTML = "N/A"
    PowerStatus.InnerHTML = "N/A"
    User.InnerHTML = "N/A"
    SessionType.InnerHTML = "N/A"
    CPU.InnerHTML = "N/A"
    RAM.InnerHTML = "N/A"
    HDD.InnerHTML = "N/A"
    Model.InnerHTML = "N/A"
    Serial.InnerHTML = "N/A"
    ConnectionType.InnerHTML = "N/A"
    DHCP.InnerHTML = "N/A"
    IPAddress.InnerHTML = "N/A"
    MACAddress.InnerHTML = "N/A"

    Call ClearPerformanceStats()
   End Sub


   '*************************************************************
   '*Subprocedure ClearPerformanceStats()
   '*Summary:  Resets the "Performance" data
   '*************************************************************
   Sub ClearPerformanceStats()
    Load.InnerHTML = "---%"
    RAMUsage.InnerHTML = "----"
   End Sub

   '*************************************************************
   '*Subprocedure UpdateConnectionStatus()
   '*Summary:  Updates the power status of the remote computer
   '*    and is used on a timer to update every 15 sec.
   '*    If the current status was "Off-line", the
   '*    machine will be queried when "On-Line"
   '*************************************************************
   Sub UpdateConnectionStatus()
    Dim isPingable 'As Boolean
    Dim sComputer, sDisplayStatus 'As String

    Err.Clear
    sComputer = ComputerName.InnerHTML
    sCurrentStatus = PowerStatus.InnerHTML

    If sComputer = "" Or sComputer = "N/A" Or InStr(UCase(sCurrentStatus), "ACCESS DENIED") Then
     'No computer defined or access has been denied, skip
    Else
     isPingable = Ping(sComputer)

     If isPingable Then
      If InStr(UCase(sCurrentStatus), "OFF-LINE") Then
       sDisplayStatus = "<font color='green'>█</font> On-Line"
       QuerySystem(sComputer)
      Else
       sDisplayStatus = "<font color='green'>█</font> On-Line"
      End If
     ElseIf Err.Number <> 0 Then
      sDisplayStatus = "<font color='black'>█</font> Unknown"
     Else
      sDisplayStatus = "<font color='red'>█</font> Off-Line"
     End If

     PowerStatus.InnerHTML = sDisplayStatus
    End If
   End Sub


   '*************************************************************
   '*Subprocedure GetPerformanceStats()
   '*Summary:  Updates the CPU and RAM usage of the remote computer
   '*    and is used on a timer to update every 5 sec.
   '*    Will only query computers with "On-Line" status
   '*************************************************************
   Sub GetPerformanceStats()
    Dim sComputer 'As String
    Dim oWMI 'As Object

    dLoad = 0
    If InStr(UCase(PowerStatus.InnerHTML), "ON-LINE") Then
     sComputer = ComputerName.InnerHTML
     Set oWMI = GetWMIConnection(sComputer)

     Load.InnerHTML = LoadPercentage(oWMI)
     RAMUsage.InnerHTML = MemoryUsage(oWMI)
    Else
     Call ClearPerformanceStats()
    End If
   End Sub


   '*************************************************************
   '*Function LoadPercentage()
   '*Summary:  Queries the CPU for the total amount of load on
   '*    the processor
   '*
   '*Input:  oWMI
   '*Output:  Current load percentage of the CPU
   '*************************************************************
   Function LoadPercentage(oWMI)
    Dim oProcessor 'As Object
    Dim sQuery 'As String
    Dim colProcessors 'As Collection
    Dim dLoad 'As Decimal

    sQuery = "SELECT LoadPercentage FROM Win32_Processor"


    Set colProcessors = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oProcessor In colProcessors
     dLoad = dLoad + oProcessor.LoadPercentage
    Next
    LoadPercentage = Round(dLoad/iNumberOfProcessors) & "%"
   End Function


   '*************************************************************
   '*Function MemoryUsage()
   '*Summary:  Queries the OS for free physical memory
   '*    and subtracts it from total to get usage
   '*
   '*Input:  oWMI
   '*Output:  Amount of memory in use (MiB)
   '*************************************************************
   Function MemoryUsage(oWMI)
    Dim colOS 'As Collection
    Dim oOS ' As Object
    Dim sQuery 'As String
    Dim iFreeRAM 'As Integer

    sQuery = "SELECT FreePhysicalMemory FROM Win32_OperatingSystem"
    Set colOS = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oOS In colOS
     iFreeRAM = oOS.FreePhysicalMemory
    Next

    iFreeRAM = iFreeRAM * 1024 'FreePhyscialMemory returns KB, convert to Bytes

    MemoryUsage = ConvertToMiB(iTotalRAM - iFreeRAM, 0)
   End Function


   '*************************************************************
   '*Function Ping(sComputer)
   '*Summary:  Attempts to ping the remote computer
   '*
   '*Input:  sComputer
   '*Output:  True\False
   '*************************************************************
   Function Ping(sComputer)
    On Error Resume Next

    Dim sQuery 'As String
    Dim oQuerySearch, oPing 'As Object

    sQuery = "SELECT StatusCode FROM Win32_PingStatus WHERE Address = '" & sComputer & "'"

    Set oQuerySearch = GetObject("winmgmts:\\").ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oPing in oQuerySearch
     If oPing.StatusCode = 0 Then
      Ping = True
     Else
      Ping = False
     End If
    Next
   End Function


   '*************************************************************
   '*Function GetWMIConnection(sComputer)
   '*Summary:  Attempts to connect to the remote computer's
   '*    WMI object
   '*
   '*Input:  sComputer
   '*Output:  WMI Object
   '*************************************************************
   Function GetWMIConnection(sComputer)
    On Error Resume Next

    Set GetWMIConnection = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & _
            sComputer & "/root/cimv2")
   End Function


   '*************************************************************
   '*Function GetRegConnection(sComputer)
   '*Summary:  Connects to the remote computer's registry
   '*    object
   '*
   '*Input:  sComputer
   '*Output:  Registry Object
   '*************************************************************
   Function GetRegConnection(sComputer)
    Set GetRegConnection = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
            sComputer & "\root\default:StdRegProv")
   End Function


   '*************************************************************
   '*Function GetUser(oWMI)
   '*Summary:  Queries the remote system for the logged on
   '*    user
   '*
   '*Input:  oWMI
   '*Output:  Owner of the 'explorer.exe' process
   '*************************************************************
   Function GetUser(oWMI)
    Dim sQuery, sUser, sDomain 'As String
    Dim colQuery 'As Collection
    Dim oProcess 'As Object

    sQuery = "SELECT Name FROM Win32_Process WHERE Name = 'explorer.exe'"

    Set colQuery = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oProcess In colQuery
     oProcess.GetOwner sUser, sDomain
    Next

    If sUser <> "" Then
     GetUser = UCase(sUser)
    Else
     GetUser = NO_USER
    End If
   End Function


   '*************************************************************
   '*Function GetSessionType(oReg, oWMI, sUser)
   '*Summary:  Gets the logon user's SID and checks how they
   '*    logged into the system
   '*
   '*Input:  oReg, oWMI, sUser
   '*Output:  How user is logged in (local/remote)
   '*************************************************************
   Function GetSessionType(oReg, oWMI, sUser)
    Const HKEY_USERS = &H80000003

    Dim aSubKeys 'As Array()
    Dim colAccounts 'As Collection
    Dim oAccount 'As Object
    Dim sSessionKey, sSessionType 'As String

    If sUser <> "" Or sUser <> NO_USER Then
     sUserSID = GetUserSID(oWMI)
     sSessionKey = sUserSID & "\Volatile Environment"
     oReg.GetStringValue HKEY_USERS, sSessionKey, "SESSIONNAME", sSessionType
     If UCase(sSessionType) = "CONSOLE" Then
      GetSessionType = "Local"
     Else
      GetSessionType = "Remote"
     End If
    Else
     GetSessionType = "N/A"
    End If
   End Function


   '*************************************************************
   '*Function GetUserSID(oWMI)
   '*Summary:  Retrieves the SID of the user owning the
   '*    'explorer.exe' process
   '*
   '*Input:  oWMI
   '*Output:  Owner's SID of the 'explorer.exe' process
   '*************************************************************
   Function GetUserSID(oWMI)
    Dim sQuery, sUserSID 'As String
    Dim colProcess 'As Collection

    sQuery = "SELECT * FROM Win32_Process WHERE Name = 'explorer.exe'"
    Set colProcess = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oProcess In colProcess
     oProcess.GetOwnerSID sUserSID
    Next

    GetUserSID = sUserSID
   End Function


   '*************************************************************
   '*Function QueryHardware(oWMI)
   '*Summary:  Queries the remote system for multiple hardware
   '*    related items
   '*
   '*Input:  oWMI
   '*Output:  CPU, RAM, HDD, Model, Serial, & computer name
   '*************************************************************
   Function QueryHardware(oWMI)
    Dim sQuery 'As String
    Dim cHardware 'As Class
    Dim colCompSys, colDisks 'As Collection
    Dim iFreeDsk, iTotalDsk 'As Integer
    Dim oItem, oDisk 'As Object

    Set cHardware = New Hardware

    'Query For CPU Name
    sQuery = "SELECT Name FROM Win32_Processor"
    Set colProcessor = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oItem In colProcessor
     cHardware.mCPU = oItem.Name
    Next

    'Query for Model, Name, Total RAM, & Number of processors
    sQuery = "SELECT Name, Model, TotalPhysicalMemory, NumberOfProcessors FROM Win32_ComputerSystem"
    Set colCompSys = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oItem In colCompSys
     With oItem
      cHardware.mComputer = .Name
      cHardware.mModel = Trim(.Model)
      cHardware.mRAM = ConvertToMiB(.TotalPhysicalMemory, 0) & " MiB"

      iNumberOfProcessors = .NumberOfProcessors
      iTotalRAM = .TotalPhysicalMemory
     End With
    Next

    'Query for free & total disk space
    sQuery = "SELECT Name, FreeSpace, Size FROM Win32_LogicalDisk WHERE DriveType = '3'"
    Set colDisks = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oDisk In colDisks
     With oDisk
      sDriveName = .Name
      iFreeDsk = ConvertToGiB(.FreeSpace, 2)
      iTotalDsk = ConvertToGiB(.Size, 2)
     End With
     sDriveInfo = sDriveInfo & sDriveName & " " & iFreeDsk & "/" & iTotalDsk & " GiB; "
    Next
    cHardware.mDisks = sDriveInfo

    'Query for serial number
    sQuery = "SELECT SerialNumber FROM Win32_BIOS"
    Set colBIOS = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oItem In colBIOS
     cHardware.mSerial = oItem.SerialNumber
    Next

    Set QueryHardware = cHardware
   End Function


   '*************************************************************
   '*Function QueryNetworkInfo(oWMI)
   '*Summary:  Queries the remote system for multiple network
   '*    related items
   '*
   '*Input:  oWMI
   '*Output:  Connection Type, DHCP status, IP, & MAC
   '*************************************************************
   Function QueryNetworkInfo(oWMI)
    Dim cNetwork 'As Class
    Dim aIPAddress 'As Array
    Dim colNIC 'As Collection
    Dim oNIC 'As Object
    Dim sQuery, sDHCP, sIPAddress, sMACAddress, sConnectionType, sX, sIP 'As Sting

    Set cNetwork = New NetworkProperties

    sQuery = "SELECT DHCPEnabled, Index, IPAddress, MACAddress FROM " & _
       "Win32_NetworkAdapterConfiguration WHERE IPEnabled = 'True'"

    Set colNIC = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oNIC In colNIC
     With oNIC
      For Each sIP In .IPAddress
       If sIP = "" Or sIP = "0.0.0.0" Or InStr(sIPAddress, sIP) Then
        'Invalid IP Address; Skip it
       Else
        sX = GetConnectionType(oWMI, .Index)
        sConnectionType = sConnectionType & sX & "; "
        sDHCP = sDHCP & .DHCPEnabled & "; "
        sIPAddress = sIPAddress & sIP & "; "
        sMACAddress = sMACAddress & .MACAddress & "; "
       End If
      Next
     End With
    Next

    With cNetwork
     .mDHCP = sDHCP
     .mIPAddresses = sIPAddress
     .mMACAddresses = sMACAddress
     .mConnectionType = sConnectionType
    End With

    Set QueryNetworkInfo = cNetwork
   End Function


   '*************************************************************
   '*Function GetConnectionType(oWMI, iIndex)
   '*Summary:  Retrieves the connection name as found in
   '*    the "Network Connections" window
   '*
   '*Input:  oWMI, iIndex
   '*Output:  Name of the connection device
   '*************************************************************
   Function GetConnectionType(oWMI, iIndex)
    Dim sQuery 'As String
    Dim colNetAdapter 'As Collection

    sQuery = "SELECT NetConnectionID FROM Win32_NetworkAdapter WHERE Index = '" & iIndex & "'"
    Set colNetAdapters = oWMI.ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)

    For Each oNetAdapter In colNetAdapters
     If oNetAdapter.NetConnectionID = "" Then
      GetConnectionType = "Undefined"
     Else
      GetConnectionType = oNetAdapter.NetConnectionID
     End If
    Next
   End Function


   '*************************************************************
   '*Function ConvertToMiB(iValue, iPercision)
   '*Summary:  Converts the given number to "MiB" form
   '*
   '*Input:  iValue, iPercision
   '*Output:  A number converted to "Mega-bytes" form
   '*************************************************************
   Function ConvertToMiB(iValue, iPercision)
    ConvertToMiB = Round(iValue / 1024 ^ 2, iPercision)
   End Function


   '*************************************************************
   '*Function ConvertToGiB(iValue, iPercision)
   '*Summary:  Converts the given number to "GiB" form
   '*
   '*Input:  iValue, iPercision
   '*Output:  A number converted to "Giga-bytes" form
   '*************************************************************
   Function ConvertToGiB(iValue, iPercision)
    ConvertToGiB = Round(iValue / 1024 ^ 3, iPercision)
   End Function


   '*************************************************************
   '*Subprocedure AddTimer(sSubOrFunction, iInterval)
   '*Summary:  Adds a new timer for the HTA to re-run code
   '*    blocks; keeps track of timer IDs so they can
   '*    be cancelled via the StopTimers_OnClick() or
   '*    started via the StartTimers_OnClick() sub
   '*
   '*Input:  sSubOrFunctionName, iInterval
   '*************************************************************
   Sub AddTimer(sSubOrFunctionName, iInterval)
    On Error Resume Next
    Dim iLength 'As Integer

    iLength = UBound(aTimerIDs) + 1
    ReDim Preserve aTimerIDs(iLength)
    aTimerIDs(iLength) = Window.setInterval(sSubOrFunctionName, iInterval)
    Err.Clear
   End Sub


   '*************************************************************
   '*Subprocedure StartTimers()
   '*Summary:  Contains code that adds timers as well as the
   '*    blocks of code called and intervals to run at
   '*************************************************************
   Sub StartTimers()
    Call AddTimer("UpdateConnectionStatus", 20000)
    Call AddTimer("GetPerformanceStats", 5000)
   End Sub


   '*************************************************************
   '*Subprocedure StopTimers()
   '*Summary:  Contains code that ends timers as well as
   '*    clear the aTimerID array to keep space free
   '*************************************************************
   Sub StopTimers()
    Dim iID 'As Integer

    For Each iID In aTimerIDs
     Window.clearInterval(iID)
    Next

    Erase aTimerIDs

    Call ClearPerformanceStats()
   End Sub

   '*************************************************************
   '*Function SortDictionary(oDictionary)
   '*Summary:  Used to sort a dictionary object by adding the
   '*    key to a collection list to sort and returns
   '*    a sorted array for use agaist the dictionary
   '*    object
   '*
   '*Input:  oDictionary
   '*************************************************************
   Function SortDictionary(oDictionary)
    Dim oArrayList 'As Object
    Dim sKey 'As String
    Set oArrayList = CreateObject("System.Collections.ArrayList")

    For Each sKey in oDictionary
     oArrayList.Add sKey
    Next

    oArrayList.Sort

    SortDictionary = oArrayList.ToArray()
   End Function


   '*************************************************************
   '*Function CreateIEObject()
   '*Summary:  Returns a IE object; used to create cleaner
   '*    subs/functions
   '*
   '*Input:  iWidth, iHeight
   '*Output:  Internet Explorer application object
   '*************************************************************
   Function CreateIEObject(iWidth, iHeight)
    Dim oIE 'As Object

    Set oIE = CreateObject("InternetExplorer.Application")

    With oIE
     .Navigate "About:blank"
     .ToolBar = True
     .AddressBar = False
     .StatusBar = False
     .Width = 800
     .Height = 600
    End With

    Set CreateIEObject = oIE
   End Function


   '*************************************************************
   '*Subprocedure CreateLogData()
   '*Summary:  Writes the data to the 'Export Query' log
   '*
   '*Input:  oLog
   '*************************************************************
   Sub CreateLogData(oLog)
    Dim sStatus 'As String

    sStatus = PowerStatus.InnerHTML
    If InStr(UCase(sStatus), "ON-LINE") Then
     sStatus = "On-Line"
    Else
     sStatus = "Off-Line"
    End If

    With oLog
     .WriteLine "Query Report"
     .WriteLine Now()
     .WriteLine String(40, "-")
     .WriteLine "Computer Name: " & vbTab & vbTab & ComputerName.InnerHTML
     .WriteLine "Status: " & vbTab & vbTab & sStatus
     .WriteLine "Logged On: " & vbTab & vbTab & User.InnerHTML
     .WriteLine "Session Type: " & vbTab & vbTab & SessionType.InnerHTML
     .WriteLine "CPU: " & vbTab & vbTab & vbTab & CPU.InnerHTML
     .WriteLine "Memory: " & vbTab & vbTab & RAM.InnerHTML
     .WriteLine "HDD: " & vbTab & vbTab & vbTab & HDD.InnerHTML
     .WriteLine "Model: " & vbTab & vbTab & vbTab & Model.InnerHTML
     .WriteLine "Serial: " & vbTab & vbTab & Serial.InnerHTML
     .WriteLine "Net Type: " & vbTab & vbTab & ConnectionType.InnerHTML
     .WriteLine "DHCP Enabled: " & vbTab & vbTab & DHCP.InnerHTML
     .WriteLine "IP Address(es): " & vbTab & IPAddress.InnerHTML
     .WriteLine "MAC Address(es): " & vbTab & MACAddress.InnerHTML
     .WriteLine String(40, "-")
     .WriteLine "Report completed at " & Now()
    End With
   End Sub


   '********************************************
   '*Classes
   '********************************************
   Class Hardware
    Public mComputer
    Public mCPU
    Public mRAM
    Public mDisks
    Public mModel
    Public mSerial
   End Class


   Class NetworkProperties
    Public mDHCP
    Public mIPAddresses
    Public mMACAddresses
    Public mConnectionType
   End Class


   '********************************************
   '*Event Listeners
   '********************************************


   '*************************************************************
   '*Subprocedure BrowseDrive_OnClick()
   '*Summary:  Displays the remote C: drive, if shared
   '*************************************************************
   Sub BrowseDrive_OnClick()
    Dim oWSH 'As Object
    Dim sComputer, sCommand 'As String

    Set oWSH = CreateObject("WScript.Shell")

    sComputer = ComputerName.InnerHTML
    sCommand = "explorer \\" & sComputer & "\C$"

    oWSH.Run sCommand, WS_SHOW, False
   End Sub


   '*************************************************************
   '*Subprocedure DisplayServices_OnClick()
   '*Summary:  Displays the current services of the remote
   '*    computer using the services through the
   '*    Microsoft Management Console
   '*************************************************************
   Sub DisplayServices_OnClick()
    Dim oWSH 'As Object
    Dim sComputer, sCommand 'As String

    Set oWSH = CreateObject("WScript.Shell")

    sComputer = ComputerName.InnerHTML
    sCommand = "services.msc /computer=" & sComputer

    oWSH.Run sCommand, WS_SHOW, False
   End Sub


   '*************************************************************
   '*Subprocedure DisplayPrograms_OnClick()
   '*Summary:  Displays programs registered in the 'Add\Remove
   '*    Programs' window
   '*************************************************************
   Sub DisplayPrograms_OnClick()
    Const APPS_KEY = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

    Dim sComputer, sSubKey 'As String
    Dim oReg, oDictionary 'As Object
    Dim aApps 'As Array

    sComputer = ComputerName.InnerHTML

    Set oDictionary = CreateObject("Scripting.Dictionary")
    Set oReg = GetRegConnection(sComputer)
    oReg.EnumKey HKEY_LOCAL_MACHINE, APPS_KEY, aApps

    Set oIE = CreateIEObject(800, 600)

    'Get Display names from the registry
    For Each sSubKey In aApps
     oReg.GetStringValue HKEY_LOCAL_MACHINE, APPS_KEY & sSubKey, "DisplayName", sAppName
     If Not(IsNull(sAppName)) Then
      If Not(oDictionary.Exists(sAppName)) Then
       oDictionary.Add sAppName, sSubKey
      End if
     End If
    Next

    oIE.document.write "<html><head><title>Installed Programs</title></head><body><b>Installed Programs: " & _
         oDictionary.Count & "</b><br /><table border='1' width=100%><tr><td>" & _
        "<b><center>Application</center></b></td><td><b><center>Version</center></b>" & _
        "</td><td><b><center>Publisher</center></b></td></tr>"

    aAppNames = SortDictionary(oDictionary)

    'After sorting the dictionary object into an array
    'use the keys to retrieve the item (registry sub-key)
    'and the version/publisher
    For Each sKey in aAppNames
     oReg.GetStringValue HKEY_LOCAL_MACHINE, APPS_KEY & oDictionary(sKey), "DisplayVersion", sAppVersion
     oReg.GetStringValue HKEY_LOCAL_MACHINE, APPS_KEY & oDictionary(sKey), "Publisher", sAppPublisher

     oIE.document.write "<tr><td>" & sKey & "</td><td>" & sAppVersion & "</td><td>" & sAppPublisher & "</td></tr>"
    Next

    oIE.document.write "</table></body></html>"
    oIE.Visible = True
   End Sub


   '*************************************************************
   '*Subprocedure SMSLoad_OnClick()
   '*Summary:  Loads the SMS Remote Desktop Control tool
   '*************************************************************
   Sub SMSLoad_OnClick()
    Const SMS_DESKTOP_TOOL = "<SMS Remote tool path (For Installation)>"
    Const SMS_EXE_FOLDER = "C:\remote\"
    Const SMS_TOOL_NAME = "SMSRemoteDesktops.vbs"

    Dim oWSH, oFSO 'As Object
    Dim sComputer, sCommand 'As String

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oWSH = CreateObject("WScript.Shell")

    sComputer = ComputerName.InnerHTML
    sCommand = "WScript " & chr(34) & SMS_EXE_FOLDER & SMS_TOOL_NAME & chr(34) & " " & sComputer

    If oFSO.FolderExists(SMS_EXE_FOLDER) Then
     oWSH.Run sCommand, WS_SHOW, False
    Else
     iResponse = Msgbox("The SMS Remote tool was not found." & vbCrLf & vbCrLf & _
         "Would you like to install them now?", vbYesNo, "SMS Tools")
     If iResponse = 6 Then
      oFSO.CopyFolder SMS_DESKTOP_TOOL, "C:\"

      oWSH.Run sCommand, WS_SHOW, False
     End If
    End If
   End Sub


   '*************************************************************
   '*Subprocedure Export_OnClick()
   '*Summary:  Creates a log file of the data retrieved during
   '*    the system query; General, Hardware, Network,
   '*    & Misc
   '*************************************************************
   Sub Export_OnClick()
    Dim oFSO, oLog, oSaveDialog 'As Object
    Dim sDefaultLogPath, sComputer, sSavePath 'As String

    sComputer = ComputerName.InnerHTML
    sDefaultLogPath = "C:\ExportQuery-" & sComputer & "-" & Year(Now) & Month(Now) & Day(Now) & ".log"

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oSaveDialog = CreateObject("SAFRCFileDlg.FileSave")

    With oSaveDialog
     .FileName = sDefaultLogPath
     .FileType = "Log File (*.log)"
     .OpenFileSaveDlg
    End With

    sSavePath = oSaveDialog.FileName
    If sSavePath = "" Then
     'Cancel button pressed
    Else
     If InStr(sSavePath, ".log") = False Then
      sSavePath = sSavePath & ".log"
     End If

     Set oLog = oFSO.OpenTextFile(sSavePath, FOR_WRITING, True)
     CreateLogData(oLog)
     oLog.Close
    End If
   End Sub


   '*************************************************************
   '*Subprocedure CheckTimers_OnClick()
   '*Summary:  Starts and stops the timer events for the
   '*    remote monitoring functions
   '*************************************************************
   Sub CheckTimers_OnClick()
    If bTimersActive Then
     bTimersActive = False
     Call StopTimers()

     MonitorStatus.InnerHTML = "<font color='red'>██</font>"
     MonitorStatus.Title = "Not monitoring Status and Performance items"
    Else
     bTimersActive = True
     Call StartTimers()

     MonitorStatus.InnerHTML = "<font color='green'>██</font>"
     MonitorStatus.Title = "Monitoring Status and Performance items"
    End If
   End Sub


   '*************************************************************
   '*Subprocedure BodyListener_OnKeyPress()
   '*Summary:  Response to the 'Enter' press to start the
   '*    process of the inital query of a remote
   '*    machine
   '*************************************************************
   Sub BodyListener_OnKeyPress()
    If Window.Event.KeyCode = 13 Then
     If txtComputerOrIp.Value <> "" Then
      QuerySystem UCase(txtComputerOrIP.Value)
     End If
    End If
   End Sub
</script>

<body id="BodyListener">
   <div class="Wrapper" id="Wrapper">
    <div id="Input">
     <label>Name or IP of remote machine:</label>
     <input type="text" id="txtComputerOrIP">
    </div>
    <br />
    <div>
     <div class="Tasks" id="TaskOperations">
      <fieldset>
       <legend>Task Options</legend>
       <table width=100%>
        <tr>
         <td><button id="BrowseDrive">Browse C:</button></td>
        </tr>
        <tr>
         <td><button id="DisplayServices">Services</button></td>
        </tr>
        <tr>
         <td><button id="DisplayProcesses">Processes</button></td>
        </tr>
        <tr>
         <td><button id="DisplayPrograms">Installed Programs</button></td>
        </tr>
        <tr>
         <td><button id="SMSLoad">SMS Remote Desktop</button></td>
        </tr>
        <tr>
         <td><button id="Export">Export Query</button></td>
        </tr>
       </table>
      </fieldset>

      <fieldset>
       <legend class="stats">Performance</legend>
       <table width=100%>
        <tr>
         <td><label class="stats">CPU Usage:</label></td>
         <td id="Load" class="stats">---%</td>
        </tr>
        <tr>
         <td><label class="stats">Memory Usage (M):</label></td>
         <td id="RAMUsage" class="stats">----</td>
        </tr>
        <tr>
         <td><label class="stats">Monitoring:</label></td>
         <td id="MonitorStatus" class="monitor">██</td>
        </tr>
       </table>
       <button id="CheckTimers">Start/End Monitoring</button>
      </fieldset>
     </div>
   </div>

    <div>
     <div class="Info" id="Information">
      <fieldset>
       <legend>General Information</legend>
       <table width=100%>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>Computer Name:</label></td>
         <td id="ComputerName">N/A</td>
        </tr>
        <tr bgcolor="#E5E5E5">
         <td width=135px><label>Status:</label></td>
         <td id="PowerStatus">N/A</td>
        </tr>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>Logged On:</label></td>
         <td id="User">N/A</td>
        </tr>
        <tr bgcolor="#E5E5E5">
         <td width=135px><label>Session Type:</label></td>
         <td id="SessionType">N/A</td>
        </tr>
       </table>
      </fieldset>

      <fieldset>
       <legend>Hardware Information</legend>
       <table width=100%>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>CPU:</label></td>
         <td id="CPU">N/A</td>
        </tr>
        <tr bgcolor="#E5E5E5">
         <td width=135px><label>Memory:</label></td>
         <td id="RAM">N/A</td>
        </tr>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>HDD:</label></td>
         <td id="HDD">N/A</td>
        </tr>
        <tr bgcolor="#E5E5E5">
         <td width=135px><label>Model:</label></td>
         <td id="Model">N/A</td>
        </tr>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>Serial:</label></td>
         <td id="Serial">N/A</td>
        </tr>
       </table>
      </fieldset>

      <fieldset>
       <legend>Network Information</legend>
       <table width=100%>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>Net Type:</label></td>
         <td id="ConnectionType">N/A</td>
        </tr>
        <tr bgcolor="#E5E5E5">
         <td width=135px><label>DCHP Enabled:</label></td>
         <td id="DHCP">N/A</td>
        </tr>
        <tr bgcolor="#A2D2A7">
         <td width=135px><label>IP Address(es):</label></td>
         <td id="IPAddress">N/A</td>
        </tr>
        <tr bgcolor="#E5E5E5">
         <td width=135px><label>MAC Address(es):</label></td>
         <td id="MACAddress">N/A</td>
        </tr>
       </table>
      </fieldset>
     </div>
    </div>
   </div>
</body>
</html>

#1

ebgreen

Total Posts : 8227
Scores: 98
Reward points : 0
Joined: 7/12/2005
Status: online

Re:Remote PC Viewer Thursday, April 15, 2010 5:10 AM (permalink)

0

Thanks for sharing. TLDR though. I will point out that this template:

   '*************************************************************
   '*Subprocedure Blah
   '*Summary: Foo
   '*
   '*Input:  None
   '*Output:  None
   '*************************************************************

Is redundant since by definition a Sub cannot have any output. The template is also not used for all subs and it is not filled out correctly for at least two of the functions. You can debate whether or not code should be commented, but I think it is pretty universally accepted that no comments are better than wrong ones.

"... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
http://www.visualbasicscript.com/m_47117/tm.htm

#2

Wakawaka Total Posts : 456 Scores: 23 Reward points : 0 Joined: 8/27/2009 Status: offline	Re:Remote PC Viewer Thursday, April 15, 2010 6:19 AM (permalink) 0 Thank you, I will update it.
	#3

sun1010 Total Posts : 27 Scores: 0 Reward points : 0 Joined: 1/11/2010 Status: offline	Re:Remote PC Viewer Thursday, June 17, 2010 3:35 PM (permalink) 0 Doesn't seem to connect to the remote servers when run.
	#4

Wakawaka Total Posts : 456 Scores: 23 Reward points : 0 Joined: 8/27/2009 Status: offline	Re:Remote PC Viewer Monday, July 05, 2010 7:08 AM (permalink) 0 If it is a virtual server, then I haven't tested that. As for a regular server, it would depend on the network/server permissions. If it shows denied they they probably disabled remote access to the WMI on that machine.
	#5

xmen007 Total Posts : 3 Scores: 0 Reward points : 0 Joined: 6/24/2010 Status: offline	Re:Remote PC Viewer Monday, July 05, 2010 3:06 PM (permalink) 0 What If I want to record any user logged on / logged off the Active Directory to a database: date, time, computer name, ...??
	#6

Wakawaka

Total Posts : 456
Scores: 23
Reward points : 0
Joined: 8/27/2009
Status: offline

Re:Remote PC Viewer Monday, July 19, 2010 4:40 AM (permalink)

0

This doesn't connect to the active directory. It just queries the machine.

If you want to record user data like that, you would have to add additional code to connect to the AD using the users ID, pull the fields you want and then put it to the database. It isn't too hard, you could add a extra button to do that or make it part of the regular process.

Also, I failed to state earlier, the script has a chance for failure when looking at the performace data because how it is setup. Since it checks the power status every 15-20 seconds and the performance stats every 5 seconds, there is a chance, if the computer is shutdown, that it will attempt to get the performance data before it queries the power status. You can replace it with this:

        Sub GetPerformanceStats() 
         Dim sComputer 'As String 
         Dim oWMI 'As Object          Dim bPingStatus 'As Boolean
         
         dLoad = 0          bPingStatus = Ping(ComputerName.InnerHTML)         If bPingStatus = True Then 
          sComputer = ComputerName.InnerHTML 
          Set oWMI = GetWMIConnection(sComputer) 
          
          Load.InnerHTML = LoadPercentage(oWMI) 
          RAMUsage.InnerHTML = MemoryUsage(oWMI) 
         Else 
          Call ClearPerformanceStats() 
         End If 
        End Sub

or you can remove the timer for GetPerformaceStats and place the GetPerformaceStats call within the UpdateConnectionStatus sub with

Sub UpdateConnectionStatus() 
         Dim isPingable 'As Boolean 
         Dim sComputer, sDisplayStatus 'As String 
         
         Err.Clear 
         sComputer = ComputerName.InnerHTML 
         sCurrentStatus = PowerStatus.InnerHTML 
         
         If sComputer = "" Or sComputer = "N/A" Or InStr(UCase(sCurrentStatus), "ACCESS DENIED") Then 
          'No computer defined or access has been denied, skip 
         Else 
          isPingable = Ping(sComputer) 
         
          If isPingable Then 
           If InStr(UCase(sCurrentStatus), "OFF-LINE") Then 
            sDisplayStatus = "<font color='green'>&#9608;</font> On-Line" 
            QuerySystem(sComputer)             GetPerformanceStats()
           Else 
            sDisplayStatus = "<font color='green'>&#9608;</font> On-Line"            GetPreformanceStats
           End If 
          ElseIf Err.Number <> 0 Then 
           sDisplayStatus = "<font color='black'>&#9608;</font> Unknown" 
          Else 
           sDisplayStatus = "<font color='red'>&#9608;</font> Off-Line" 
          End If 
         
          PowerStatus.InnerHTML = sDisplayStatus 
         End If 
        End Sub

#7

yfki Total Posts : 97 Scores: 0 Reward points : 0 Joined: 12/12/2007 Status: offline	Re:Remote PC Viewer Monday, July 19, 2010 9:34 AM (permalink) 0 Maybe I am missing something here, but it just does not seem to work for me. Other then monitoring changing from red to green :) Tried on multiple machines, even attempted 127.0.0.1
	#8

Wakawaka Total Posts : 456 Scores: 23 Reward points : 0 Joined: 8/27/2009 Status: offline	Re:Remote PC Viewer Tuesday, July 20, 2010 11:44 PM (permalink) 0 How long do you wait? The Performance data takes 5 seconds to display and then it will update from there every 5 seconds.
	#9

Online Bookmarks Sharing:

Jump to:

Current active users

There are 0 members and 1 guests.

Icon Legend and Permission

New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages

Read Message
Post New Thread
Reply to message
Post New Poll
Submit Vote
Post reward post
Delete my own posts
Delete my own threads
Rate post