Teamviewer VBScript Pinging Computers

时间：2013-12-02 22:52:18

标签： windows vbscript active-directory ping

我正在寻找一种方法来获取我当前的VBScript（它非常大，我不知道是否有办法将其配对），这种方法当前创建了一个活动目录中所有计算机的列表并将其输出到一份文件。完成后，我的脚本的其余部分将调用该文本文件，并使用Windows 7注册表项或Windows XP创建另一个包含所有计算机名称和日期/时间/以及团队查看者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

2 个答案:

答案 0 :(得分：0)

问题的原因是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

答案 1 :(得分：0)

这是我想出的。我不得不添加“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
相关问题
最新问题