working routine seems to hang on some servers

[skar]

The function below seems to work on 90% of windows servers. It catches if the server is a DC or not. But for some reason it hangs on some boxes. What would my next step be? It doesnt get to the msgbox that says "Im in the loop".

Any help please!

'DomainControllerCheck - If the server is a DC then skip it. Otherwise the domain admin account
'has its password reset.
Function DomainContollerCheck(strComputername)
Dim objWMIService, colComputers, colItem
'==========================================
'Call the WMI service on the target machine
'==========================================

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputername & "\root\cimv2")

'==========================================================
'Extract the contents of the Win32_ComputerSystem container
'========================================================== 

Set colComputers = objWMIService.ExecQuery _
    ("Select DomainRole from Win32_ComputerSystem")

'=========================================================
'Loop through the results as it is passed back as an array
'=========================================================

for each colItem in colComputers
msgbox "im in the loop"
if colItem.DomainRole = 4 or colItem.DomainRole = 5 then

'========================================================================
'If the computer is a domain controller, this part of the script executes
'========================================================================

	msgbox "This is a domain controller"
	dc = 1
else

'==================================================================
'If the computer is anything else, this part of the script executes
'==================================================================

	msgbox "This is not a domain controller"
	dc = 0
end if
next
End Function

 

[EBGreen]

My first question would be: Do you have On Error Resume Next anywhere in the scriot? If you do, then comment it out and I suspect you will see what the error is.

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[skar]

<bangs head against wall....> argh!

Ok, I've removed the On Error Resume Next and its running again. I'll see what happens.

Thanks.

 

[skar]

Its still hanging and without errors. With the use of msgbox I know it gets to this part of the code. Starts the loop but doesnt pop up the next msgbox.

Any ideas?

for each colItem in colComputers
msgbox "im in the loop"
if colItem.DomainRole = 4 or colItem.DomainRole = 5 then

 

[EBGreen]

So this does pop up a box:

MsgBox "Before Loop"
for each colItem in colComputers
msgbox "im in the loop"
if colItem.DomainRole = 4 or colItem.DomainRole = 5 then

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[skar]

Yes. Odd huh? As it works fine for most of the servers I'm running this against.

Any ideas what I could do to catch this error?

 

[EBGreen]

What do you get if you put a messagebox in to show you colComputers.Count?

I suspect it will be 0 and your problem is actually further down in the code.

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[skar]

Ok, I put in the msgbox with colComputers.Count and ran it against a known good server and one that it wont run against.

The working server gave me a 1 and ran with no problems. The other server didnt show me the colComputers.Count msgbox. It just hung.

 

[EBGreen]

This is sounding more and more like On Error Resume Next is still present somewhere in the script. Either way, it sounds like there is a problem with the creation of the collection. Put a messagebox immediately after you try to create the collection that will show you Err.Number.

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[PScottC]

Is there a version difference on the servers that don't work correctly? WMI wasn't available in NT4 unless you specifically installed it.

PSC

Governments and corporations need people like you and me. We are samurai. The keyboard cowboys. And all those other people out there who have no idea what's going on are the cattle. Mooo! --Mr. The Plague, from the movie "Hackers

 

[skar]

I'm using two servers for these tests. Server82 and server83. They are both Windows 2000 sp3. I'm checking them now to see what the differences are. But it seems they are "sister" servers. Both running pretty much the same software.

Server82 runs fine. Server83 hangs the script.

I take it WMI is standard on 2000 and above?

TomThumbKP: Thanks for the help so far. I put another msgbox in before and after. It hangs as soon as it starts the loop. So Im getting nothing back. Below is the entire script.

Option Explicit 
'On Error Resume Next
 
Dim oFSO, oFailureReport, oSuccessReport, oTextStream, oAdminID, RemotePC, strComputerName, AdminAccount
Dim adminPassword, NewPassword, dc
 
set oFSO=CreateObject("Scripting.FileSystemObject")
 
If Not oFSO.FolderExists("C:\Adminpass\scripts\lists") Then
 oFSO.CreateFolder("c:\Adminpass")
 oFSO.CreateFolder("c:\Adminpass\scripts")
 oFSO.CreateFolder("C:\Adminpass\scripts\lists")
End If 
 
If oFSO.FileExists("C:\Adminpass\scripts\lists\failed.txt") Then
   oFSO.DeleteFile("C:\Adminpass\scripts\lists\failed.txt")
End If 
 
If oFSO.FileExists("C:\Adminpass\scripts\lists\success.txt") Then
   oFSO.DeleteFile("C:\Adminpass\scripts\lists\success.txt")
End If 
 

set oFailureReport=oFSO.createtextfile("C:\Adminpass\scripts\lists\failed.txt")
set oSuccessReport=oFSO.createtextfile("C:\Adminpass\scripts\lists\success.txt")


'open the data file
Set oTextStream = oFSO.OpenTextFile("wslist.txt")
'make an array from the data file
RemotePC = Split(oTextStream.ReadAll, vbNewLine)
'close the data file
oTextStream.Close
 
Call InputPassword()

'msgbox NewPassword

For Each strComputername In RemotePC
	msgbox "Start DC Check Routine..." & strComputername
	call DomainContollerCheck(strComputername)
	msgbox strComputername & " DC= " & dc 
	if dc = 1 then 
		
		msgbox strComputername & " is a DC. Checking next server in the list..."
	Else
		'msgbox "Testing stops here!"
		'WScript.Quit
		'Get admin account even if it has been renamed
		call GetAdminAccount(strComputername)
        	msgbox AdminAccount
    		'Goto the local Admin account of the machine
    		set oAdminID = GetObject("WinNT://" & strComputername & "/" & AdminAccount & ", user")
      		'Check for error and record in case of failed attempt
      		If Err Then
        		ReportError()
        		Err.Clear
      		Else
          		adminPassword = NewPassword
          		oAdminID.SetPassword adminPassword
          		oAdminID.SetInfo
          		oSuccessReport.WriteLine strComputername & " Admin Password was reset."
      		End If
	End If
Next

'Close all open files
oFailureReport.close
oSuccessReport.close
 
'Present yourself a message so you'll know its finsihed
msgbox "All servers in the list have now been run against this script. "
 
set oFSO = nothing
set oAdminID = Nothing
set oTextStream = nothing
set oSuccessReport = nothing
set oFailureReport = nothing
 
'GetAdminAccount - Finds the administrator account name for the specified member server
'The "Well Known Sid" for the admin account is "S-1-5-<domain>-500"
'500 = 0x1F4 ->F4,01 (Little Endian) -> F41 (when the zero is removed)
'The SID seems to be double null terminated so the hex representation we are looking
'for is "F4,01,00,00" or "F4100"
Function GetAdminAccount(strComputername)
  Dim colUsers, User, Sid, x, y, i, strErrDescr
  'msgbox strComputername
  Set colUsers = GetObject("WinNT://" & strComputername & ",computer")
  If Err.Number <> 0 Then
    'Call LogToFile()
    msgbox "ERROR: Could not connect to server '" & strComputername & "' to identify the admin account. " & ErrDescr(Hex(Err.Number))
    Err.Clear
    'On Error Goto 0
    Exit Function
  End If
  colUsers.Filter = Array("User")
  For each user in colUsers
    y=""
    Sid = user.get("ObjectSID")
    x = MidB(Sid,LenB(Sid) - 3)
    For i = 1 to LenB(x)
      y = y & Hex(AscB(MidB(x,i,1)))
    Next
    If y = "F4100" Then
      AdminAccount = user.name
    End If
  Next
  'On Error Goto 0
End Function

'DomainControllerCheck - If the server is a DC then skip it. Otherwise the domain admin account
'has its password reset.
Function DomainContollerCheck(strComputername)
Dim objWMIService, colComputers, colItem
'==========================================
'Call the WMI service on the target machine
'==========================================

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputername & "\root\cimv2")

'==========================================================
'Extract the contents of the Win32_ComputerSystem container
'========================================================== 

Set colComputers = objWMIService.ExecQuery _
    ("Select DomainRole from Win32_ComputerSystem")

'=========================================================
'Loop through the results as it is passed back as an array
'=========================================================
msgbox "starting the loop..."
msgbox Err.Number
for each colItem in colComputers
msgbox Err.Number
if colItem.DomainRole = 4 or colItem.DomainRole = 5 then

