Question

嗯......我认为标题就是全部。我想检查我的网络上是否存在电脑，例如“JOAN-PC”。

现在我正在做这样的事情：

Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
MsgBox Not CBool(oShell.NameSpace(CVar("\\JOAN-PC")) Is Nothing)

效果很好，但很慢，我的程序必须多次调用它。有些人知道快速做同样的事情吗？

提前致谢。

Answer 1

也许您可以使用NetRemoteTOD或相关的简单网络API，甚至是“ping”请求。

这是一个你可能会适应的小例子。尝试一下，没有响应的机器的超时似乎不会太长（7或8秒）。对于合法用途，这可能不是问题，但它足以阻止恶意“扫描仪”试图通过受害机器的IP地址扫描整个网络。

Option Explicit

'Fetch and display Net Remote Time Of Day from a
'remote Windows system.  Supply a UNC hostname,
'DNS name, or IP address - or empty string for
'the local host's time and date.
'
'Form has 3 controls:
'
'   txtServer   TextBox
'   cmdGetTime  CommandButton
'   lblTime     Label

Private Const NERR_SUCCESS As Long = 0

Private Type TIME_OF_DAY_INFO
    tod_elapsedt As Long
    tod_msecs As Long
    tod_hours As Long
    tod_mins As Long
    tod_secs As Long
    tod_hunds As Long
    tod_timezone As Long
    tod_tinterval As Long
    tod_day As Long
    tod_month As Long
    tod_year As Long
    tod_weekday As Long
End Type

Private Declare Function NetApiBufferFree Lib "netapi32" ( _
    ByVal lpBuffer As Long) As Long

Private Declare Function NetRemoteTOD Lib "netapi32" ( _
    ByRef UncServerName As Byte, _
    ByRef BufferPtr As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef pTo As Any, _
    ByRef uFrom As Any, _
    ByVal lSize As Long)

Private Function GetTOD(ByVal Server As String) As Date
    Dim bytServer() As Byte
    Dim lngBufPtr As Long
    Dim todReturned As TIME_OF_DAY_INFO

    bytServer = Trim$(Server) & vbNullChar
    If NetRemoteTOD(bytServer(0), lngBufPtr) = NERR_SUCCESS Then
        CopyMemory todReturned, ByVal lngBufPtr, LenB(todReturned)
        NetApiBufferFree lngBufPtr
        With todReturned
            GetTOD = DateAdd("n", _
                             -.tod_timezone, _
                             DateSerial(.tod_year, .tod_month, .tod_day) _
                           + TimeSerial(.tod_hours, .tod_mins, .tod_secs))
        End With
    Else
        Err.Raise vbObjectError Or &H2000&, _
                  "GetTOD", _
                  "Failed to obtain time from server"
    End If
End Function

Private Sub cmdGetTime_Click()
    Dim dtServerTime As Date

    On Error Resume Next
    dtServerTime = GetTOD(txtServer.Text)
    If Err.Number <> 0 Then
        lblTime.Caption = Err.Description
    Else
        lblTime.Caption = CStr(dtServerTime)
    End If
    On Error GoTo 0
    txtServer.SetFocus
End Sub

快速检查网络中是否存在特定计算机的方法

1 个答案: