Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Старожил


Сообщения: 210
Благодарности: 76

Профиль | Отправить PM | Цитировать


Проверил. Нашёл пропущенный оператор.
Перед оператором On Error Resume Next
надо добавить оператор Set objWShell = CreateObject("WScript.Shell")

Поскольку сценарий работает достаточно медленно, то лучше запускать его в консольном режиме. Там, по крайней мере, можно реализовать вывод промежуточных результатов.
читать дальше »
Код: Выделить весь код
Dim objWMI, objCollection, objItem
Dim objWsNet, objDomain, objComputer, strDomain, strThisComputer
Dim objWShell, objExec, objOutStream
Dim arrComputers(), strMAC, strName, blnPing, strTemp, i

strMAC = Trim(InputBox("MAC-адрес:"))
If Len(strMAC) > 0 Then
    strMAC = Replace(Replace(strMAC, " ", ""), "-", ":")
    Set objWsNet = CreateObject("WScript.Network")
    strDomain = objWsNet.UserDomain
    strThisComputer = objWsNet.ComputerName
    Set objWsNet = Nothing
    Set objDomain = GetObject("WinNT://" & strDomain & ",domain")
    objDomain.Filter = Array("computer")
    i = -1
    For Each objComputer In objDomain
        i = i + 1
        ReDim Preserve arrComputers(i)
        arrComputers(i) = objComputer.Name
    Next
    Set objComputer = Nothing
    Set objDomain = Nothing
    Set objWShell = CreateObject("WScript.Shell")
    On Error Resume Next
    For i = 0 To UBound(arrComputers)
        strTemp = vbNullString: blnPing = False
        If StrComp(strThisComputer, arrComputers(i), vbTextCompare) <> 0 Then
            Set objExec = objWShell.Exec("ping -n 1 -w 130 " & arrComputers(i))
            Set objOutStream = objExec.StdOut
            While Not objOutStream.AtEndOfStream
                strTemp = strTemp & Trim(objOutStream.ReadLine)
            Wend
            If InStr(1, strTemp, "TTL", vbTextCompare) > 0 Then
                blnPing = True
            Else
                blnPing = False
            End If
        Else
            blnPing = True
        End If
        If blnPing Then
            Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & arrComputers(i) & "\root\cimv2")
            If Err.Number = 0 Then
                Set objCollection = objWMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE MACAddress='" & strMAC & "'")
                If objCollection.Count > 0 Then
                    strName = arrComputers(i)
                    Exit For
                End If
                Set objCollection = Nothing
                Set objWMI = Nothing
            Else
                Err.Clear
            End If
        End If
    Next
    Set objOutStream = Nothing
    Set objExec = Nothing
    Set objWShell = Nothing
    If Len(strName) > 0 Then
        WScript.Echo "Искомое имя: " & strName
    Else
        WScript.Echo "Выполнить сопоставление не удалось."
    End If
End If
WScript.Quit 0

Последний раз редактировалось DmitriiV, 29-07-2013 в 09:26.

Это сообщение посчитали полезным следующие участники:

Отправлено: 09:16, 29-07-2013 | #3