'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