【问题标题】:Teamviewer VBScript Pinging ComputersTeamviewer VBScript Ping 计算机
【发布时间】:2013-12-02 22:52:18
【问题描述】:

我正在寻找一种方法来拥有我当前的 VBScript(它非常大,我不知道是否有办法将它配对)当前创建活动目录中所有计算机的列表并将其输出到一份文件。完成后,我的脚本的其余部分将调用该文本文件,并通过 Windows 7 reg 密钥或 Windows XP 创建另一个包含所有计算机名称和日期/时间/以及 teamviewer ID 的文件。我遇到的问题是,如果域中不再存在计算机,则脚本会将先前的值放入不存在的计算机中,从而创建重复项。

我很想找到一种方法来编辑我的脚本并 ping 原始文本文件中的每台计算机,并从中删除不在线的计算机。我将附上我的脚本。如果您有任何问题,请告诉我。

' Declare the constants
Dim oFSO
Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
'Const REG_SZ = 1 ' String value in registry (Not DWORD)
Const ForReading = 1 
Const ForWriting = 2

' Set File objects...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDictionary2 = CreateObject("Scripting.Dictionary")

' Set string variables
strDomain = "my domain" ' Your Domain
strPCsFile = "DomainPCs.txt" 
strPath = "C:\logs\" ' Create this folder
strWorkstationID = "C:\logs\WorkstationID.txt"

If objFSO.FolderExists(strPath) Then
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
Else
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
oFSO.CreateFolder strPath
End If

' Get list of domain PCs - Using above variables.
strMbox = MsgBox("Would you like info for entire domain: rvdocs.local?",3,"Hostname")

'an answer of yes will return a value of 6, causing script to collect domain PC info
If strMbox = 6 Then
Set objPCTXTFile = objFSO.OpenTextFile(strPath & strPCsFile, ForWriting, True)
Set objDomain = GetObject("WinNT://" & strDomain) ' Note LDAP does not work
objDomain.Filter = Array("Computer")
For Each pcObject In objDomain
objPCTXTFile.WriteLine pcObject.Name
Next
objPCTXTFile.close

Else
'an answer of no will prompt user to input name of computer to scan and create PC file
strHost = InputBox("Enter the computer you wish to get Workstation ID","Hostname"," ")
Set strFile = objfso.CreateTextFile(strPath & strPCsFile, True)
strFile.WriteLine(strHost)
strFile.Close
End If


' Read list of computers from strPCsFile into objDictionary
Set readPCFile = objFSO.OpenTextFile(strPath & strPCsFile, ForReading)
i = 0
Do Until readPCFile.AtEndOfStream 
strNextLine = readPCFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop
readPCFile.Close


' Build up the filename found in the strPath
strFileName = "Workstation ID_" _
& year(date()) & right("0" & month(date()),2) _
& right("0" & day(date()),2)  &".txt"

' Write each PC's software info file...
Set objTextFile2 = objFSO.OpenTextFile(strPath & strFileName, ForWriting, True)

For each DomainPC in objDictionary
strComputer = objDictionary.Item(DomainPC)

On error resume next

' WMI connection to the operating system note StdRegProv
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
strComputer & "\root\default:StdRegProv")

' These paths are used in the filenames you see in the strPath
pcName = "SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
pcNameValueName = "ComputerName"
objReg.GetStringValue HKLM,pcName,pcNameValueName,pcValue
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath, strValueName, strValue

If IsNull(strValue) Then
    strKeyPath = "SOFTWARE\TeamViewer\Version5.1\"
    strValueName = "ClientID"
    objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If

If IsNull(strValue) Then
    strValue = " No Teamviewer ID"
End If

Set objReg = Nothing
Set ObjFileSystem = Nothing

objTextFile2.WriteLine(vbCRLF & "==============================" & vbCRLF & _
"Current Workstation ID: " & UCASE(strComputer) & vbCRLF & Time & vbCRLF & Date _
& vbCRLF & "Teamviewer ID:" & "" & strValue & vbCRLF & "----------------------------------------" & vbCRLF)

'GetWorkstationID()
Next

WScript.echo "Finished Scanning Network check : " & strPath

objFSO.DeleteFile(strPath & strPCsFile)


wscript.Quit

