Solved

This vbs script stops in the middle and shows no output also.

Posted on 2010-09-22
35
507 Views
Last Modified: 2012-05-10
Hi,

This vbs script stops in the middle and shows no output also.
Can i have the log created and updating happening from the first system.
So if it gets stuck i know which machine its stuck at.

Can we skip those errors.

This script queries all machines and gets the shares details. if possible please record the everypne full access shares only and not all shares.

Regards
Sharath
0
Comment
Question by:bsharath
  • 18
  • 11
  • 3
  • +3
35 Comments
 
LVL 14

Expert Comment

by:robincm
ID: 33741757
Where's the script?
0
 
LVL 11

Author Comment

by:bsharath
ID: 33741764
Sorry missed that
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    Set objShell = CreateObject("Wscript.Shell")

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

Const strInputFile = "Computers.txt"

Const strOutputFile = "ServerShares.csv"



strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""



Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	If Ping(strServer) = True Then

		GetShareAccessInfo(strServer)

	Else

		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

	End If

Wend

objInputFile.Close



MsgBox "Script has finished going through servers. Please see " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)

objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

	Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

	If Err.Number = 0 Then

		For Each objItem In colItems

			' Check for Disk shares only

			If objItem.Type = 0 Then

				'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

				On Error Resume Next

				Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

				RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

				If Err.Number <> 0 Then

					strTrustee = ""

					strType = ""

					strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

					Err.Clear

					On Error GoTo 0

				Else

					On Error GoTo 0

					' Retrieve the DACL array of Win32_ACE objects.

					DACL = wmiSecurityDescriptor.DACL

					strAccessMask = ""

					For Each wmiAce In DACL

						'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

						Set Trustee = wmiAce.Trustee

						If IsNull(Trustee.Domain) Then

							strTrustee = Trustee.Name

						Else

							strTrustee = Trustee.Domain & "\" & Trustee.Name

						End If

						'strAccessMask = strAccessMask & "Trustee: " & strTrustee

						Select Case wmiAce.AceType

							Case 0

								strType = "Allow"

							Case 1

								strType = "Deny"

						End Select

						'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

						Select Case wmiAce.AccessMask

							Case 1179817

								strAccessMask = "Read (" & wmiAce.AccessMask & ")"

							Case 1245631

								strAccessMask = "Change (" & wmiAce.AccessMask & ")"

							Case 2032127

								strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

							Case Else

								strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

						End Select

						strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

					Next

				End If		

		    End If

		Next

	Else

		Err.Clear

		On Error GoTo 0

		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 1

Expert Comment

by:rd1966
ID: 33745503
If you take out the 'On Error Resume Next' on line 44, you'll see it's line 45 that's failing with error  0x80041002.  You'll not get the error reported via the variable strAccessMask, in line 50, is never displayed or written to file..

Not sure if that helps, but I think that's your root cause.
0
 
LVL 1

Expert Comment

by:rd1966
ID: 33745710
I believe line 45 is failing as the share has no permissions.  When you check in Windows Explorer, it will probably show up as "Everyone" though.  If you add a real user, the error may not occur.  Just need to change the script to handle the situation?
0
 
LVL 11

Author Comment

by:bsharath
ID: 33745725
Yes need to skip if error occurs and the script only outputs finally after quering all machines.
If possible need to create the report from the first machine. So i know how its progressing as well
0
 
LVL 8

Expert Comment

by:GeneralTackett
ID: 33746680
how about on error resume?
0
 
LVL 1

Expert Comment

by:rd1966
ID: 33747915
Which OS are you using?  The script behaves differently on my home (Windows 7) and work PC (WInXP SP3)...
0
 
LVL 11

Author Comment

by:bsharath
ID: 33750861
I am running from a win Xp machine with Sp3
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33767075
Sharath, try this.

It should have reporting at each branch, so you should see at least *something* in the report for each server.

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    Set objShell = CreateObject("Wscript.Shell")

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

Const strInputFile = "Computers.txt"

