Vista - wmi fails after large number of calls

i have several scripts that use wmi that run fine against a 10 -50 hosts but
when running on 800+ or so will get through about 50 -180 hosts and then
fail. any ideas ? the number of hosts before failure varies but is usually
in the range mentioned.

script is below.

' /-------------------------------------------------------------
' |
' | <Script Description>
' | this script will find files using cim_datafile class from wmi
' | it will work recursively... going through all folders on a drive to
find files
' |
' |
' | Tested:
' | WinXp : ??
' | Win2003 32 bit: yes but errors with many hosts
' | Win2003 64 bit: yes but errors with many hosts
' | Win2000: yes but errors with many hosts
' |

' /-------------------------------------------------------------
' |
' | Init. some Values
' |
' \-------------------------------------------------------------


'some constants
'

Start = Now
On Error Resume Next
Const ForReading = 1
Const ForAppending = 8
Const OverwriteExisting = True
Const CONVERSION_FACTOR = 1048576


Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20


'some variables
'

strnames = "C:\data\scripts\names.txt"
strlogfile = "C:\data\scripts\find_files3.tsv"
strDrive = "c:"

Set objDictionary = CreateObject("Scripting.Dictionary")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(strnames, ForReading)


' /-------------------------------------------------------------
' |
' | 'create the log file
' |
' \-------------------------------------------------------------



If objFSO.FileExists (strlogfile) Then
Set objLogFile = objFSO.OpenTextFile (strlogfile, ForAppending)
Else
Set objLogFile = objFSO.CreateTextFile (strlogfile)
End If


' /-------------------------------------------------------------
' |
' | ' we write the list of servers to a dictionary

' |
' \-------------------------------------------------------------



i = 0
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop


'

' /-------------------------------------------------------------
' |
' | we do stuff to the servers in our dictionary

' |
' \-------------------------------------------------------------



For Each objItem in objDictionary

g_StrComputer = objDictionary.Item(objItem)


'Ping host to ensure that it is accessible.
blnPing = PingHost
If blnPing = True Then
ObjLogFile.WriteLine g_strcomputer & vbtab & "pinged ok ..."
blnWMI_Test = WMI_Test
If blnWMI_Test = True Then
ObjLogFile.WriteLine g_strcomputer & vbtab & "wmi tested ok ..."
blnFind = Find

Else
ObjLogFile.WriteLine " Error " & vbtab & g_strcomputer & vbtab & "wmi
failed "
end if
Else

ObjLogFile.WriteLine " Error " & vbtab & g_strcomputer & vbtab & "ping
failed "
end if


Set colFiles = nothing
StrFoundFile = ""
found = 0

Next

'we write how long the script took
ObjLogFile.WriteLine vbcrlf & "***********************"
ObjLogFile.WriteLine " this script took " & DateDiff("s", Start, Now) & "
seconds to complete."


' /-------------------------------------------------------------
' |
' | Clean Up
' |
' \-------------------------------------------------------------

objLogFile.Close
objTextFile.Close

StrComputer = ""
strNextLine = ""

Set objFSO = Nothing
Set objDictionary = Nothing


' /+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +
' + Subroutines and Functions Section

' +
' \+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++



'******************************************************************************

Function PingHost

Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("ping -n 2 -w 1000 " & g_strComputer)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") Then
PingHost = True
Else
PingHost = False
End If

End Function

'******************************************************************************


Function WMI_Test

'here we connect to wmi

ObjLogFile.WriteLine " running wmi test on " & vbtab & g_strcomputer

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

If Err.Number = 0 Then
WMI_Test = True
Else
WMI_Test = False
End If

Set objWMIService = Nothing

End Function

'******************************************************************************

Function Find

ObjLogFile.WriteLine " getting files via wmi on " & vbtab & g_strcomputer

'have to connect to wmi again . does not seem to retain connection from
prior function

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

Set colFiles = objWMIServ2.ExecQuery( _
"Select * from CIM_DataFile where drive = 'c:' " & _
"AND FileName = 'shutdown'")

If Err.Number = 0 Then
If Colfiles.count = 0 then
ObjLogFile.WriteLine " Success" & vbtab & g_strcomputer & vbtab & "zero
files "
Else
End if
For Each objFile in colFiles
ObjLogFile.WriteLine " Success" & vbtab & g_strcomputer & vbtab &objfile.name
ObjLogFile.WriteLine vbcrlf
Next

Else
ObjLogFile.WriteLine " find file query failed "

End if

Set objWMIServ2 = Nothing

End Function

'******************************************************************************

Are you saying it works for the first 50 or so, then fails for all machines
after that? Or, does it connect to a given computer sometimes, but fail at
others? Or is it failing on the same computer?

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--

I assume a
"mpwarril" <mpwarril@xxxxxx> wrote in message
news:9E6C957C-6558-4703-8EB0-676AE2E85790@xxxxxx