[turbolover]

Поиск и удаления ключей и веток реестра с помощю, (.vbs) скрипта.

Код:

Option Explicit
Dim sSearchFor, st, st0, sRegTmp, sOutTmp, eRegLine, iCnt, sRegKey, aRegFileLines, stroca, isDel, delLine, delLines, resbox
Dim wssh : Set wssh = CreateObject("WScript.Shell")
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")

sSearchFor = InputBox("Enter a search word." &vbcrlf&vbcrlf& "Below Enter the Registry Key or Hive Name, it you want Find and Deleted", "Registry Finder")
If sSearchFor = "" Then Cleanup()
 
Dim StartTime : StartTime = Timer
 
sRegTmp = wssh.Environment("Process")("Temp") & "\RegTmp.tmp "
sOutTmp="ScanReport  "&sSearchFor&".txt"

wssh.Run "regedit /e /a " & sRegTmp, , True 
aRegFileLines = Split(FSO.GetFile(sRegTmp).OpenAsTextStream(1, 0).Read(FSO.GetFile(sRegTmp).Size), vbcrlf)
FSO.DeleteFile(sRegTmp)

Dim txt : Set txt = fso.OpenTextFile(sOutTmp,2,True)

txt.WriteLine "Result of found Registry Hives"&vbcrlf&"Below we are able to delete records that we want to leave alive"&vbcrlf&"==============================================================="&vbcrlf&""

For Each eRegLine in aRegFileLines
On Error Resume Next
  If InStr(1, eRegLine, "[", 1) > 0 Then
    sRegKey = eRegLine
  end if
  If InStr(1, eRegLine, sSearchFor, 1) >  0 Then
    If sRegKey <> eRegLine Then
      st0=Split(eRegLine,"=")           
      st=Replace(st0(0),"""","")        
      stroca=Mid(sRegKey,2)
      stroca=Replace (stroca,"]","",1)  
      txt.WriteLine stroca &"\"& st     
    else
      stroca=Mid(sRegKey,2) 
      stroca=Replace (stroca,"]"," ",1)
      stroca =Trim(stroca)
      txt.WriteLine stroca & "\"        
    End If                             
    iCnt = iCnt + 1
  End If
Next

txt.Close
Erase aRegFileLines
 
If iCnt < 1 Then
  wssh.Popup "Search lasted  " & FormatNumber(Timer - StartTime, 0) & " sec. " & _
             "On request " & chr(34) & sSearchFor & chr(34) & _
             " nothing found.",, "Registry Finder", 4096
  FSO.DeleteFile(sOutTmp)
  Cleanup()
End If
 
wssh.Popup "Search lasted " & FormatNumber(Timer - StartTime, 0) & " sec. " & _
          iCnt & " matches on request " & chr(34) & sSearchFor & chr(34),, _
          "Registry Finder", 4096
 
wssh.Run "NotePad " & sOutTmp, 3, True 'Open with Notepad with a report to removal

delLines = Split(FSO.OpenTextFile(sOutTmp,1).ReadAll, vbcrlf)
For Each delLine in delLines
  if Left(delLine,1)<>"<" then
   Err.Clear
   wssh.RegDelete delLine
   If Err.Number<>0 then
      Err.Clear : wssh.RegRead delLine
      if Err.Number=0 then
        resbox=resbox&delLine&vbCrLf&vbCrLf
      end if
   End if
  end if
Next
if resbox<>"" then resbox="The following lines failed to remove:"&vbCrLf&resbox

isDel=wssh.Popup(resbox&"Save Report",, _
                 "Report", 36)
if isDel=7 then FSO.DeleteFile(sOutTmp)
Cleanup()
 
Sub Cleanup()
  Set wssh = Nothing
  Set FSO = Nothing
  WScript.Quit
End Sub