｜ Works
VBScriptでPort Ping
リモートサーバのTCPポートを監視するというのを、何故かVBSでやらなければならなくなりました。例によって古いサーバ上で動かすからなんですが…。もっと別の方へ話を持って行けなかった自分の説得力不足もあるので仕方ないか。
いろいろと手段を考えていましたが、
- 「CreateObject("NonComSck.Winsock")」を使う方法はVB6ランタイムの"MSWINSCK.OCX"がないと使えない（当然のように入っているわけなかった）
- 「WMIで"Select * from netDiagnostics"」を使う方法は、実行環境がWindows XPでないと使えない（Windows Server 2003とかでは使えない）
という感じだったので、行き着いたところは「とりあえず強引にHTTPで接続しにいってエラーコードで判別する」でした。
そんなこんなで以下のようにしてみました。
Option Explicit
Const TargetHost = "192.168.0.1"
Const TargetPort = "65000"
Dim objXML, intRet, strStatus
Set objXML = WScript.CreateObject("MSXML2.ServerXMLHTTP")
objXML.SetTimeouts 10000,10000,10000,10000
intRet = "0"
On Error Resume Next
objXML.open "GET", "http://" & TargetHost & ":" & TargetPort, False
objXML.send
intRet = Err.Number
Select Case intRet
Case 0, -2147012744, -2147024891
'TCP Connect success , no HTTP responce, 401 auth failure
strStatus = "OK"
Case -2147012867
'Connection Rejected
strStatus = "REJECTED"
Case -2147012894
'Timeout
strStatus = "TIMEOUT"
Case -2147012889
'Could not resolve address
strStatus = "UNKNOWN HOST"
Case -2147467259
'Cannot test that port with this tool
strStatus = "SYSTEM ERROR"
Case -2147012851
'Certificate authority is invalid or incorrect
strStatus = "CERTIFICATE INVALID"
Case Else
'Unknown error
strStatus = "UNKNOWN ERROR"
End Select
On Error Goto 0
Set objXML = Nothing
WScript.Echo Now & " TCP: " & strStatus
WScript.Quit(0) エラーコードはとりあえず調べられた限りですが、ポートがLISTENになっているかどうか判ればいいのでこんなものでしょうか？
しばらく使って様子見ようかと。
