'v5.5*********************************************************** 

' File:   autostart-run2.vbs 

' Autor:  "LICHTER" 

'         dieseyer.de 

' 

'Das folgende Programm soll 

'Einträge im AutoStartVerzeichnis anzeigen 

'kritische Reg-Schlüssel  

'	auslesen,  

'	speichern und  

'	beim nächsten Programmaufruf vergleichen und  

'		hinzugekommene Einträge melden. 

' 

' http://source-center.de/forum/showthread.php?t=9502 

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

 

' Reg-Schlüssel löschen 

Dim Arr(20) 

DIM sch(40) 

tit = "Mörfi's Reg_Viewer 0.1 für WIN2000 und höher (05/2005 BA Pankow)"     

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

ordner = WshShell.SpecialFolders("AllUsersStartup") 

Set fso = CreateObject("Scripting.FileSystemObject") 

on error resume next 

Set f = fso.GetFolder(ordner) 

set fc = f.Files 

x ="Über den Autostartordner werden gestartet:" & vbcrlf & vbcrlf  

for each item in fc   

x = x & item.name & " -> " & " erstellt am: "& item.DateCreated & vbCrlf 

next   

ordner = WshShell.SpecialFolders("Startup") 

Set f = fso.GetFolder(ordner) 

set fc = f.Files 

for each item in fc   

x = x & item.name & " -> " & " erstellt am: "& item.DateCreated & vbCrlf 

next  

WshShell.PopUp x & vbcrlf & vbcrlf & "REG-Schlüssel wird gelesen. Moment bitte ....",3, tit, vbExclamation  

xx = 0                 

Arr(1) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" 

Arr(2) = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" 

Arr(3) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnceEx\" 

Arr(4) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\" 

Arr(5) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce\" 

Arr(6) = "HKEY_USERS\S-1-5-18\Software\Microsoft\Windows\CurrentVersion\Run\" 

Arr(7) = "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\" 

Arr(8) = "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\RunOnce\" 

Arr(9) = "HKEY_USERS\Software\Microsoft\Windows\CurrentVersion\Run\" 

Arr(10) = "HKEY_USERS\Software\Microsoft\Windows\CurrentVersion\RunOnce\" 

Arr(11) = "HKEY_USERS\Software\Microsoft\Windows\CurrentVersion\RunServices\" 

Arr(12) = "HKEY_USERS\Software\Microsoft\Windows\CurrentVersion\RunOnceEx\" 

Arr(13) = "HKEY_USERS\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce\" 

Arr(14) = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\RunOnce\" 

Arr(15) = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\RunOnceEx\" 

dat1 = "c:\datx1.tmp " 

dat = "c:\da.tmp " 

dat2 = "c:\datref.tmp" 

datref = "" 

if fso.fileexists(dat2) then 

set a = fso.opentextfile(dat2) 

while not a.atendofStream  

datref = datref & a.Readline 

wend 

a.close 

end if 

iText = "Über die Registry werden mindestens gestartet:" & " (15 Schlüssel wurden ausgewertet)" & vbcrlf & "***** NAME und Pfad ******" & vbcr 

TextX = "" 

daten1="" 

z2 = 0 

for g = 1 to 15  

schluss = arr(g) 

WshShell.Run "regedit /E " & dat1 & schluss,0,true    

rs =   " type " & dat1 & " > c:\da.tmp"        

yyy = WshShell.Run ("cmd /C " & rs,0,true)    

if not fso.FileExists(Dat) then                

msgbox "Schlüssel : " & schluss & " nicht gefunden. Programm wird abgebrochen", vbExclamation, tit 

wscript.quit  

end if 

Set FinList = FSO.OpenTextFile( trim(Dat), 1 )   

TextX = FinList.Readline  

extX = FinList.Readline    

TextX = FinList.Readline  

if textx = "["& schluss &"]" then	 

Do While Not (FinList.atEndOfStream)  

TextX = FinList.Readline   

If not Left ( TextX, 1 ) = "[" then      

TextX = Replace(TextX, chr(34), "")  

TextX = Replace(TextX, "\\", "\") 

i1 = Instr(1, TextX,"=", 1)  

if i1 > 0 then  

wert = Left(TextX, i1 - 1) 

daten = right(TextX, len(TextX)-i1) 

else 

exit do 

end if 

xx = xx +1 

sch(xx) = schluss & wert   ' für spätere Löschung 

itext = itext & xx & ". ("&g&")"&vbtab & Ucase(wert) & "  -->     " & Lcase(daten) & vbcrlf 

if fso.fileexists(dat2) then 

z1 = instr(datref,daten) 

if z1 = 0 then  

msgbox "Achtung neuer Registry-Eintrag: " & vbcrlf & Ucase(wert) & "  -->     " & daten,16,tit 

z2 = z2 +1 

end if 

end if 

daten1 = daten1 & daten & vbcrlf 

end if 

Loop  

end if 

Set FinList = nothing  

next 

fso.DeleteFile(dat) 

fso.DeleteFile(dat1) 

if not fso.fileexists(dat2) then 

WshShell.PopUp "Referenz-Datei " & vbcrlf & vbcrlf & Ucase(dat2) & vbcrlf & vbcrlf &"wird angelegt." & "Sollen  neue Registry-Einträge legitimiert werden, dann die Referenz-Datei löschen.", 15, tit, vbExclamation   

set a = fso.createtextfile(Ucase(dat2),true)  

set a = fso.opentextfile(dat2,8,true) 

a.write daten1 

a.close 

end if 

itext2 ="" 

if z2 <> 0 then itext2 = "Alle neuen Einträge legitimieren? Wenn ja, dann Datei " & Ucase(dat2) & " löschen." & vbcrlf  

itext = itext & vbcrlf & vbcrlf & itext2 & "Ein Programm davon löschen? Vorsicht geboten! Ggf. läßt sich WINDOWS nicht mehr starten" 

ant = wshshell.PopUp (itext  , , tit,260) ', vbExclamation 

if ant = 6 then 

antx = 100 

do while antx > xx 

antx = 100 

antx  = EingabeZahl("Daten-Werte-Paar löschen" & vbcrlf & "Nr. des Datensatzes eingeben:" & vbcrlf & "(0 = Abbruch)" & vbcrlf & "")*1 

if antx = 0 then wscript.quit 

loop 

msgbox sch(antx) 

antxx = sch(antx) 

wshShell.RegDelete antxx 

end if 

Private Function EingabeZahl(Text1) 

Dim ix 

ix = "Zahl eingeben" 

do until  isnumeric(ix) 

ix = Inputbox(Text1, tit ,"Zahl eingeben") 

if not isnumeric(ix) then ix = "Bitte gültige Zahl eingeben"  

loop 

EingabeZahl = ix 

End Function