Jump to content

Recommended Posts

Posted



Connectivity Monitor
<br />
Option Explicit<br />
' On Error Resume Next<br />
<br />
Dim intRefreshRt:     intRefreshRt = frmRefresh.Refresh.Value * 1000 '10 Second Refresh Rate in Milliseconds<br />
' Dictionary object created to store Host/Computer names and the DateTime of <br />
' the last successful ping<br />
Dim objDict:         Set objDict = CreateObject("Scripting.Dictionary")<br />
' Define the file that will be used to store the Host/Computer names<br />
Dim strFileName:     strFileName = "hostslist.txt"<br />
' Define variable that will be used to automatically refresh the data<br />
Dim iTimerID<br />
' Define constants to use when accessing the text file<br />
Const ForReading = 1<br />
Const ForWriting = 2<br />
Const ForAppending = 8<br />
<br />
    Sub Window_OnLoad<br />
'         On Error Resume Next<br />
        <br />
        Dim objFSO:    Set objFSO = CreateObject("Scripting.FileSystemObject")<br />
        ' Resize the HTA and move<br />
        window.resizeTo 700, 500<br />
        window.moveTo screen.width/4, screen.height/4<br />
        ' Check for the existence of the file defined above, create if it does not exist<br />
        If Not objFSO.FileExists(strFileName) Then<br />
            objFSO.CreateTextFile strFileName, True<br />
        End If<br />
        Set objFSO = Nothing<br />
        ' Call Subs<br />
        UpdateDict<br />
        UpdateTable<br />
        ' Set timer to execute the UpdateTable Sub every second defined in the intRefreshRt variable<br />
        iTimerID = window.setInterval("UpdateTable", intRefreshRt)<br />
    End Sub<br />
    <br />
    Sub UpdateTable<br />
'         On Error Resume Next<br />
        <br />
        Dim strComputer, strHTML, strStatus<br />
        ' Begin building HTML table<br />
        strHTML = "<table width='100%' border='0'><tr>" & _<br />
                  "<td nowrap><strong>Remote Host" & _<br />
                  "<td nowrap><strong>Last Successful Ping" & _<br />
                  "<td class='status' nowrap><strong>Status"<br />
        ' Loop through dictionary to get computer names and datetime of last successful ping<br />
        For Each strComputer In objDict.keys<br />
            strStatus = GetStatus(strComputer)<br />
            If Not LCase(strStatus) = "red.jpg" Then<br />
                objDict(strComputer) = Now ' Update last successful ping for the Host/Computer<br />
            End If<br />
            strHTML = strHTML & "<tr><td>" & strComputer & "" & _<br />
                      "<td>" & objDict(strComputer) & "<td class='status'>" & strStatus & ""<br />
        Next<br />
        ' Send HTML code generated above to body section<br />
        window.document.getElementById("dispstatus").innerHTML = strHTML & ""<br />
    End Sub<br />
    <br />
    Function GetStatus(strComputer)<br />
'          On Error Resume Next<br />
    <br />
        Dim wmiQuery, objWMIService, objPing, objStatus, intReply, i<br />
        <br />
        intReply = 0<br />
        ' Define WMI query to ping<br />
        wmiQuery = "Select * From Win32_PingStatus Where " & _<br />
            "Address = '" & strComputer & "'"<br />
        <br />
        ' Make WMI connection to local machine<br />
        Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")<br />
        ' Execute Query<br />
            <br />
        For i = 1 To 4<br />
            Set objPing = objWMIService.ExecQuery(wmiQuery)<br />
            ' Retrieve the status code of each ping request<br />
            For Each objStatus In objPing<br />
                Select Case objStatus.StatusCode<br />
                    Case 0 <br />
                        intReply = intReply + 1<br />
                End Select<br />
            Next<br />
        Next<br />
        Set objPing = Nothing<br />
        Set objWMIService = Nothing<br />
        ' Determine the image color depending on the number of pings successfully received<br />
        Select Case True<br />
            Case (intReply = 0)<br />
                GetStatus = "Offline"<br />
            Case (intReply => 3)<br />
                GetStatus = "Online"<br />
            Case Else<br />
                GetStatus = "Unexpected Error"<br />
        End Select<br />
    End Function<br />
    <br />
    Sub AddNewHost<br />
'         On Error Resume Next<br />
        <br />
        Dim objFile, strComputer<br />
        ' Get host/computer name defined in the text field<br />
        strComputer = window.document.getElementById("newhost").value<br />
        ' If the host/computer name is empty then do nothing<br />
        If (IsNull(strComputer) Or strComputer = "" Or strComputer = " ") Then Exit Sub<br />
        ' Clear the host/computer name text field<br />
        window.document.getElementById("newhost").value = ""<br />
        ' Check to ensure the host/computer name does not already exists<br />
        If Not objDict.Exists(strComputer) Then<br />
            ' Open the text file and add the new host/computer<br />
            Set objFile = FileObject(ForAppending)<br />
            objFile.WriteLine strComputer<br />
            objFile.Close<br />
            Set objFile = Nothing<br />
            ' Call subs to update the information displayed<br />
            UpdateDict<br />
            UpdateTable<br />
        End If<br />
    End Sub<br />
    <br />
    Sub UpdateHList<br />
