удаление разделов реестра по маске (?)
Добрый час ! подсобите... нужно удалить кучу вот таких подобных разделов: все они начинаются одинаково ы digest , числа разные.
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\RefHive\Microsoft\Windows\CurrentVersion\Internet Settings\Digest\Hosts\digest01EB0000n10004:digest01EB0000n10004]
Код:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegDelete("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\RefHive\Microsoft\Windows\CurrentVersion\Internet Settings\Digest\Hosts\digest*")
в общем вопрос сводится как сделать выборку с условием. |
Код:
Dim objReg, strKeyPath, arrSubKeys, intResult, strTemp, strLog
Const HKLM = &H80000002
strLog = "RegClearing_Result.log"
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\RefHive\Microsoft\Windows\CurrentVersion\Internet Settings\Digest\Hosts"
On Error Resume Next
objReg.EnumKey HKLM, strKeyPath, arrSubKeys
If Err.Number = 0 Then
If IsArray(arrSubKeys) Then
For i = 0 To UBound(arrSubKeys)
If InStrRev(arrSubKeys(i), "digest", -1, vbTextCompare) > 0 Then
intResult = objReg.DeleteKey(HKLM, strKeyPath & "\" & arrSubKeys(i))
If Err.Number = 0 Then
If intResult = 0 Then
strTemp = strTemp & arrSubKeys(i) & " -> удалён" & vbNewLine
Else
strTemp = strTemp & arrSubKeys(i) & " -> ошибка удаления с кодом " & intResult & vbNewLine
End If
Else
strTemp = strTemp & arrSubKeys(i) & " -> ошибка " & Err.Number & vbNewLine
Err.Clear
End If
End If
Next
If Len(strTemp) > 0 Then
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
Set objFile = objFS.OpenTextFile(strLog, 2, True)
objFile.Write strTemp
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
WScript.Echo "Готово."
Else
WScript.Echo "Подключи с именами, соответствующими указанному условию, не обнаружены."
End If
Else
WScript.Echo "Подключи не обнаружены."
End If
Else
WScript.Echo "Ошибка " & Err.Number & vbNewLine & Err.Description
Err.Clear
End If
Set objReg = Nothing
WScript.Quit 0
|
Основательно. я думал уложиться в 5-10 строчек :). Спасибо, ДмитрийВ
|
Ошибка CScript: Ошибка при выполнении сервера сценариев Windows. (Параметр задан
неверно. )
|
1. Приведите полный текст сообщения об ошибке.
2. Если запускаемая Вами версия сценария отличается от приведённого примера, то выложите код Вашей версии.
3. Приведите полностью консольную команду, с помощью которой пытаетесь запустить сценарий.
|
1. это полный текст.
2. копировал вставил без изменений. два раза перепробовал
3. cscript //nologo scriptname.vbs
|
foxbat, пока не удаётся воспроизвести Вашу ситуацию.
1. Какая версия ОС используется?
2. Работает ли сценарий, если его запускать из GUI?
Если не работает, то каков будет результат работы сценария:
Код:
On Error Resume Next
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
If Err.Number = 0 Then
WScript.Echo "Подключение к провайдеру выполнено."
Else
WScript.Echo "Ошибка " & Err.Number & vbNewLine & Err.Description
Err.Clear
End If
WScript.Quit 0
|
Дмитрий, скрипт работает. я сохранил его в один файл, а запускал другой - пустой. Вот только результат прогона "Подключи не обнаружены."
|
Можно предположить, что указанный в сценарии путь для поиска отличается от реального.
Попробуйте выполнить (в консольном режиме) приведённый ниже сценарий и проанализируйте результат его выполнения.
Код:
Dim objReg, strKeyPath, arrSubKeys, strTemp, arrTemp, blnContinue
Dim objFS, objFile, strLog
Const HKLM = &H80000002
On Error Resume Next
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
If Err.Number = 0 Then
strLog = "RegPath_Parse.log"
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
Set objFile = objFS.CreateTextFile(strLog, True)
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\RefHive\Microsoft\Windows\CurrentVersion\Internet Settings\Digest\Hosts"
arrTemp = Split(strKeyPath, "\")
For i = 0 To UBound(arrTemp)
strTemp = strTemp & arrTemp(i)
arrSubKeys = Array()
objReg.EnumKey HKLM, strTemp, arrSubKeys
If Err.Number = 0 Then
If UBound(arrSubKeys) >= 0 Then
WScript.Echo strTemp & " -> кол-во подключей = " & UBound(arrSubKeys) + 1
objFile.WriteLine strTemp & " -> кол-во подключей = " & UBound(arrSubKeys) + 1
If i < UBound(arrTemp) Then
blnContinue = False
For j = 0 To UBound(arrSubKeys)
If StrComp(arrSubKeys(j), arrTemp(i + 1), vbTextCompare) = 0 Then
blnContinue = True
Exit For
End If
Next
strTemp = strTemp & "\"
If Not blnContinue Then
WScript.Echo strTemp & arrTemp(i + 1) & " -> подключ осутствует, продолжение просмотра невозможно"
objFile.WriteLine strTemp & arrTemp(i + 1) & " -> подключ осутствует, продолжение просмотра невозможно"
Exit For
End If
Else
For j = 0 To UBound(arrSubKeys)
WScript.Echo arrSubKeys(j)
objFile.WriteLine arrSubKeys(j)
Next
End If
Else
WScript.Echo strTemp & " -> подключи не обнаружены"
objFile.WriteLine strTemp & " -> подключи не обнаружены"
Exit For
End If
Else
WScript.Echo strTemp & " -> ошибка чтения списка подключей"
objFile.WriteLine strTemp & " -> ошибка чтения списка подключей"
Err.Clear
Exit For
End If
Next
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
Else
WScript.Echo "Ошибка " & Err.Number & vbNewLine & Err.Description
Err.Clear
End If
Set objReg = Nothing
WScript.Quit 0
|
вот последняя строка лога:
Код:
SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\RefHive\Microsoft\Windows\CurrentVersion\Internet Settings\Digest -> кол-во подключей = 1
хотя их там десятки тысяч. если надо могу скрин дать
по предыдущим разделам считает всё верно. |
Цитата:
Цитата foxbat
... их там десятки тысяч... »
|
Возможно, именно такое большое количество подключей и является причиной неверной работы сценариев.
Попробуйте для пути
"HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\RefHive\Microsoft\Windows\CurrentVersion\Internet Settings\Digest"
выполнить запрос reg query, перенаправив его вывод в файл, а затем оцените достоверность выполнения запроса. |
Время: 18:33.
© OSzone.net 2001-
