Monday, August 17, 2009

Rebuild procedure for corrupt WINDOWS performance counters

Its have already been discussed a lot, and correction methods have been placed.

A good place to start is in “http://support.microsoft.com/kb/300956

In Windows Server 2003 and 2008 Microsoft even provides some sort of a rebuild solution (in the article), but it relies on the existence of all the performance counters ini files in the %Systemroot%\System32 directory, which doesn’t include many third party performance counters ini files. 


To rebuild all Performance counters including extensible and third-party counters in

Windows Server 2003, type the following commands at a command prompt. Press ENTER after each command.

cd\windows\system32
lodctr /R

Nevertheless to my recollection ,there wasn’t one thorough solution presented that took into account the following:

1. The interrelations of WMI and the Performance counter mechanism.

(best described in “http://support.microsoft.com/kb/266416”)

2. How to find the most current .ini files that relate to the most current performance counters installed in the system including third-party.

3. A complete solution that automates the all process.

4. We should make sure that the dat files to rebuild the base performance counter libraries are from the proper installation disk of the worked-on operating system - Perfc009.dat file and the Perfh009.dat file. These files are located on the Windows Installation Disc. The compressed files are found at DriveLetter:\i386\perfc009.da_ and at DriveLetter:\i386\perfh009.da_. As part of our restoration procedure, we shall replace the files that are in the %Systemroot%\System32 folder.

5. all the vbe scripts are encoded scripts that
are produced with the screnc executable (a Microsoft utility).

screnc example.vbs example.vbe

 

 

My solution guidelines -

1. WMI uses the performance counters info in its own classes that fills-up its repository (raw and processed).

WMI manages its performance counter information, loading the performance library using ADAP ( AutoDiscovery/AutoPurge ).

We shall use the following procedures before and after the Performance counters restoration process to follow -

Before restoration - 
winmgmt /clearadap

This command clears all WMI-related values from the service's performance registry key.

After restoration -

winmgmt /resyncperf "winmgmt service pid"

(for higher versions from Windows 2000 use just:
winmgmt /resyncperf ).

This command registers the computer's performance libraries with the WMI.

 

2. To find the most current Performance counters .ini files – we do the obvious – just search all over the relevant logical drives (we exclude those whom we know for sure that doesn’t include such ini files).

For each ini file found we choose the most current one (its creation date is more current).

3. The solution is embodied in a batch file like the following

ResetPerfCounters.bat -

   1: winmgmt /clearadap



   2: expand perfc009.da_ %SystemRoot%\system32\PERFC009.DAT



   3: expand perfh009.da_ %SystemRoot%\system32\PERFH009.DAT



   4: REM Clean Registry Performance-Counter Settings (Base + Extended Performance Counters Settings) ...



   5: cscript //NoLogo //H:CScript ResetPerf.vbe        



   6: REM Finished Cleaning Registry Performance-Counter Settings.



   7: REM %SystemDrive%



   8: REM CD %SystemRoot%\system32



   9: DEL /F /Q c:\inifiles.txt



  10:  



  11: REM re-add the extensible counters from the list of services



  12: REM fetch the list of ini files of services using performance counters ...



  13: REM FINDSTR /I /M drivername= *.ini  > c:\inifiles.txt



  14:  



  15: cscript //NoLogo //H:CScript FindDriverIniFiles.vbe c:\inifiles.txt



  16: cscript //NoLogo //H:CScript DoLoadCtr.vbe c:\inifiles.txt



  17: REM Winmgmt /resyncperf



  18: cscript //Nologo //H:CScript ResyncPerf.vbe



  19: ECHO --- Done !



  20:  



  21:  



  22:  



  23:  



  24:  



  25:  




ResetPerf.vbe  - cleans all the registry entries of the performance counters



ResetPerf.vbs listed -





   1: Option Explicit



   2: On Error Resume Next



   3:  



   4: Dim WshShell



   5: Dim refRegistry



   6: Dim strValueData



   7: Dim strSKPath



   8: Dim strValueName



   9: Dim strMessage  'container for the combined message



  10: Dim strWQL  ' This string represent the WMI query.



  11: Dim strResult 



  12: Dim arrSubKeys(2)



  13: Dim strSubKey1



  14: Dim strSubKey2



  15: Dim strKeyBase



  16: Dim strKeyPath



  17:  



  18: Const REG_SZ = 1



  19: Const REG_EXPAND_SZ = 2



  20: Const REG_BINARY = 3



  21: Const REG_DWORD = 4



  22: Const REG_MULTI_SZ = 7



  23:  



  24: Const HKEY_CLASSES_ROOT = &H80000000



  25: Const HKEY_CURRENT_USER = &H80000001



  26: Const HKEY_LOCAL_MACHINE = &H80000002



  27: Const HKEY_USERS = &H80000003



  28: Const HKEY_CURRENT_CONFIG = &H80000005



  29: Const HKEY_DYN_DATA = &H80000006



  30:  



  31: Const StrHKEY_CLASSES_ROOT         = "HKEY_CLASSES_ROOT"



  32: Const StrHKEY_CURRENT_USER         = "HKEY_CURRENT_USER"



  33: Const StrHKEY_LOCAL_MACHINE     = "HKEY_LOCAL_MACHINE"



  34: Const StrHKEY_USERS             = "HKEY_USERS"



  35: Const StrHKEY_CURRENT_CONFIG     = "HKEY_CURRENT_CONFIG"



  36: Const StrHKEY_DYN_DATA             = "HKEY_DYN_DATA"



  37:  



  38: Const strBasePerfPath            = "Software\Microsoft\Windows NT\CurrentVersion\Perflib"      '"Software\Microsoft\Windows NT\CurrentVersion\Perflib"



  39: Const strExtPerfPath            = "System\CurrentControlSet\Services"                        '"System\CurrentControlSet\Services"



  40:  



  41: Function DelValue(refRegistry, KeyBase, KeyPath, strValueName)



  42:     Dim lRC 



  43:     



  44:     DelValue = True



  45:     lRC = refRegistry.DeleteValue(KeyBase, KeyPath, strValueName)



  46:  



  47:     If (lRC <> 0) Or (Err.Number <> 0) Then



  48:         DelValue = False



  49:         Exit Function



  50:     End If



  51: End Function



  52:  



  53: Function GetStringValue(refRegistry, KeyBase, KeyPath, strValueName, strValueData) 



  54:     If refRegistry.GetStringValue(KeyBase,_



  55:                                   KeyPath, _



  56:                                   strValueName, _



  57:                                   strValueData) = 0 Then    



  58:         GetStringValue = strValueData                                  



  59:     Else



  60:         GetStringValue = "GetError"



  61:     End If



  62: End Function



  63:  



  64: Function SetStringValue(refRegistry, KeyBase, KeyPath, strValueName, strValueData) 



  65:     If refRegistry.SetStringValue(KeyBase,_



  66:                                   KeyPath, _



  67:                                   strValueName, _



  68:                                   strValueData) = 0 Then    



  69:         SetStringValue = strValueData



  70:     Else



  71:         GetStringValue = "SetError"



  72:     End If



  73: End Function



  74:  



  75: Function SetDWORDValue(refRegistry, KeyBase, KeyPath, strValueName, ValueData) 



  76:     Dim lRC 



  77:     



  78:     SetDWORDValue = True



  79:     lRC = refRegistry.SetDWORDValue(KeyBase, KeyPath, strValueName, ValueData)



  80:     



  81:     If (lRC <> 0) Or (Err.Number <> 0) Then



  82:         SetDWORDValue = False



  83:         Exit Function



  84:     End If



  85: End Function



  86:  



  87: 'display output



  88: 'WshShell.Popup strIndent & KeyPath, 1, "KeyBase = " & KeyBaseStr , 0



  89:  



  90:  



  91: Function DoBasePerformanceReset(refRegistry, KeyBase, KeyPath, KeyBaseStr)



  92: On Error Resume Next



  93:  



  94:     DoBasePerformanceReset = True



  95:  



  96:     'display output



  97:     WshShell.Popup "KeyBase = " & KeyBaseStr & "KeyPath = " & KeyPath & vbCrLf & _



  98:             "change the [Last Counter] value to 1846 (decimal), and change the [Last Help] value to 1847 (decimal). ", _



  99:             2, KeyPath, 0



 100:         



 101:     If (SetDWORDValue(refRegistry, KeyBase, KeyPath, "Last Counter", 1846) = False) Then



 102:         WScript.Echo "Could not change DWORD [LastCounter] value to 1846" 



 103:         DoBasePerformanceReset = False



 104:         Exit Function



 105:     End If        



 106:     



 107:     If (SetDWORDValue(refRegistry, KeyBase, KeyPath, "Last Help", 1847) = False) Then



 108:         WScript.Echo "Could not change DWORD [LastCounter] value to 1846" 



 109:         DoBasePerformanceReset = False



 110:         Exit Function



 111:     End If        



 112: End Function



 113:  



 114:  



 115: Function DoExtPerformanceReset(refRegistry, KeyBase, KeyPath, KeyBaseStr)



 116: On Error Resume Next



 117:  



 118:     Dim lRC1



 119:     Dim lRC2



 120:  



 121:  



 122:     DoExtPerformanceReset = True



 123:     Err.Clear 



 124:     'display output



 125:     WshShell.Popup "KeyBase = " & KeyBaseStr & "KeyPath = " & KeyPath & vbCrLf & _



 126:                     "Remove the following values ([First Counter],[First Help],[Last Counter],[Last Help],[Disable Performance Counters]) " & vbCrLf & _



 127:                     "from the Performance subkey (if they exist) ", _



 128:                     2, KeyPath, 0



 129:         



 130:     'enumerate subkeys (the Services Subkeys - looking for a "Performance" subkey) ...



 131:     lRC1 = refRegistry.EnumKey(KeyBase, KeyPath, arrSubKeys(1))



 132:     If (lRC1 = 0) And (Err.Number = 0) And (Not IsNull(arrSubKeys(1))) Then



 133:         For Each strSubKey1 In arrSubKeys(1)



 134:             'recursively call ourselves



 135:             lRC2 = refRegistry.EnumKey(KeyBase, KeyPath & "\" & CStr(strSubKey1), arrSubKeys(2))



 136:             If (lRC2 = 0) And (Err.Number = 0) And (Not IsNull(arrSubKeys(2))) Then



 137:                 For Each strSubKey2 In arrSubKeys(2)



 138:                     If (StrComp(CStr(strSubKey2), "Performance", 1) = 0) Then



 139:                         If (ChangePerfValues (refRegistry, KeyBase, KeyPath & "\" & CStr(strSubKey1) & "\" & CStr(strSubKey2), KeyBaseStr) = False) Then



 140:                             WScript.Echo "Could not delete DWORD values: ([First Counter],[First Help],[Last Counter],[Last Help]) under " & _



 141:                                          KeyBaseStr & "\" & KeyPath & "\" & CStr(strSubKey1) & "\" & CStr(strSubKey2)



 142:                             DoExtPerformanceReset = False



 143:                             Exit Function



 144:                         End If



 145:                         Exit For



 146:                     End If



 147:                 Next



 148:             ElseIf Err.Number > 0 Then



 149:                 DoExtPerformanceReset = False



 150:                 WScript.Echo "EnumKey Failed on - KeyBase = " & KeyBaseStr & " KeyPath = " & KeyPath & "\" & CStr(strSubKey1) & _



 151:                     vbCrLf & Err.Description & vbCrLf



 152:                 Err.Clear 



 153:             End If



 154:         Next



 155:     ElseIf Err.Number > 0 Then



 156:         DoExtPerformanceReset = False



 157:         WScript.Echo "EnumKey Failed on - KeyBase = " & KeyBaseStr & " KeyPath = " & KeyPath & _



 158:             vbCrLf & Err.Description & vbCrLf



 159:         Err.Clear 



 160:     End If



 161: End Function



 162:  



 163:  



 164: 'Remove the following values ("First Counter","First Help","Last Counter","Last Help") from the Performance subkey (if they exist).



 165: Function ChangePerfValues(refRegistry, KeyBase, KeyPath, KeyBaseStr)



 166: On Error Resume Next



 167:  



 168:     Dim lRC



 169:     Dim sNames



 170:     Dim iTypes



 171:     Dim i



 172:     



 173:     ChangePerfValues = True



 174:     



 175:     lRC = refRegistry.EnumValues(KeyBase, KeyPath, sNames, iTypes)



 176:     If (lRC = 0) And (Err.Number = 0) And (Not IsNull(sNames)) Then



 177:         For i = LBound(sNames) To UBound(sNames)



 178:             If ((StrComp(CStr(sNames(i)), "Disable Performance Counters", 1) = 0) Or _



 179:                 (StrComp(CStr(sNames(i)), "First Counter", 1) = 0) Or _



 180:                 (StrComp(CStr(sNames(i)), "First Help", 1) = 0) Or _



 181:                 (StrComp(CStr(sNames(i)), "Last Counter", 1) = 0) Or _



 182:                 (StrComp(CStr(sNames(i)), "Last Help", 1) = 0)) Then



 183:                 lRC = refRegistry.DeleteValue(KeyBase, KeyPath, CStr(sNames(i)))



 184:                 If (Err.Number > 0) Then



 185:                     Err.Clear 



 186:                     ChangePerfValues = False



 187:                     WScript.Echo "DeleteValue Failed on - KeyBase = " & KeyBaseStr & " KeyPath = " & KeyPath & " Value = " & CStr(sNames(i)) & _



 188:                         vbCrLf & Err.Description & vbCrLf



 189:                     Exit Function



 190:                 End If



 191:             End If



 192:         Next



 193:     ElseIf Err.Number > 0 Then



 194:         ChangePerfValues = False



 195:         WScript.Echo "EnumValues Failed on - KeyBase = " & KeyBaseStr & " KeyPath = " & KeyPath & _



 196:             vbCrLf & Err.Description & vbCrLf



 197:         WScript.Echo Err.Description & vbCrLf



 198:         Err.Clear 



 199:     End If



 200: End Function



 201:  



 202:  



 203: 'Beginnning of main code ...



 204: set WshShell = WScript.CreateObject("WScript.Shell")



 205: Set refRegistry = GetObject("winmgmts:root\default:StdRegProv")



 206:  



 207: If (DoBasePerformanceReset(refRegistry, HKEY_LOCAL_MACHINE, strBasePerfPath, StrHKEY_LOCAL_MACHINE) = True) Then



 208:     If (DoExtPerformanceReset(refRegistry, HKEY_LOCAL_MACHINE, strExtPerfPath, StrHKEY_LOCAL_MACHINE) = True)  Then



 209:             Wscript.Echo Wscript.ScriptFullName  & " - Success !" & vbCrLf



 210:     Else



 211:             Wscript.Echo Wscript.ScriptFullName  & "(DoExtPerformanceReset) - Failed !" & vbCrLf



 212:     End If



 213: Else



 214:     Wscript.Echo Wscript.ScriptFullName & "(DoBasePerformanceReset) - Failed !" & vbCrLf



 215: End If



 216:  



 217: 'Clean variables ...



 218: Set refRegistry = Nothing



 219: Set WshShell = Nothing



 220:  



 221:  



 222:  



 223:  




FindDriverIniFiles.vbe – finds all the performance counters ini files and lists their full pathname into an output file.



FindDriverIniFiles.vbs listed -





   1: On Error Resume Next



   2: Const OverwriteExisting = True



   3: Const WindowsFolder       = 0



   4: Const SystemFolder       = 1



   5: Const TemporaryFolder     = 2



   6:  



   7: Dim WshShell



   8: Dim WshSysEnv



   9: Dim objWMIService 



  10: Dim colLogicalDisks 



  11: Dim colLogicalDisk 



  12: Dim DiskIndex



  13: Dim strIniListFile



  14: Dim tmpStr



  15: Dim tmpIniFile



  16: Dim ProcessIDs()



  17: Dim ProcessID



  18: Dim strProcessIDs



  19: Dim WorkDir



  20:  



  21: Err.Clear     'Clear Errors



  22: If WScript.Arguments.Count = 0 Then        



  23:     WScript.Echo "Format: " & WScript.ScriptFullName & vbTab & "<INI output listfile>" & vbCrLf



  24:      WScript.Quit 0                        



  25: Else                                    



  26:     strIniListFile = WScript.Arguments(0)    



  27: End If    



  28: 'strIniListFile = "c:\inifiles.txt"



  29:  



  30:  



  31: Set WshShell = WScript.CreateObject("WScript.Shell")



  32: dim wshFSO :    Set wshFSO = CreateObject("Scripting.FileSystemObject")



  33: WorkDir = wshFSO.GetSpecialFolder(WindowsFolder) & "\system32"  



  34: Set wshFSO = Nothing



  35:  



  36:  



  37: WScript.Echo "Starting search for Perf. Counters  ini files in (" & Now & ")" 



  38: WScript.Echo "Be patient - it may take up to 20 minutes !" 



  39:  



  40: '"%WINDIR%\System32\CScript.exe //nologo ""%1"" %*"



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



  42: Set colLogicalDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where MediaType = 12 And VolumeName <> 'Exchange'")



  43:  



  44: DiskIndex = 0



  45: For each colLogicalDisk in colLogicalDisks 



  46:     DiskIndex = DiskIndex  + 1



  47:     Redim Preserve ProcessIDs(DiskIndex-1)



  48:     



  49:     Wscript.Echo "Searching Perf Counters INI files in: " & vbTab & colLogicalDisk.Name 



  50:     



  51:     tmpIniFile = "c:\IniFiles" & DiskIndex & ".txt"     



  52:     tmpStr = "CMD /C FINDSTR /S /I /M drivername= " & colLogicalDisk.Name  & "\*.ini   > " & tmpIniFile



  53:     ProcessID = RunCommand(tmpStr)



  54:     If (ProcessID = -1 ) Then



  55:            WScript.Echo "Error Running " & tmpStr 



  56:            Set colLogicalDisks = Nothing



  57:         WScript.DisconnectObject(WshShell)



  58:         Set WshShell = Nothing



  59:            WScript.Quit 1



  60:        End If



  61:         



  62:     ProcessIDs(DiskIndex-1) = ProcessID



  63:     'WshShell.Run tmpStr, 7, true



  64: Next



  65:  



  66:     



  67: strProcessIDs = ""



  68: For each ProcessID in ProcessIDs



  69:     If strProcessIDs <> "" Then



  70:         strProcessIDs = strProcessIDs & " Or ProcessId = '" & ProcessID & "' " 



  71:     Else



  72:         strProcessIDs = strProcessIDs & "ProcessId = '" & ProcessID & "' " 



  73:     End If



  74: Next



  75:  



  76: Do Until CheckProcesses() = True



  77:     WshShell.Popup "Still searching Perf Counters INI files ..", 3," Working ...", vbInformation 



  78:     WSCript.Sleep  10000



  79: Loop



  80:     



  81: DiskIndex = 0



  82: For each colLogicalDisk in colLogicalDisks 



  83:     DiskIndex = DiskIndex  + 1



  84:     tmpIniFile = "c:\IniFiles" & DiskIndex & ".txt" 



  85:     Call CombineIniFiles(tmpIniFile, strIniListFile)    'Prefix lines with LogicalDisk name ...



  86: Next



  87:  



  88:  



  89: Set colLogicalDisks = Nothing



  90: Set objWMIService = Nothing



  91: WScript.DisconnectObject(WshShell)



  92: Set WshShell = Nothing



  93: WScript.Echo "Finished search for Perf. Counters  ini files in (" & Now & ")"



  94: WScript.Quit 0



  95:  



  96:  



  97: Function CombineIniFiles (strInFile, strOutFile)



  98:     Const ForReading = 1, ForWriting = 2, ForAppending = 8



  99:  



 100:     Dim objFSO



 101:     Dim objFile



 102:     Dim arrFileLines()



 103:     Dim arrFileLine



 104:     Dim i



 105:     



 106:     i = 0



 107:     Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



 108:     Set objFile = objFSO.OpenTextFile(strInFile, ForReading)



 109:  



 110:     Do Until objFile.AtEndOfStream



 111:         Redim Preserve arrFileLines(i)



 112:         arrFileLines(i) = objFile.ReadLine



 113:         i = i + 1



 114:     Loop



 115:     objFile.Close



 116:     



 117:     Set objFile = objFSO.OpenTextFile(strOutFile, ForAppending, True)



 118:     For Each arrFileLine in arrFileLines



 119:         objFile.WriteLine arrFileLine



 120:     Next



 121:     objFile.Close



 122:  



 123:  



 124:     WScript.DisconnectObject(objFSO)



 125:     Set objFSO = Nothing



 126: End Function



 127:  



 128:  



 129: Function RunCommand (strCmd)



 130:     Const HIDDEN_WINDOW = 12



 131:     Const Normal = 32



 132:     Const Idle = 64



 133:     Const High = 128



 134:     Const Realtime = 256



 135:     Const Above_Normal = 16384 



 136:     Const Below_Normal = 32768 



 137:     



 138:     



 139:     Dim objStartup



 140:     Dim objConfig



 141:     Dim errReturn



 142:         



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



 144:     Set objStartup = objWMIService.Get("Win32_ProcessStartup")



 145:     Set objConfig = objStartup.SpawnInstance_



 146:     objConfig.ShowWindow = HIDDEN_WINDOW



 147:     objConfig.PriorityClass = Normal



 148:     Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")



 149:     errReturn = objProcess.Create(strCmd, WorkDir, objConfig, intProcessID)



 150:     



 151:     If errReturn = 0 Then



 152:         RunCommand = intProcessID



 153:     Else



 154:         RunCommand = -1    'Error



 155:     End If



 156:  



 157: End Function



 158:  



 159:  



 160: Function CheckProcesses()



 161:     Dim colProcessList



 162:     



 163:  



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



 165:     Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where " & strProcessIDs) 



 166:     If (Not IsEmpty(colProcessList)) And (colProcessList.Count > 0) Then



 167:         CheckProcesses = False



 168:         Set colProcessList = Nothing



 169:         Exit Function



 170:     Else



 171:         CheckProcesses = True        'No "findstr" processes running anymore ...



 172:         Set colProcessList = Nothing



 173:     End If



 174: End Function




DoLoadCtr.vbe – looks in the input file and lodctr only the most current ini files listed.



DoLoadCtr.vbs listed -





   1: Option Explicit



   2: Const OverwriteExisting = True



   3: Const WindowsFolder       = 0



   4: Const SystemFolder       = 1



   5: Const TemporaryFolder     = 2



   6: Const ForReading = 1, ForWriting = 2, ForAppending = 8



   7: Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0



   8: Const dtBeginOfDate = #1/1/2601#



   9:  



  10: Dim objFileDictionary



  11: Dim objCounternameDictionary



  12: Dim objCounterFilesDictionary



  13: Dim objRootCounterFilesDictionary



  14:  



  15: Dim objFSO



  16: Dim strInputFilename



  17: Dim objTextFile



  18: Dim strShortFilename



  19: Dim index



  20: Dim strNextLine



  21: Dim objArgs



  22: Dim WshShell



  23: Dim Return



  24: Dim objItem



  25: Dim FileParts



  26: Dim dtCurrentDateTime



  27: Dim dtNewDateTime



  28: Dim strCounterName



  29: Dim WorkDir



  30:  



  31: Set objArgs = WScript.Arguments       ' Create object.



  32: If objArgs.Count = 1 Then



  33:        strInputFilename = trim(objArgs(0))



  34: Else



  35:     WScript.Echo "Format: cscript " & WScript.ScriptName & " ini-files-listfile"



  36:     Err.Clear 



  37:     WScript.Quit



  38: End If



  39:  



  40:  



  41: Set WshShell = WScript.CreateObject("WScript.Shell")



  42: Set objFileDictionary = WScript.CreateObject("Scripting.Dictionary")



  43: Set objCounternameDictionary = WScript.CreateObject("Scripting.Dictionary")



  44:  



  45: Set objFSO = CreateObject("Scripting.FileSystemObject")



  46: WorkDir = objFSO.GetSpecialFolder(WindowsFolder) & "\system32"  



  47: Set objTextFile = objFSO.OpenTextFile(strInputFilename, ForReading)



  48: index = 0



  49:  



  50:  



  51: 'Dim objDictionary



  52: 'Dim objTimeDictionary



  53: 'Dim objFileDictionary



  54:  



  55: 'CheckFileNewer(sFilename, dtCurrentDateTime, dtNewDateTime)    



  56: Do Until objTextFile.AtEndOfStream 



  57:     strNextLine = Trim(objTextFile.Readline)



  58:     FileParts = Split(strNextLine, "\", -1, 1)



  59:     strShortFilename = Trim(FileParts(UBound(FileParts)))



  60:     dtNewDateTime = GetFileDate(strNextLine)



  61:     



  62:     If Not objFileDictionary.Exists(strShortFilename) Then



  63:         Set objCounterFilesDictionary = WScript.CreateObject("Scripting.Dictionary")    'Dict for each uniq filename.



  64:  



  65:         strCounterName = GetCounterName(strNextLine)



  66:         objCounternameDictionary.Add strShortFilename, strCounterName



  67:         objCounterFilesDictionary.Add dtNewDateTime, """" & strNextLine & """"



  68:         objFileDictionary.Add strShortFilename, objCounterFilesDictionary



  69:     Else



  70:         if Not(objFileDictionary(strShortFilename).Exists(dtNewDateTime)) Then



  71:             objFileDictionary(strShortFilename).Add dtNewDateTime, """" & strNextLine & """"        'insert at the end of dictionary



  72:         End If



  73:     End If



  74:      



  75:     index = index + 1



  76: Loop



  77:     



  78: WScript.Echo "Found [" & index & "] performance-counters ini files ..." & vbCrLf



  79: For Each objItem in objFileDictionary



  80:     DoRunLodctr(objFileDictionary(objItem))



  81: Next



  82:  



  83:  



  84:  



  85:  



  86: Function GetOldestFileDate(FileDict, dtNewestDate)



  87:     Dim dtOldestDate



  88:     Dim FileElemDate



  89:     



  90:     dtOldestDate = dtNewestDate



  91:     For Each FileElemDate In FileDict



  92:         If (DateDiff("n", dtOldestDate, CDate(FileElemDate)) < 0) Then 



  93:             dtOldestDate = CDate(FileElemDate)



  94:         End If



  95:     Next



  96:  



  97:     GetOldestFileDate = dtOldestDate



  98: End Function



  99:  



 100:  



 101: Sub DoRunLodctr(FileDict)



 102:     Dim i, count



 103:     Dim FileElem



 104:     Dim OldestDate



 105:     



 106:     count = FileDict.Count 



 107:     OldestDate = dtBeginOfDate



 108:     Do



 109:         count = count - 1



 110:            OldestDate = GetOldestFileDate(FileDict, OldestDate)



 111:         WScript.Echo "lodctr.exe " & FileDict(OldestDate) 



 112:         Return = WshShell.Run("%windir%\system32\" & "lodctr.exe " & FileDict(OldestDate), 0, TRUE)



 113:     Loop While (Count > 0)



 114: End Sub



 115:  



 116: WScript.DisconnectObject(WshShell) 



 117: Set WshShell = Nothing



 118: WScript.DisconnectObject(objFileDictionary) 



 119: Set objFileDictionary = Nothing



 120: WScript.DisconnectObject(objCounternameDictionary) 



 121: Set objCounternameDictionary = Nothing



 122: WScript.DisconnectObject(objFSO) 



 123: Set objFSO = Nothing



 124: WScript.Quit 



 125:  



 126:  



 127:  



 128: Function CheckFileNewer(sFilename, sDate, sNewDate)    'return True if newer ; False if not.



 129:        Dim fso, f



 130:  



 131:        Set fso = CreateObject("Scripting.FileSystemObject")



 132:        Set f = fso.GetFile(sFilename)



 133:        If (DateDiff("n", sDate, f.DateLastModified) > 0) Then 



 134:            CheckFileNewer = True



 135:         sNewDate = CDate(f.DateLastModified)



 136:        Else



 137:            CheckFileNewer = False



 138:        End If



 139:     



 140:     set f = Nothing : set fso = Nothing



 141: End Function



 142:  



 143:  



 144: Function GetFileDate(sFilename)



 145:        Dim fso, f



 146:  



 147:        Set fso = CreateObject("Scripting.FileSystemObject")



 148:        Set f = fso.GetFile(sFilename)



 149:        GetFileDate = CDate(f.DateLastModified)



 150:     



 151:     set f = Nothing : set fso = Nothing



 152: End Function



 153:  



 154:  



 155: Function GetCounterName(sFilename)



 156:        Dim fso, f, ts



 157:        Dim MyArray



 158:        Dim str



 159:        Dim RegResult



 160:  



 161:      Set fso = CreateObject("Scripting.FileSystemObject")



 162:      Set f = fso.GetFile(sFilename)



 163:        Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)



 164:        



 165:        If ts.AtEndOfStream Then



 166:         GetCounterName = "Error"



 167:         set ts = Nothing : set f = Nothing : set fso = Nothing       



 168:         Exit Function



 169:        End If



 170:        



 171:        str = ts.ReadAll



 172:      ts.Close



 173:     set ts = Nothing : set f = Nothing : set fso = Nothing       



 174:  



 175:     RegResult = RegExpFunction("drivername=[a-zA-Z0-9_.]+\b", str)



 176:     If (RegResult = "Error") Then



 177:         GetCounterName = "Error"



 178:         Exit Function



 179:     End If



 180:     



 181:     MyArray = Split(RegResult, "=", -1, vbTextCompare)



 182:     GetCounterName = Trim(MyArray(1))



 183: End Function



 184:  



 185:  



 186: '*******************************************************



 187: ' Finding a pattern in a string using the RegExp object



 188: '*******************************************************



 189: Function RegExpFunction(patrn, strng)



 190: On Error Resume Next



 191:     Dim regEx, IDs



 192:  



 193:   



 194:     Err.Clear



 195:     Set regEx = CreateObject("VBScript.RegExp")    ' Create a regular expression.



 196:     regEx.Pattern = patrn            ' Set pattern.



 197:     regEx.IgnoreCase = True          ' Set case insensitivity.



 198:     regEx.Global = True              ' Set global applicability.



 199:     Set IDs = regEx.Execute(strng)    ' Execute search.



 200:     



 201:     If IDs.Count = 0 Then    'No matches found



 202:         RegExpFunction = "Error"



 203:     Else



 204:         RegExpFunction = CStr(IDs(0).Value)



 205:     End If



 206:     Set regEx = Nothing



 207: End Function



 208:  



 209:  




 



Enjoy ..



2 comments:

Unknown said...

We are provide online solution of your problem if any type of problem related of windows 7 then please check this site and fix your problem.
Fix Windows 7 Error 1068
Thank you
Aalia lyon

naftaly shprai said...

I don't see any relevant solution to my detailed one.

Please comment on my solution.
Did you try it?

Do you have any alternative?

Naftaly Shprai