http://dieseyer.de • all rights reserved • © 2011 v11.4
'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
http://dieseyer.de • all rights reserved • © 2011 v11.4