尝试这样的方法:使用
.Popup method
Option Explicit
Dim ObjExec,objShell,strFromProc,intButton,Port
Port = "5900"
Set objShell = CreateObject("WScript.Shell")
Set ObjExec = objShell.Exec("%comspec% /c netstat -a | find "& DblQuote("ESTABLISHED") & "| find " & DblQuote(Port) &"")
strFromProc = ObjExec.StdOut.ReadAll
If Instr(strFromProc,"ESTABLISHED") > 0 Then
intButton = objShell.Popup(strFromProc,3,"Connection Established @ Port "& Port &"",vbInformation)
Else
intButton = objShell.Popup("Connection Not Established @ Port "& Port,3,"Connection Not Established @ Port "& Port &"",vbExclamation)
End If
'****************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'****************************************************************
如果你想避免使用黑色控制台;试试这个方法:
Option Explicit
Dim ObjExec,strCommand,OutPutData,objShell,strFromProc,intButton,Port
Port = "5900"
Set objShell = CreateObject("WScript.Shell")
strCommand = "%comspec% /c netstat -a | find "& DblQuote("ESTABLISHED") & "| find " & DblQuote(Port) &""
OutPutData = Run_Cmd(strCommand)
If Instr(OutPutData,"ESTABLISHED") > 0 Then
intButton = objShell.Popup(OutPutData,3,"Connection Established @ Port "& Port &"",vbInformation)
Else
intButton = objShell.Popup("Connection Not Established @ Port "& Port,3,"Connection Not Established @ Port "& Port &"",vbExclamation)
End If
'****************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'****************************************************************
Function Run_Cmd(strCommand)
On Error Resume Next
Const ForReading = 1
Const TemporaryFolder = 2
Const WshHide = 0
Dim wsh, fs, ts
Dim strTempFile,strFile, strData
Set wsh = CreateObject("Wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
strTempFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, fs.GetTempName)
strFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, "result.txt")
wsh.Run "cmd.exe /c " & strCommand & " > " & DblQuote(strTempFile) & "2>&1", WshHide, True
wsh.Run "cmd.exe /u /c Type " & DblQuote(strTempFile) & " > " & DblQuote(strFile) & "", WshHide, True
Set ts = fs.OpenTextFile(strFile, ForReading,true,-1)
strData = ts.ReadAll
Run_Cmd = strData
ts.Close
fs.DeleteFile strTempFile
fs.DeleteFile strFile
End Function
'****************************************************************