WSHでPing

<html>
<head>
</head>
<body>
<p>
PING DEAD or ALIVE
</p>
<hr>
<form name="frm_base">
設置場所
<select name="sel_place" title="場所" size="1">
<option value="00">全機</option>
</select>
<input type="button" value="実行" onClick="DeadorAlive()">
</form>
<Script language="VBScript">
'*******************************************************
'
' PING関数
'
'*******************************************************
Function PingComputer(strComputer)
    Dim strReturn
    Dim strSQL
    Dim strAddress

    Set objLocator = CreateObject("WbemScripting.SWbemLocator")
    Set objServer = objLocator.ConnectServer()
    strSQL = "Select * From Win32_PingStatus " & _
                "Where Address = '" & _
                strComputer & _
                "' And Timeout = 100"
    Set objPing = objServer.ExecQuery(strSQL)
    For Each Ping In objPing
        strAddress = Ping.ProtocolAddress
        Select Case Ping.StatusCode
        Case 0
            strReturn = "Success"
        Case 11001
            strReturn = "Buffer Too Small"
        Case 11002
            strReturn = "Destination Net Unreachable"
        Case 11003
            strReturn = "Destination Host Unreachable"
        Case 11004
            strReturn = "Destination Protocol Unreachable"
        Case 11005
            strReturn = "Destination Port Unreachable"
        Case 11006
            strReturn = "No Resources"
        Case 11007
            strReturn = "Bad Option"
        Case 11008
            strReturn = "Hardware Error"
        Case 11009
            strReturn = "Packet Too Big"
        Case 11010
            strReturn = "Request Timeout"
        Case 11011
            strReturn = "Bad Request"
        Case 11012
            strReturn = "Bad Route"
        Case 11013
            strReturn = "Time To Live Expired Transit"
        Case 11014
            strReturn = "Time To Live Expired Reassembly"
        Case 11015
            strReturn = "Parameter Problem"
        Case 11016
            strReturn = "Source Quench"
        Case 11017
            strReturn = "Option Too Big"
        Case 11018
            strReturn = "Bad Destination"
        Case 11032
            strReturn = "Negotiating IPSEC"
        Case 11050
            strReturn = "General Failure"
        Case Else
            strReturn = "Unknown"
        End Select
    Next

    PingComputer = strReturn & ":" & strAddress
End Function

'*****************************************************
'
' Domain内の全てのコンピューターのリスト
'
'*****************************************************
Function ListAllComputers(strContainerName)
    Dim Container
    Dim ContainerName
    Dim Computer

    ContainerName = strContainerName
    Set Container = GetObject("WinNT://" & ContainerName)
    Container.Filter = Array("Computer")
    For Each Computer in Container
        strComputers = strComputers & Computer.Name & vbTab
    Next

    strComputers = Left(strComputers, Len(strComputers) - 1 )
    strComputers = Trim(strComputers)
    ListAllComputers = Split(strComputers, vbTab)
End Function

Sub DeadorAlive()
    Dim strReturn

    aryComputers = ListAllComputers("ドメイン名")
    strPlace = Document.frm_base.sel_place.value
    strReturn = "<H1>Ping Dead or Alive</H1><hr>"
    strReturn = strReturn & "<TABLE>"
    strReturn = strReturn & "<tbody>"
    strReturn = strReturn & "<tr>"
    strReturn = strReturn & "<td>"
    strReturn = strReturn & "Name"
    strReturn = strReturn & "</td>"
    strReturn = strReturn & "<td>"
    strReturn = strReturn & "Status"
    strReturn = strReturn & "</td>"
    strReturn = strReturn & "</tr>"

    For Each Computer In aryComputers
        strStatus = PingComputer(Computer)
        If Left(strStatus,Len("Success")) = "Success" Then
            strBgColor = "lime"
        Else
            strBgColor = "red"
        End If
        strReturn = strReturn & _
                        "<tr bgcolor='" & strBgColor & "'><td>" & _
                        Computer & "</td><td>" & _
                        strStatus & "</td></tr>"
    Next

    strReturn = strReturn & "</tbody>"
    strReturn = strReturn & "</table>"
    document.write strReturn
End Sub
</Script>
</tbody>
</table>
</body>
</html>

 

Keywords
Windows Network