【问题讨论】:

    标签: windows vbscript active-directory ping


    【解决方案1】:

    问题的原因是objReg 保留了上一次迭代的值

    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
      strComputer & "\root\default:StdRegProv")
    

    由于无法访问的计算机(被On Error Resume Next 屏蔽)而失败。

    解决此问题的一种方法是在尝试连接到远程主机之前将objReg 设置为Nothing,然后检查变量是否仍然是Nothing

    On Error Resume Next
    
    Set objReg = Nothing
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
      strComputer & "\root\default:StdRegProv")
    
    If Not objReg Is Nothing Then
      'check for TeamViewer ID
    Else
      'remote host unavailable
    End If
    

    解决这个问题的一个更优雅的解决方案(不需要臭名昭著的On Error Resume Next)是在尝试连接远程计算机之前对其进行 ping 操作:

    Set wmi = GetObject("winmgmts://./root/cimv2")
    qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
    For Each response In wmi.ExecQuery(qry)
      If IsObject(response) Then
        hostAvailable = (response.StatusCode = 0)
      Else
        hostAvailable = False
      End If
    Next
    
    If hostAvailable Then
      Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
        strComputer & "\root\default:StdRegProv")
    
      'check for TeamViewer ID
    Else
      'remote host unavailable
    End If
    

    【讨论】:

    • 所以我将底部解决方案添加到我的脚本中,如果计算机离线或 WMI 不工作,我会看到“远程服务器计算机不存在或不可用”框。有没有办法绕过这个错误?
    • @user3059231 我的代码不应该显示任何消息,但我在第二个代码示例中错误地使用了CreateObject 而不是GetObject(现已修复)。请再试一次。如果您仍然收到消息:请出示您修改后的代码。
    【解决方案2】:

    这是我想出的。我必须添加“On Error Resume Next”,否则会弹出一个错误框。这是修改后的代码:

    ' Declare the constants
    Dim oFSO
    Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
    'Const REG_SZ = 1 ' String value in registry (Not DWORD)
    Const ForReading = 1 
    Const ForWriting = 2
    
    ' Set File objects...
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Set objDictionary2 = CreateObject("Scripting.Dictionary")
    
    ' Set string variables
    strDomain = "mydomain" ' Your Domain
    strPCsFile = "DomainPCs.txt" 
    strPath = "C:\logs\" ' Create this folder
    strWorkstationID = "C:\logs\WorkstationID.txt"
    
    If objFSO.FolderExists(strPath) Then
    Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
    Else
    Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
    oFSO.CreateFolder strPath
    End If
    
    ' Get list of domain PCs - Using above variables.
    strMbox = MsgBox("Would you like info for entire domain: rvdocs.local?",3,"Hostname")
    
    'an answer of yes will return a value of 6, causing script to collect domain PC info
    If strMbox = 6 Then
    Set objPCTXTFile = objFSO.OpenTextFile(strPath & strPCsFile, ForWriting, True)
    Set objDomain = GetObject("WinNT://" & strDomain) ' Note LDAP does not work
    objDomain.Filter = Array("Computer")
    For Each pcObject In objDomain
    objPCTXTFile.WriteLine pcObject.Name
    Next
    objPCTXTFile.close
    
    Else
    'an answer of no will prompt user to input name of computer to scan and create PC file
    strHost = InputBox("Enter the computer you wish to get Workstation ID","Hostname"," ")
    Set strFile = objfso.CreateTextFile(strPath & strPCsFile, True)
    strFile.WriteLine(strHost)
    strFile.Close
    End If
    
    
    ' Read list of computers from strPCsFile into objDictionary
    Set readPCFile = objFSO.OpenTextFile(strPath & strPCsFile, ForReading)
    i = 0
    Do Until readPCFile.AtEndOfStream 
    strNextLine = readPCFile.Readline
    objDictionary.Add i, strNextLine
    i = i + 1
    Loop
    readPCFile.Close
    
    
    ' Build up the filename found in the strPath
    strFileName = "Workstation ID_" _
    & year(date()) & right("0" & month(date()),2) _
    & right("0" & day(date()),2) & ".txt"
    
    ' Write each PC's software info file...
    Set objTextFile2 = objFSO.OpenTextFile(strPath & strFileName, ForWriting, True)
    
    For each DomainPC in objDictionary
    strComputer = objDictionary.Item(DomainPC)
    
    Set wmi = GetObject("winmgmts://./root/cimv2")
    qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
    For Each response In wmi.ExecQuery(qry)
      If IsObject(response) Then
        hostAvailable = (response.StatusCode = 0)
      Else
        hostAvailable = False
      End If
    Next
    
    
    On error resume Next
    
    If hostAvailable Then
      'check for TeamViewer ID
    
    ' WMI connection to the operating system note StdRegProv
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
    strComputer & "\root\default:StdRegProv")
    
    ' These paths are used in the filenames you see in the strPath
    pcName = "SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
    pcNameValueName = "ComputerName"
    objReg.GetStringValue HKLM,pcName,pcNameValueName,pcValue
    strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5.1\"
    strValueName = "ClientID"
    objReg.GetDWORDValue HKLM,strKeyPath, strValueName, strValue
    
    If IsNull(strValue) Then
        strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5\"
        strValueName = "ClientID"
        objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
    End If
    
    If IsNull(strValue) Then
        strKeyPath = "SOFTWARE\TeamViewer\Version5.1\"
        strValueName = "ClientID"
        objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
    End If
    
    If IsNull(strValue) Then
        strKeyPath = "SOFTWARE\TeamViewer\Version5\"
        strValueName = "ClientID"
        objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
    End If
    
    If IsNull(strValue) Then
        strValue = " No Teamviewer ID"
    End If
    
    Set objReg = Nothing
    Set ObjFileSystem = Nothing
    
    objTextFile2.WriteLine(vbCRLF & "==============================" & vbCRLF & _
    "Current Workstation ID: " & UCASE(strComputer) & vbCRLF & Time & vbCRLF & Date _
    & vbCRLF & "Teamviewer ID:" & "" & strValue & vbCRLF _
    & "----------------------------------------" & vbCRLF)
    
    'GetWorkstationID()
    strValue = NULL
    
    Else
    
      'remote host unavailable
    
    End If
    Next
    
    WScript.echo "Finished Scanning Network check : " & strPath
    
    'objFSO.DeleteFile(strWorkstationID)
    objFSO.DeleteFile(strPath & strPCsFile)
    
    wscript.Quit
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2011-04-27
      • 1970-01-01
      • 2011-09-27
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多