'========================================================================
'If the computer is a domain controller, this part of the script executes
'========================================================================

	msgbox "This is a domain controller"
	dc = 1
else

'==================================================================
'If the computer is anything else, this part of the script executes
'==================================================================

	msgbox "This is not a domain controller"
	dc = 0
end if
next
End Function

'InputPassword Routine
Function InputPassword()
  Dim PWD_TITLE, PWD_PROMPT_CORE, PWD_PROMPT_ONE, PWD_PROMPT_TWO, PWD_QUIT_QUESTION, PWD_MISMATCH
  PWD_TITLE = "New Password"
  PWD_PROMPT_CORE = "This script will change all local admin passwords that are in the txt file server-list.txt." & vbCrLf & vbCrLf
  PWD_PROMPT_ONE = "Enter the new password here:"
  PWD_PROMPT_TWO = "Re-Enter the new password here:"
  PWD_QUIT_QUESTION = "No password was specified. Do you want to Quit?"
  PWD_MISMATCH = "The password does not match!"
  
  Dim PwdOKFlag, strPwd1, strPwd2
  
  PwdOKFlag = False
  While PwdOKFlag = False
    strPwd1 = InputBox(PWD_PROMPT_CORE & PWD_PROMPT_ONE, PWD_TITLE)
    If strPwd1 = "" Then
      If MsgBox(PWD_QUIT_QUESTION, vbQuestion + vbYesNo, PWD_TITLE) = vbYes Then
        WScript.Quit
      End If
    End If
    strPwd2 = InputBox(PWD_PROMPT_CORE & PWD_PROMPT_TWO, PWD_TITLE)

    If (strPwd1 <> strPwd2) Then
      MsgBox PWD_MISMATCH, vbOKOnly, PWD_TITLE
    Else  
      PwdOKFlag = True
	End if
  WEnd
  NewPassword = strPwd1
End Function

'LogToFile - add log info to the file
Sub LogToFile(strTxtToAdd)
  Dim fso, f
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile(PWD_CHANGE_LOG, 8, True)
  f.WriteLine strTxtToAdd
  f.Close
End Sub

Sub ReportError()
    oFailureReport.WriteLine strComputername & " could not be reset."
End Sub

 

[tsuji]

[1] Some side notes
[1.a] This logic is not robust.
[tt]>If Not oFSO.FolderExists("C:\Adminpass\scripts\lists") Then
> oFSO.CreateFolder("c:\Adminpass")
> oFSO.CreateFolder("c:\Adminpass\scripts")
> oFSO.CreateFolder("C:\Adminpass\scripts\lists")
>End If [/tt]
You probably get away with it because you have already the folder and no need to create anything. Otherwise if any of the parent folder exists, you have a runtime error and disturb the flow of the script if you have on error resume next.
[1.b] This is minor observation.
[tt]>Set oTextStream = oFSO.OpenTextFile("wslist.txt")[/tt]
Better furnished parameters (..., 1,true)[/tt] for instance to eliminate ambiguity, if any.
[1.c]
[tt]>set oFSO = nothing
>set oAdminID = Nothing
>set oTextStream = nothing
>set oSuccessReport = nothing
>set oFailureReport = nothing[/tt]
Watch out. At least move the set oFSO line to the end. Better in the reverse order of their creation.
[1.d] In LogToFile, you can use the globally scoped oFSO instead of creating oFSO.
[1.e] In LogToFile, PWD_CHANGE_LOG is not defined anywhere.
[1.f] In GetAdminAccount, what is ErrDescr function. (I see what it would be, but it is not defined.) Besides, err.description would probably do similar thing.
[1.g] You practically must, if not you better, make sure that you do nothing if trim(strComputername) is empty. It is the most common occurence if the text file ended with a carriage return.

[2] Now, the main thing I see is that if you script it with inline error handling in mind, you have to put on error resume next inside every sub/function level. Hence, you must put inside DomainContollerCheck (sic) and at its top "on error resume next". The behaviour of without it is that once encountering a runtime error within the sub, the control is immediately return to the caller main function. This may provoke unpredictable behavior. The missing msgbox action is probably due to this as the control is already given back to the back. So, uncomment the on error in the main and add on error to every sub/function.