扫描IP范围并将用户信息提供给Excel工作表的脚本。回收信息

时间:2014-07-10 17:43:20

标签: excel vbscript ip network-scan

我需要有关生成带有特定用户信息的Excel工作表的VBS脚本的帮助。

它有效......排序。问题是它似乎回收产生不准确结果的信息。任何人都知道如果没有相关信息,我会如何将Excel文档中的脚本区域留空?我知道这是可能的,只需要朝着正确的方向轻推。

谢谢!

On Error Resume Next

Dim FSO
Dim objStream

Const TriStateFalse = 0
Const FILE_NAME = "Users.csv"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set objStream = FSO.CreateTextFile(FILE_NAME, _
True, TristateFalse)

strSubnetPrefix = "192.168.1."
intBeginSubnet = 1
intEndSubnet = 254

For i = intBeginSubnet To intEndSubnet
strComputer = strSubnetPrefix & i
    'strcomputer = inputbox("Enter Computer Name or IP")
    if strcomputer = "" then
        wscript.quit
    else

    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
        ("select * from Win32_PingStatus where address = '" & strcomputer & "'")
    For Each objStatus in objPing
        If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then 
            'request timed out
            'msgbox(strcomputer & " did not reply" & vbcrlf & vbcrlf & _
                    '"Please check the name and try again")
        else

            set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\cimv2")
            Set colSettings = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
            For Each objComputer in colSettings 
                                    objStream.WriteLine objComputer.name & "," & objcomputer.username & "," & objcomputer.domain _
                & "," & strcomputer
                'msgbox("System Name: " & objComputer.Name & vbcrlf & "User Logged in : " & _
                'objcomputer.username  & vbcrlf & "Domain: " & objComputer.Domain)
            Next
        end if
    next
    end if
Next

Msgbox("Done Collecting")

set objwmiservice = nothing
set colsettings = nothing
set objping = nothing

2 个答案:

答案 0 :(得分:0)

您使用EVIL全局On Error Resume Next。这意味着:所有错误都被忽略/隐藏,并且脚本继续(或多或少地愉快地)用于所有实际目的的未定义状态。演示脚本:

Option Explicit

Dim a : a = Array(1,0,2)

Bad a
Good a

Sub Bad(a)
    Dim i, n
   On Error Resume Next
    For i = 0 To UBound(a)
        n = 4712 / a(i)
        WScript.Echo "Bad", i, a(i), n
    Next
End Sub

Sub Good(a)
    Dim i, n
    For i = 0 To UBound(a)
      On Error Resume Next
        n = 4712 / a(i)
        If Err.Number Then n = "value to use in case of error"
      On Error GoTo 0
        WScript.Echo "Good", i, a(i), n
    Next
End Sub

输出:

cscript oern.vbs
Bad 0 1 4712
Bad 1 0 4712  <--- assignment failed, 'old' value of n retained, no clue about problem
Bad 2 2 2356
Good 0 1 4712
Good 1 0 value to use in case of error
Good 2 2 2356

严格的本地OERN确保处理特定问题(除以零,ping失败),并报告所有其他异常,因此可以改进程序。

further food for thought

答案 1 :(得分:0)

在再次设置之前,您的WMI调用变量需要重置为空。这个脚本应该更好。

On Error Resume Next

Dim FSO
Dim objStream

Const TriStateFalse = 0
Const FILE_NAME = "Users.csv"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set objStream = FSO.CreateTextFile(FILE_NAME, _
True, TristateFalse)

strSubnetPrefix = "192.168.1."
intBeginSubnet = 1
intEndSubnet = 254

For i = intBeginSubnet To intEndSubnet
strComputer = strSubnetPrefix & i
    'strcomputer = inputbox("Enter Computer Name or IP")
    if strcomputer = "" then
        wscript.quit
    else

    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
        ("select * from Win32_PingStatus where address = '" & strcomputer & "'")
    For Each objStatus in objPing
        If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then 
            'request timed out
            'msgbox(strcomputer & " did not reply" & vbcrlf & vbcrlf & _
                    '"Please check the name and try again")
        else

            set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\cimv2")
            Set colSettings = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
            For Each objComputer in colSettings 
                                    objStream.WriteLine objComputer.name & "," & objcomputer.username & "," & objcomputer.domain _
                & "," & strcomputer
                'msgbox("System Name: " & objComputer.Name & vbcrlf & "User Logged in : " & _
                'objcomputer.username  & vbcrlf & "Domain: " & objComputer.Domain)
            Next
            set objwmiservice = nothing
            set colsettings = nothing
        end if
    next
    end if
    set objping = nothing
Next

Msgbox("Done Collecting")