'         On Error Resume Next<br />
        <br />
        Dim objFile, arrTemp, strTemp, i<br />
        ' Get the host/computer names in the text area and split into an array<br />
        arrTemp = Split(window.document.getElementById("txtahlist").Value, VbCrLf)<br />
        ' Open text file<br />
        Set objFile = FileObject(ForWriting)<br />
        ' Loop through array, writing to text file if the value is not null or blank<br />
        For i = 0 To UBound(arrTemp)<br />
            strTemp = arrTemp(i)<br />
            If Not (IsNull(strTemp) Or strTemp = "" Or strTemp = " ") Then<br />
                objFile.WriteLine strTemp<br />
            End If<br />
        Next<br />
        objFile.Close<br />
        Set objFile = Nothing<br />
        ' Clear info from dictionary in case there has been deletions<br />
        objDict.RemoveAll<br />
        ' Refresh all the data displayed by calling the subs<br />
        UpdateDict<br />
        UpdateTable<br />
        ' Re-state the timer that is cleared in the EditList sub<br />
        iTimerID = window.setInterval("UpdateTable", intRefreshRt)<br />
    End Sub<br />
    <br />
    Sub EditList<br />
'         On Error Resume Next<br />
        <br />
        Dim objFile, strHTML<br />
        ' Stop the time to prevent the data from refreshing while making changes to the host list<br />
        window.clearInterval(iTimerID)<br />
        ' Read the current host/computer names from the text file<br />
        Set objFile = FileObject(ForReading)<br />
        ' Output data from text file to text area to review/modify as needed<br />
        strHTML = "<textarea id='txtahlist' cols='30' rows='10'>" & objFile.ReadAll & "" & _<br />
                  "<br /><br /><input type='button' value='Update List' onclick='UpdateHList'>" & _<br />
                  "  <input type='button' value='Cancel' onclick='UpdateTable'>"<br />
        objFile.Close<br />
        Set objFile = Nothing<br />
        ' Write HTML to body of HTA<br />
        window.document.getElementById("dispstatus").innerHTML = strHTML<br />
    End Sub<br />
    <br />
    Function FileObject(strMethod)<br />
'         On Error Resume Next<br />
        <br />
        Dim objFSO:    Set objFSO = CreateObject("Scripting.FileSystemObject")<br />
        ' Open text file using the method specified<br />
        Set FileObject = objFSO.OpenTextFile(strFileName, strMethod)<br />
        Set objFSO = Nothing<br />
    End Function<br />
    <br />
    Sub UpdateDict<br />
'         On Error Resume Next<br />
        <br />
        Dim objFile, strLine<br />
        ' Open the text file to read its content<br />
        Set objFile = FileObject(ForReading)<br />
        ' Loop through each line adding it to the dictionary<br />
        Do Until objFile.AtEndOfStream<br />
            strLine = objFile.ReadLine<br />
            If Not (IsNull(strLine) Or strLine = "" or strLine = " ") Then<br />
                If Not objDict.Exists(strLine) Then<br />
                    objDict.Add strLine, ""<br />
                End If<br />
            End If<br />
        Loop<br />
        objFile.Close<br />
        Set objFile = Nothing<br />
    End Sub<br />

    applicationname="Connectivity Monitor"    
   border="dialog"
   borderstyle="normal"
   caption="Connectivity Monitor"
   contextmenu="no"
   icon="images\icon.ico"
   maximizebutton="no"
   minimizebutton="yes"
   navigable="yes"
   scroll="no"
   selection="no"
   showintaskbar="yes"
   singleinstance="yes"
   sysmenu="yes"
   version="1.0"
   windowstate="normal"
>
<br />
a:link {<br />
    color:#ffffff;<br />
    font-size:10px;<br />
    font-family:"Times New Roman", Times, serif;<br />
    text-decoration:none;<br />
    font-style: normal;<br />
    font-variant: normal;<br />
}<br />
a:visited {<br />
    color:#ffffff;<br />
    font-size:10px;<br />
    font-family:"Times New Roman", Times, serif;<br />
    text-decoration:none;<br />
    font-style: normal;<br />
    font-variant: normal;<br />
}<br />
a:hover {<br />
    color:#ffffff;<br />
    font-size:10px;<br />
    font-family:"Times New Roman", Times, serif;<br />
    text-decoration:underline;<br />
    font-style: normal;<br />
    font-variant: normal;<br />
}<br />
td {<br />
    font-family: "Times New Roman", Times, serif;<br />
    font-size: 18px;<br />
    font-style: normal;<br />
    font-weight: normal;<br />
    font-variant: normal;<br />
    color: #FFFFFF;<br />
    vertical-align: center;<br />
}<br />
.status {<br />
    text-align:center;<br />
}<br />



</pre><form name="frmRefresh">
Ping Every :  Seconds
</form><br><div align="center">
Connectivity Monitor
Add Host:   

Edit Host List




</div><br><b

 

A HTA to monitor network connections via ip address afaik.

 

Just want to know how to ammend the above so that the text field called Refresh which is inside of the form can be equal to the intRefresh vbscript variable ie

 

intRefresh = Document.frmRefresh.Refresh.value

 

But cant seem to get it to work correctly please help

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now



×
×
  • Create New...