Const strOutputFile = "ServerShares.csv"



strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""



Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	If Ping(strServer) = True Then

		GetShareAccessInfo(strServer)

	Else

		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

	End If

Wend

objInputFile.Close



MsgBox "Script has finished going through servers. Please see " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)

objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

	Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

	If Err.Number = 0 Then

		For Each objItem In colItems

			' Check for Disk shares only

			If objItem.Type = 0 Then

				'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

				On Error Resume Next

				Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

				RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

				If Err.Number <> 0 Then

					strTrustee = ""

					strType = ""

					strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

					strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

					Err.Clear

					On Error GoTo 0

				Else

					On Error GoTo 0

					' Retrieve the DACL array of Win32_ACE objects.

					DACL = wmiSecurityDescriptor.DACL

					strAccessMask = ""

					For Each wmiAce In DACL

						'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

						Set Trustee = wmiAce.Trustee

						If IsNull(Trustee.Domain) Then

							strTrustee = Trustee.Name

						Else

							strTrustee = Trustee.Domain & "\" & Trustee.Name

						End If

						'strAccessMask = strAccessMask & "Trustee: " & strTrustee

						Select Case wmiAce.AceType

							Case 0

								strType = "Allow"

							Case 1

								strType = "Deny"

						End Select

						'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

						Select Case wmiAce.AccessMask

							Case 1179817

								strAccessMask = "Read (" & wmiAce.AccessMask & ")"

							Case 1245631

								strAccessMask = "Change (" & wmiAce.AccessMask & ")"

							Case 2032127

								strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

							Case Else

								strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

						End Select

						strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

					Next

				End If		

		    End If

		Next

	Else

		Err.Clear

		On Error GoTo 0

		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33768125
Thanks Rob at one machine it gets stuck and does not move to next machine.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33768755
Rob i deleted the machine names where it gets stuck. But the csv file is not available it does not save
0
 
LVL 17

Expert Comment

by:Shanmuga Sundaram
ID: 33776460
bsharath the output file should be created in the directory where the script is running from. If you want the file to be created and read from the specific location then replace these lines

Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"


with

Const strInputFile = "C:\Computers.txt"
Const strOutputFile = "c:\ServerShares.csv"

This will create the output file in c drive root. similarly this will read the file from the c drive root.

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33785280
Try this.....it should output in a more verbose manner, hopefully giving us a clue as to where it stops.  You should see more output in the DOS prompt as it goes through the servers in computers.txt

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    Set objShell = CreateObject("Wscript.Shell")

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

Const strInputFile = "Computers.txt"

Const strOutputFile = "ServerShares.csv"



strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""



WScript.Echo "Opening input file..."

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	WScript.Echo "Pinging " & strServer

	If Ping(strServer) = True Then

		WScript.Echo strServer & " responded. Getting share info..."

		GetShareAccessInfo(strServer)

	Else

		WScript.Echo strServer & " did not respond."

		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

	End If

Wend

objInputFile.Close



WScript.Echo VbCrLf & "Creating output file " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)

objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing

WScript.Echo "Output file created."



MsgBox "Script has finished going through servers. Please see " & strOutputFile



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	WScript.Echo "Connecting to " & strServer & " via WMI..."

	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

	Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

	If Err.Number = 0 Then

		WScript.Echo "WMI connection successful"

		For Each objItem In colItems

			' Check for Disk shares only

			If objItem.Type = 0 Then

				WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."

				'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

				On Error Resume Next

				Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

				RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

				If Err.Number <> 0 Then

					WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description

					strTrustee = ""

					strType = ""

					strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

					strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

					Err.Clear

					On Error GoTo 0

				Else

					WScript.Echo "Enumerating DACL..."

					On Error GoTo 0

					' Retrieve the DACL array of Win32_ACE objects.

					DACL = wmiSecurityDescriptor.DACL

					strAccessMask = ""

					For Each wmiAce In DACL

						'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

						Set Trustee = wmiAce.Trustee

						If IsNull(Trustee.Domain) Then

							strTrustee = Trustee.Name

						Else

							strTrustee = Trustee.Domain & "\" & Trustee.Name

						End If

						'strAccessMask = strAccessMask & "Trustee: " & strTrustee

						Select Case wmiAce.AceType

							Case 0

								strType = "Allow"

							Case 1

								strType = "Deny"

						End Select

						'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

						Select Case wmiAce.AccessMask

							Case 1179817

								strAccessMask = "Read (" & wmiAce.AccessMask & ")"

							Case 1245631

								strAccessMask = "Change (" & wmiAce.AccessMask & ")"

							Case 2032127

								strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

							Case Else

								strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

						End Select

						WScript.Echo "Storing share access results for " & strTrustee & "..."

						strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

					Next

				End If		

		    End If

		Next

	Else

		WScript.Echo "WMI Error connecting to " & strServer

		Err.Clear

		On Error GoTo 0

		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33804953
