05/06/2015 1432 views

##VBscript to check for a registry key on a text file of workstations works, but if the workstation is offline or had a DNS/IP conflict script crashes. I am struggling with adding logic to check for if it pings output the regitry setting, if it is offline or dns/ip conflict output the issue. Any help would be appreicated.##


' Set the constants
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForAppending = 8

' Create FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile ("C:\outputfile.csv", ForAppending, True)

arrComputers = Split(objFSO.OpenTextFile("C:\inputfile.txt").ReadAll, vbNewLine)

for each strComputer in arrComputers
  'wscript.echo "Examining " & strComputer
  Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
  objFile.WriteLine "Workstation Name: " & strComputer
  strKeyPath = "Software\ODBC\ODBC.INI\somesetting"
  strValueName = "Server"
  oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
  objFile.WriteLine("Current ODBC Setting: " & strValue)


0 Comments   [ + ] Show comments


All Answers


First, please apply the CODE style to your code. It makes the post easier to read.

Second, try this:

Public strMsg
Public strLogText

If WMIPing(strComputer) Then
 '// Do something with the machine
 '// Write out to your log that the machine isn't present
End If

Function WMIPing(ByVal strMachineNameOrIP)
 '// Returns True if strMachineNameOrIP is alive or False if dead
 Dim objPing 
 Dim objStatus 
 Dim intStatus 
 On Error Resume Next

 WMIPing  = False
 Set objPing  = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strMachineNameOrIP & "'")     

 If Err.Number <> 0 Then
  strMsg  = "Function WMIPing: Unable to create WMI Ping object" & vbCRLF
  If Len(strLogText) > 0 Then
   strLogText = strLogText & vbCRLF & vbCRLF & strMsg
   strLogText = strMsg
  End If
  On Error Goto 0
  Exit Function
 End If
 For Each objStatus In objPing   
  intStatus = objStatus.StatusCode

  Select Case intStatus
   Case 0 '// Success
    WMIPing = True
   Case 11001 '// Buffer Too Small
   Case 11002 '// Destination Net Unreachable
   Case 11003 '// Destination Host Unreachable
   Case 11004 '// Destination Protocol Unreachable
   Case 11005 '// Destination Port Unreachable
   Case 11006 '// No Resources
   Case 11007 '// Bad Option
   Case 11008 '// Hardware Error
   Case 11009 '// Packet Too Big
   Case 11010 '// Request Timed Out
   Case 11011 '// Bad Request
   Case 11012 '// Bad Route
   Case 11013 '// TimeToLive Expired Transit
   Case 11014 '// TimeToLive Expired Reassembly
   Case 11015 '// Parameter Problem
   Case 11016 '// Source Quench
   Case 11017 '// Option Too Big
   Case 11018 '// Bad Destination
   Case 11032 '// Negotiating IPSEC
   Case 11050 '// General Failure
  End Select
 On Error Goto 0
  Set objPing = Nothing
End Function

I haven't added the necessary code to "plug in" to yours: I'll leave that to you.

Third, your code urgently needs some error-trapping. Remember: in your code, always assume that NOTHING will work! For example, turn this:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile ("C:\outputfile.csv", ForAppending, True)

into this:

Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not IsObject(objFSO) Then
 '// Exit with an appropriate message
End If

Set objFile = objFSO.OpenTextFile ("C:\outputfile.csv", ForAppending, True)
If Not IsObject(objFile) Then
 '// Exit with an appropriate message
End If

and so on. It seems like a monumental PITA but it means your code is robust and that it will cope with any eventuality.

For generic error-handling, I am a long-term user of a routine that somebody created using Bruce McKinney's BugAssert function as inspiration.

Answered 05/07/2015 by: VBScab
Red Belt