2

我通过 VPN 收集了美国、印度和远程用户。我正在使用无 DSN 方法链接到我的 Access DB 应用程序中的远程表。

我需要一种有效的方法来确定用户选择的 IP 是否可达（称为“myIP”）。

我目前的方法 PINGS myIP，但会打开一个讨厌的 CMD 窗口并需要几秒钟才能解决状态。

SystemReachable (myIP)

If InStr(myStatus, "Reply") > 0 Then
    ' MsgBox "IP is Confirmed Reachable"
Else
    MsgBox "[" & myIP & "] is not Reachable" & vbCrLf & vbCrLf & Confirm your selected location, or VPN is active."
    Exit Sub
End If

''''''''''''''''''''''''''''

Function SystemReachable(ByVal ComputerName As String)
Dim oShell, oExec As Variant
Dim strText, strCmd As String

strText = ""
strCmd = "ping -n 3 -w 1000 " & ComputerName

Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec(strCmd)

Do While Not oExec.StdOut.AtEndOfStream
    strText = oExec.StdOut.ReadLine()
    If InStr(strText, "Reply") > 0 Then
        myStatus = strText
        Exit Do
    Else
        myStatus = ""
    End If
Loop

End Function

是否有更好/更快的方法来确定“myIP”的状态/可达性？

谢谢！

4

3 回答 3

3

找到了一种非常可行且无声的方法：

Dim strCommand as string
Dim strPing As String

strCommand = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 -w 500 " & myIP & " | " & "%SystemRoot%\system32\find.exe /i " & Chr(34) & "TTL=" & Chr(34)
strPing = fShellRun(strCommand)

If strPing = "" Then
    MsgBox "Not Connected"
Else
    MsgBox "Connected!"
End If

'''''''''''''''''''''''''''

Function fShellRun(sCommandStringToExecute)

' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in and its contents are returned as the value the function returns.

' "myIP" is a user-selected global variable

Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr

Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")

    sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
    On Error Resume Next
    oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
    iErr = Err.Number

    On Error GoTo 0
    If iErr <> 0 Then
        fShellRun = ""
        Exit Function
    End If

    On Error GoTo err_skip
    fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1).ReadAll
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

Exit Function

err_skip:
    fShellRun = ""
    oFileSystemObject.DeleteFile sShellRndTmpFile, True


End Function
于 2013-10-04T11:34:38.543 回答
1

使用临时文件这样做似乎不是一个好的解决方案，尤其是在使用 SSD 时。

ShellObject.Run 当您将 TRUE 作为第三个参数传递时，它返回命令返回值。

对于“ping”，当主机可达时设置为0，如果主机不可达或发生任何错误，则设置为其他。所以你可以使用下面的方法来快速判断目的地是否可达：

    Dim strCommand
    Dim iRet

    strCommand = "%SystemRoot%\system32\ping.exe -n 1 -l 1 -w 500 " & myIP
    iRet = fShellRun(strCommand)

    If iRet <> 0 Then
        MsgBox "Not Connected"
    Else
        MsgBox "Connected!"
    End If

    Function fShellRun(sCommandStringToExecute)

        ' This function will accept a string as a DOS command to execute.
        ' It will then execute the command in a shell, and returns the command 
        ' return code to the caller. 

        ' "myIP" is a user-selected global variable

        Dim oShellObject

        Set oShellObject = CreateObject("Wscript.Shell")

        On Error Resume Next
        fShellRun = oShellObject.Run(sCommandStringToExecute, 0, TRUE)

    End Function
于 2019-02-02T16:15:16.697 回答
0

基于 Steven Ding 的解决方案，我将其缩短为 1-liner（因为我只是喜欢重载的短函数）：

Function PingOk(Ip As String) As Boolean
  PingOk = (0 = CreateObject("Wscript.Shell").Run("%SystemRoot%\system32\ping.exe -n 1 -l 1 -w 5000 " & Ip, 0, True))
End Function
于 2021-03-10T02:05:46.183 回答