Rob the script runs now. But cannot find the csv where its stored...
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33804957
If you get the message "Script has finished going through servers" then you should find ServerShares.csv in the same folder as the VBS file.

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33804968
Running it again now...
Can you help with this please...
http://www.experts-exchange.com/Programming/Languages/Q_26501147.html
0
 
LVL 11

Author Comment

by:bsharath
ID: 33809184
Rob the script gets stuck at one machine

Retrieving Logical Share Security Settings for ProdvVerIssues...
Enumerating DACL...
Storing share access results for Everyone...
Pinging Dev051
Dev051 responded. Getting share info...
Enumerating De051
Connecting to Dev051 via WMI...

if i remove that machine and run again it gets stuck at another machine. can we record the faiure and skip or sort this issue.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 65

Expert Comment

by:RobSampson
ID: 33812474
It should *eventually* get past that.  When you connect to a machine via WMI using GetObject, there's no time-out that you can set.  You just have to wait for the GetObject call to return some error code, which my code traps and should output, and then continue.  How long have you left it for?  It shouldn't take more than 10 minutes maximum I don't think.

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33813165
But its been 12 hrs and its still stuck on this one machine
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33818892
OK, maybe try this.  It adds one more line of error checking.

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    Set objShell = CreateObject("Wscript.Shell")

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

Const strInputFile = "Computers.txt"

Const strOutputFile = "ServerShares.csv"



strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""



WScript.Echo "Opening input file..."

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	WScript.Echo "Pinging " & strServer

	If Ping(strServer) = True Then

		WScript.Echo strServer & " responded. Getting share info..."

		GetShareAccessInfo(strServer)

	Else

		WScript.Echo strServer & " did not respond."

		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

	End If

Wend

objInputFile.Close



WScript.Echo VbCrLf & "Creating output file " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)

objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing

WScript.Echo "Output file created."



MsgBox "Script has finished going through servers. Please see " & strOutputFile



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	WScript.Echo "Connecting to " & strServer & " via WMI..."

	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

	If Err.Number = 0 Then

		WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."

		Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

		If Err.Number = 0 Then

			For Each objItem In colItems

				' Check for Disk shares only

				If objItem.Type = 0 Then

					WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."

					'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

					On Error Resume Next

					Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

					RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

					If Err.Number <> 0 Then

						WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description

						strTrustee = ""

						strType = ""

						strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

						strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

						Err.Clear

						On Error GoTo 0

					Else

						WScript.Echo "Enumerating DACL..."

						On Error GoTo 0

						' Retrieve the DACL array of Win32_ACE objects.

						DACL = wmiSecurityDescriptor.DACL

						strAccessMask = ""

						For Each wmiAce In DACL

							'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

							Set Trustee = wmiAce.Trustee

							If IsNull(Trustee.Domain) Then

								strTrustee = Trustee.Name

							Else

								strTrustee = Trustee.Domain & "\" & Trustee.Name

							End If

							'strAccessMask = strAccessMask & "Trustee: " & strTrustee

							Select Case wmiAce.AceType

								Case 0

									strType = "Allow"

								Case 1

									strType = "Deny"

							End Select

							'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

							Select Case wmiAce.AccessMask

								Case 1179817

									strAccessMask = "Read (" & wmiAce.AccessMask & ")"

								Case 1245631

									strAccessMask = "Change (" & wmiAce.AccessMask & ")"

								Case 2032127

									strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

								Case Else

									strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

							End Select

							WScript.Echo "Storing share access results for " & strTrustee & "..."

							strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

						Next

					End If		

			    End If

			Next

		Else

			WScript.Echo "Error enumerating Win32_Share information on " & strServer

			Err.Clear

			On Error GoTo 0

			strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

		End If

	Else

		WScript.Echo "WMI Error connecting to " & strServer

		Err.Clear

		On Error GoTo 0

		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33819902
