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

嗯。。。我想标题说明了一切。我想检查我的网络上是否有电脑，例如“JOAN-pc”

现在我在做这样的事情：

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

工作正常，但速度很慢，我的程序不得不多次调用它。 你们中的一些人知道做同样事情的快速方法吗

---

提前感谢。

也许您可以使用

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

选项显式
'从服务器获取并显示一天中的净远程时间
'远程Windows系统。提供UNC主机名，
'DNS名称或IP地址-或的空字符串
'本地主机的时间和日期。
'
'窗体有3个控件：
'
'txtServer文本框
'cmdGetTime命令按钮
“时间标签
只要长=0，则私有Const NERR_成功
私有类型时间天信息
tod_的时间越长越好
tod_毫秒长
tod_小时长
tod_mins尽可能长
tod_secs尽可能长
tod_hunds尽可能长
tod_时区尽可能长
tod_tinterval尽可能长
今天的时间尽可能长
一个月的时间
一年之久
tod_工作日尽可能长
端型
专用声明函数NetApiBufferFree Lib“netapi32”（_
ByVal lpBuffer As Long）As Long
专用声明函数NetRemoteTOD Lib“netapi32”（_
ByRef UncServerName作为字节_
ByRef BufferPtr As Long）As Long
私有声明子CopyMemory Lib“kernel32”别名“rtlmovemory”（_
ByRef pTo（如有）_
ByRef uFrom和其他人一样_
ByVal（尽可能长）
私有函数GetTOD（ByVal服务器作为字符串）作为日期
Dim bytServer（）作为字节
变暗LNGBUFFTR尽可能长
Dim TOD作为时间\天\信息返回
bytServer=Trim$（服务器）&vbNullChar
如果NetRemoteTOD（bytServer（0），lngBufPtr）=NERR_SUCCESS，则
CopyMemory todReturned，ByVal LNGBUFFPTR，LenB（todReturned）
NetApiBufferFree LNGBUFTR
托德回来了
GetTOD=DateAdd（“n”_
-.tod_时区_
日期序列（.tod_年、.tod_月、.tod_日）_
+时间序列（.tod_小时、.tod_分钟、.tod_秒））
以
其他的
错误。引发vbObjectError或&H2000&_
“GetTOD”_
“无法从服务器获取时间”
如果结束
端函数
私有子cmdGetTime_Click（）
Dim dtServerTime作为日期
出错时继续下一步
dtServerTime=GetTOD（txtServer.Text）
如果错误号为0，则
lblTime.Caption=错误描述
其他的
lblTime.Caption=CStr（dtServerTime）
如果结束
错误转到0
txtServer.SetFocus
端接头

为什么您的程序必须多次调用它？你真的希望计算机以现有解决方案无法处理的速度快速出现/消失吗？我必须每秒钟检查一次，因为我的程序正在将文件复制到共享文件夹。在此之前，我需要确保电脑通过局域网连接，并且其文件夹可用。我希望消耗尽可能少的资源，仅此而已。您根本不需要检查它。您需要进行复制并处理可能导致的错误情况。无论如何，你必须处理好它们。目前你正试图预测手术会成功。这是算命，不是计算。判断资源是否可用的唯一可靠方法是尝试使用它。好的，我会这样做。真的谢谢！我想你已经完了。此系列中的NetGetJoinInformation和其他调用也会遇到相同的问题。即使是ICMP ping，如果不等待回复，也不可靠。哦！NetGetJoinInformation（）api工作得非常好，比我的方法更快。真的谢谢Bob77！