<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>
コメント