Hi Rob i get this and its stuck

Pinging Dev00
Dev00 responded. Getting share info...
Enumerating Dev00
Connecting to Dev00 via WMI...
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33819916
Hmmmm, the GetObject call should be eventually timing out.....

What happens if you replace this line:
      Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

with this:
      Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
      Set objWMI = objSWbemLocator.ConnectServer(strServer, "root\cimv2")

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33819931
0
 
LVL 11

Author Comment

by:bsharath
ID: 33820152
Rob still gets stuck here

Pinging Dev0
Dev0 responded. Getting share info...
Enumerating Dev0
Connecting to Dev0 via WMI...
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33820231
OK, what happens if you open a command prompt and run this:
wmic /NODE:"Dev0" computersystem get name

Does it sit there forever and not return anything?  If there's a WMI problem, it should cause an error.

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33820269
Rob even that command just stays intact without any change.
Even the script gets stuck with that machine and hrs later also there is no change
0
 
LVL 11

Author Comment

by:bsharath
ID: 33820310
I get this

C:\>wmic /NODE:"Dev0" computersystem ge
t name
Node - Dev0
ERROR:
Code = 0x800706ba
Description = The RPC server is unavailable.
Facility = Win32
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33820839
OK, that error from WMIC is what I expected to happen.  How long did it take to do that?

Anyway, I've made the code use WMIC for the WMI connection test, so hopefully it will at least *eventually* time out.

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objShell = CreateObject("Wscript.Shell")

Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

Const strInputFile = "Computers.txt"

Const strOutputFile = "ServerShares.csv"



strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""



WScript.Echo "Opening input file..."

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	WScript.Echo "Pinging " & strServer

	If Ping(strServer) = True Then

		WScript.Echo strServer & " responded. Getting share info..."

		GetShareAccessInfo(strServer)

	Else

		WScript.Echo strServer & " did not respond."

		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

	End If

Wend

objInputFile.Close



WScript.Echo VbCrLf & "Creating output file " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)

objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing

WScript.Echo "Output file created."



MsgBox "Script has finished going through servers. Please see " & strOutputFile



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	WScript.Echo "Connecting to " & strServer & " via WMI..."

	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)

	If intReturn = 0 Then

		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

		If Err.Number = 0 Then

			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."

			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

			If Err.Number = 0 Then

				For Each objItem In colItems

					' Check for Disk shares only

					If objItem.Type = 0 Then

						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."

						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						On Error Resume Next

						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

						If Err.Number <> 0 Then

							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description

							strTrustee = ""

							strType = ""

							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

							strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

							Err.Clear

							On Error GoTo 0

						Else

							WScript.Echo "Enumerating DACL..."

							On Error GoTo 0

							' Retrieve the DACL array of Win32_ACE objects.

							DACL = wmiSecurityDescriptor.DACL

							strAccessMask = ""

							For Each wmiAce In DACL

								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

								Set Trustee = wmiAce.Trustee

								If IsNull(Trustee.Domain) Then

									strTrustee = Trustee.Name

								Else

									strTrustee = Trustee.Domain & "\" & Trustee.Name

								End If

								'strAccessMask = strAccessMask & "Trustee: " & strTrustee

								Select Case wmiAce.AceType

									Case 0

										strType = "Allow"

									Case 1

										strType = "Deny"

								End Select

								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

								Select Case wmiAce.AccessMask

									Case 1179817

										strAccessMask = "Read (" & wmiAce.AccessMask & ")"

									Case 1245631

										strAccessMask = "Change (" & wmiAce.AccessMask & ")"

									Case 2032127

										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

									Case Else

										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

								End Select

								WScript.Echo "Storing share access results for " & strTrustee & "..."

								strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

							Next

						End If		

				    End If

				Next

			Else

				WScript.Echo "Error enumerating Win32_Share information on " & strServer

				Err.Clear

				On Error GoTo 0

				strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

			End If

		Else

			WScript.Echo "WMI Error connecting to " & strServer

			Err.Clear

			On Error GoTo 0

			strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

		End If

	Else

		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer

		Err.Clear

		On Error GoTo 0

		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33820842
Rob i get this

---------------------------
Windows Script Host
---------------------------
Script:      D:\Shares.vbs
Line:      4
Char:      5
Error:      Object required: 'objShell'
Code:      800A01A8
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33826523
Whoops.
Set objShell = CreateObject("Wscript.Shell")

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

Const strInputFile = "Computers.txt"

Const strOutputFile = "ServerShares.csv"



strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""



WScript.Echo "Opening input file..."

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	WScript.Echo "Pinging " & strServer

	If Ping(strServer) = True Then

		WScript.Echo strServer & " responded. Getting share info..."

		GetShareAccessInfo(strServer)

	Else

		WScript.Echo strServer & " did not respond."

		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

	End If

Wend

objInputFile.Close



WScript.Echo VbCrLf & "Creating output file " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)

objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing

WScript.Echo "Output file created."



MsgBox "Script has finished going through servers. Please see " & strOutputFile



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	WScript.Echo "Connecting to " & strServer & " via WMI..."

	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)

	If intReturn = 0 Then

		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

		If Err.Number = 0 Then

			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."

			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

			If Err.Number = 0 Then

				For Each objItem In colItems

					' Check for Disk shares only

					If objItem.Type = 0 Then

						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."

						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						On Error Resume Next

						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

						If Err.Number <> 0 Then

							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description

							strTrustee = ""

							strType = ""

							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

							strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

							Err.Clear

							On Error GoTo 0

						Else

							WScript.Echo "Enumerating DACL..."

							On Error GoTo 0

							' Retrieve the DACL array of Win32_ACE objects.

							DACL = wmiSecurityDescriptor.DACL

							strAccessMask = ""

							For Each wmiAce In DACL

								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

								Set Trustee = wmiAce.Trustee

								If IsNull(Trustee.Domain) Then

									strTrustee = Trustee.Name

								Else

									strTrustee = Trustee.Domain & "\" & Trustee.Name

								End If

								'strAccessMask = strAccessMask & "Trustee: " & strTrustee

								Select Case wmiAce.AceType

									Case 0

										strType = "Allow"

									Case 1

										strType = "Deny"

								End Select

								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

								Select Case wmiAce.AccessMask

									Case 1179817

										strAccessMask = "Read (" & wmiAce.AccessMask & ")"

									Case 1245631

										strAccessMask = "Change (" & wmiAce.AccessMask & ")"

									Case 2032127

										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

									Case Else

										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

								End Select

								WScript.Echo "Storing share access results for " & strTrustee & "..."

								strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

							Next

						End If		

				    End If

				Next

			Else

				WScript.Echo "Error enumerating Win32_Share information on " & strServer

				Err.Clear

				On Error GoTo 0

				strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

			End If

		Else

			WScript.Echo "WMI Error connecting to " & strServer

			Err.Clear

			On Error GoTo 0

			strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

		End If

	Else

		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer

		Err.Clear

		On Error GoTo 0

		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33828388
Hi Rob this time it was running without any issue. But suddenly the script completed and no csv file saved
ServerShares.csv
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33828414
OK, try this.  It will output to the file as it goes through each server, and also *make sure* that the output file is created in the same folder as the VBS.

Just out of interest....could you check your C:\Windows\System32\ folder the ServerShares.csv file?

Rob.
Set objShell = CreateObject("Wscript.Shell")

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

strInputFile = "Computers.txt"

strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ServerShares.csv"



WScript.Echo VbCrLf & "Creating output file " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)



'strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

objOutputFile.WriteLine """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

WScript.Echo "Opening input file..."

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	WScript.Echo "Pinging " & strServer

	If Ping(strServer) = True Then

		WScript.Echo strServer & " responded. Getting share info..."

		GetShareAccessInfo(strServer)

	Else

		WScript.Echo strServer & " did not respond."

		'strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

		objOutputFile.WriteLine """" & strServer & """,""OFFLINE"""

	End If

Wend

objInputFile.Close



'objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing

WScript.Echo "Output file created."



MsgBox "Script has finished going through servers. Please see " & strOutputFile



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	WScript.Echo "Connecting to " & strServer & " via WMI..."

	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)

	If intReturn = 0 Then

		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

		If Err.Number = 0 Then

			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."

			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

			If Err.Number = 0 Then

				For Each objItem In colItems

					' Check for Disk shares only

					If objItem.Type = 0 Then

						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."

						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						On Error Resume Next

						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

						If Err.Number <> 0 Then

							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description

							strTrustee = ""

							strType = ""

							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

							'strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

							objOutputFile.WriteLine """" & strServer & """,""GetSecurityDescriptor ERROR"""

							Err.Clear

							On Error GoTo 0

						Else

							WScript.Echo "Enumerating DACL..."

							On Error GoTo 0

							' Retrieve the DACL array of Win32_ACE objects.

							DACL = wmiSecurityDescriptor.DACL

							strAccessMask = ""

							For Each wmiAce In DACL

								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

								Set Trustee = wmiAce.Trustee

								If IsNull(Trustee.Domain) Then

									strTrustee = Trustee.Name

								Else

									strTrustee = Trustee.Domain & "\" & Trustee.Name

								End If

								'strAccessMask = strAccessMask & "Trustee: " & strTrustee

								Select Case wmiAce.AceType

									Case 0

										strType = "Allow"

									Case 1

										strType = "Deny"

								End Select

								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

								Select Case wmiAce.AccessMask

									Case 1179817

										strAccessMask = "Read (" & wmiAce.AccessMask & ")"

									Case 1245631

										strAccessMask = "Change (" & wmiAce.AccessMask & ")"

									Case 2032127

										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

									Case Else

										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

								End Select

								WScript.Echo "Storing share access results for " & strTrustee & "..."

								'strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

								objOutputFile.WriteLine """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

							Next

						End If		

				    End If

				Next

			Else

				WScript.Echo "Error enumerating Win32_Share information on " & strServer

				Err.Clear

				On Error GoTo 0

				'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

				objOutputFile.WriteLine """" & strServer & """,""WMI ERROR"""

			End If

		Else

			WScript.Echo "WMI Error connecting to " & strServer

			Err.Clear

			On Error GoTo 0

			'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

			objOutputFile.WriteLine """" & strServer & """,""WMI ERROR"""

		End If

	Else

		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer

		Err.Clear

		On Error GoTo 0

		'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		

		objOutputFile.WriteLine """" & strServer & """,""WMI ERROR"""		

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33828425
I could not find the file in system32

I get this

D:\Shares.vbs(18, 1) Microsoft VBScript runtime error: Object required: 'objOutputFile'
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 33828445
Sorry....typo....
Set objShell = CreateObject("Wscript.Shell")

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /c cscript  """ & strPath & """"

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If



Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

strInputFile = "Computers.txt"

strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ServerShares.csv"



WScript.Echo VbCrLf & "Creating output file " & strOutputFile

Set objFile = objFSO.CreateTextFile(strOutputFile, True)



'strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

objFile.WriteLine """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

WScript.Echo "Opening input file..."

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream

	strServer = objInputFile.ReadLine

	WScript.Echo "Pinging " & strServer

	If Ping(strServer) = True Then

		WScript.Echo strServer & " responded. Getting share info..."

		GetShareAccessInfo(strServer)

	Else

		WScript.Echo strServer & " did not respond."

		'strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		

		objFile.WriteLine """" & strServer & """,""OFFLINE"""

	End If

Wend

objInputFile.Close



'objFile.Write strResults

objFile.Close

Set objFile = Nothing

Set objFSO = Nothing

WScript.Echo "Output file created."



MsgBox "Script has finished going through servers. Please see " & strOutputFile



Sub GetShareAccessInfo(strServer)

	WScript.Echo "Enumerating " & strServer

	On Error Resume Next

	WScript.Echo "Connecting to " & strServer & " via WMI..."

	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)

	If intReturn = 0 Then

		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

		If Err.Number = 0 Then

			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."

			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")

			If Err.Number = 0 Then

				For Each objItem In colItems

					' Check for Disk shares only

					If objItem.Type = 0 Then

						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."

						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						On Error Resume Next

						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")

						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

						If Err.Number <> 0 Then

							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description

							strTrustee = ""

							strType = ""

							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description

							'strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""

							objFile.WriteLine """" & strServer & """,""GetSecurityDescriptor ERROR"""

							Err.Clear

							On Error GoTo 0

						Else

							WScript.Echo "Enumerating DACL..."

							On Error GoTo 0

							' Retrieve the DACL array of Win32_ACE objects.

							DACL = wmiSecurityDescriptor.DACL

							strAccessMask = ""

							For Each wmiAce In DACL

								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf

								Set Trustee = wmiAce.Trustee

								If IsNull(Trustee.Domain) Then

									strTrustee = Trustee.Name

								Else

									strTrustee = Trustee.Domain & "\" & Trustee.Name

								End If

								'strAccessMask = strAccessMask & "Trustee: " & strTrustee

								Select Case wmiAce.AceType

									Case 0

										strType = "Allow"

									Case 1

										strType = "Deny"

								End Select

								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType

								Select Case wmiAce.AccessMask

									Case 1179817

										strAccessMask = "Read (" & wmiAce.AccessMask & ")"

									Case 1245631

										strAccessMask = "Change (" & wmiAce.AccessMask & ")"

									Case 2032127

										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"

									Case Else

										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"

								End Select

								WScript.Echo "Storing share access results for " & strTrustee & "..."

								'strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

								objFile.WriteLine """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"

							Next

						End If		

				    End If

				Next

			Else

				WScript.Echo "Error enumerating Win32_Share information on " & strServer

				Err.Clear

				On Error GoTo 0

				'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

				objFile.WriteLine """" & strServer & """,""WMI ERROR"""

			End If

		Else

			WScript.Echo "WMI Error connecting to " & strServer

			Err.Clear

			On Error GoTo 0

			'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""

			objFile.WriteLine """" & strServer & """,""WMI ERROR"""

		End If

	Else

		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer

		Err.Clear

		On Error GoTo 0

		'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		

		objFile.WriteLine """" & strServer & """,""WMI ERROR"""		

	End If

End Sub



Function Ping(strComputer)

	Dim objShell, boolCode

	Set objShell = CreateObject("WScript.Shell")

	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)

	If boolCode = 0 Then

		Ping = True

	Else

		Ping = False

	End If

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33828466
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Batch, VBS, and scripts in general are incredibly useful for repetitive tasks.  Some tasks can take a while to complete and it can be annoying to check back only to discover that your script finished 5 minutes ago.  Some scripts may complete nearly …
There is an easy way, in .NET, to centralize the treatment of all unexpected errors. First of all, instead of launching the application directly in a Form, you need first to write a Sub called Main, in a module. Then, set the Startup Object to th…
The viewer will learn how to clear a vector as well as how to detect empty vectors in C++.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now