' ----------------------------------------------------------
' Script d'accès direct via REGEDIT à une clef importante
' de la Base de registres
'
' JC BELLAMY © 2003
' ----------------------------------------------------------
Dim shell,fso
Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set shell = WScript.CreateObject("WScript.Shell")
FicHTML=GetPath() & "setregedit.html" 
CreateHTML
' Ouverture d'Internet Explorer
Set oIE = WScript.CreateObject("InternetExplorer.Application", "IE_")
oIE.Left = 50        
oIE.Top = 100 
oIE.Height = 350
oIE.Width = 600
oIE.MenuBar = 0         
oIE.ToolBar = 0
oIE.StatusBar = 0
oIE.navigate FicHTML 
oIE.Visible = 2      
Do While (oIE.Busy)    
	WScript.Sleep 200  
	Loop

Do While true
	oIE.Visible = 2   
	shell.AppActivate "Accès direct BDR"
	' Attente d'action sur le bouton ou fermeture de la fenêtre
	On Error Resume Next 
	Do                   
		WScript.Sleep 100
		Loop While (oIE.Document.Script.CheckVal() = 0)
' Si on ferme directement IE sans passer par un bouton, 
' cela provoque une erreur qui est détectée et alors
' on quitte le script
	If Err <> 0 Then Wscript.quit
	test=oIE.Document.Script.CheckVal()
	If test=-1 Then 
		CloseIE
		Wscript.quit
		end if
	oIE.Document.Script.Window_OnLoad()
	SelectedKey=""
' Lancement de REGEDIT avec la clef choisie
	If test=1 Then
		SelectedKey=oIE.Document.RegEditForm.key.value
	Else
		FirstKey=oIE.Document.RegEditForm.extent.value
		If left(FirstKey,1)<>"." Then FirstKey="." & FirstKey
		typeKey=shell.RegRead("HKEY_CLASSES_ROOT\" & FirstKey & "\")
		If Err <>0 Then
			msgbox "Extension " & FirstKey & " absente de la BDR",vbCritical,"Accès direct BDR"
		else
			SelectedKey="HKEY_CLASSES_ROOT\" & TypeKey & "\shell\open\command" 
			End If		
		End If
	If SelectedKey<>"" Then
		KeyName="HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"
		shell.RegWrite keyName, SelectedKey 
		oIE.Visible = 0 
		shell.Run "REGEDIT",1,true
		End If
	loop
'--------------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
End Function
'--------------------------------------------------------------------
' Fermeture d'Internet Explorer
Sub CloseIE
oIE.Quit        
Set oIE = Nothing
End Sub
'--------------------------------------------------------------------
Sub CreateHTML
Dim tabkey,tablib
tabkey=array( _
"HKEY_CLASSES_ROOT\http\shell\open\command", _
"HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\DefaultIcon", _
"HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon", _
"HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\DefaultIcon", _
"HKEY_CURRENT_USER\Control Panel\Keyboard", _
"HKEY_CURRENT_USER\Control Panel\Desktop", _
"HKEY_CURRENT_USER\Control Panel\International", _
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", _
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", _
"HKEY_CURRENT_USER\Software\Policies\Microsoft\Internet Explorer\Control Panel", _
"HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main", _
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run", _
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{44BBA840-CC51-11CF-AAFA-00AA00B6015C}", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{44BBA842-CC51-11CF-AAFA-00AA00B6015B}", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{89820200-ECBD-11cf-8B85-00AA005B4383}", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{4f645220-306d-11d2-995d-00c04f98bbc9}", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{5945c046-1e7d-11d1-bc44-00c04fd912be}", _ 
"HKEY_LOCAL_MACHINE\Network\Logon", _
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\policies\Ratings", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", _
"HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Session Manager", _
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup", _
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Browser\Parameters", _
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\VxD\VNETSUP\Ndi\Params\MaintainServerList", _
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services", _
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices", _
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\hivelist")

tablib=array( _
"(HKCR) Navigateur par défaut", _
"(HKCR) Icône poste de travail", _
"(HKCR) Icône corbeille", _
"(HKCR) Icône voisinage réseau", _
"(HKCU) Configuration clavier", _
"(HKCU) Configuration bureau", _
"(HKCU) Configuration international", _
"(HKCU) Dossiers système", _
"(HKLM) Dossiers système", _
"(HKCU) Page d'accueil IE", _
"(HKCU) Paramètres principaux IE", _
"(HKCU) Applis lancées au démarrage", _
"(HKLM) Applis lancées au démarrage", _
"(HKLM) Installation de Outlook Express", _
"(HKLM) Installation de NetMeeting", _
"(HKLM) Installation de Internet Explorer", _
"(HKLM) Installation de VBScript", _
"(HKLM) Installation de Messenger", _
"(HKLM) Authentification par serveur de domaine (Win9x)", _
"(HKLM) Contrôle d'accès IE", _
"(HKLM) Chemins principaux", _
"(HKLM) Winlogon (NT)", _
"(HKLM) Session Manager (NT)", _
"(HKLM) Désinstallation d'applis", _
"(HKLM) Installation de Windows", _
"(HKLM) Master browser (NT)", _
"(HKLM) Master browser (Win9x)", _
"(HKLM) Services (NT)", _
"(HKLM) Services (Win9x)", _
"(HKLM) Nom des ruches (NT)")

Dim ts
Set ts = fso.CreateTextFile(fichtml, True)
ts.writeline "<html>"
ts.writeline "<head>"
ts.writeline "<title>Accès direct BDR</title>"
ts.writeline "<STYLE TYPE=""text/css"">"
ts.writeline "	body {"
ts.writeline "	font-family: Verdana;"
ts.writeline "	font-size: 10 pt }"
ts.writeline "	h1, h2, h3, h4, h5, h6 { font-family: Verdana }"
ts.writeline "</STYLE>"
ts.writeline "</head>"
ts.writeline "<body bgcolor=""#FFFFD2"" scroll=""no"">"
ts.writeline "<script language=""VBScript"">" 
ts.writeline "<!--"
ts.writeline "Dim ready "
' Action sur les boutons
ts.writeline "Sub B0_OnClick"
ts.writeline "ready=-1" 
ts.writeline "End Sub"
ts.writeline "Sub B1_OnClick"
ts.writeline "ready=1" 
ts.writeline "End Sub"
ts.writeline "Sub B2_OnClick"
ts.writeline "ready=2" 
ts.writeline "End Sub"
' Initialisation
ts.writeline "Sub Window_OnLoad()"
ts.writeline "ready=0" 
ts.writeline "End Sub"
' Fonction utilisable de l'extérieur pour tester l'envoi
ts.writeline "Public Function CheckVal()"
ts.writeline "CheckVal=ready"
ts.writeline "End function"
ts.writeline "'-->"
ts.writeline "</script>"
ts.writeline "<form name=""RegeditForm"">"
ts.writeline "<h3><center>Ouverture directe de REGEDIT</center></h3><hr>"
ts.writeline "Clefs usuelles : <br>"
ts.writeline "<font size=""-2"">"
ts.writeline "<b>HKCR</b> = HKEY_CLASSES_ROOT<br>"
ts.writeline "<b>HKCU</b> = HKEY_CURRENT_USER<br>"
ts.writeline "<b>HKLM</b> = HKEY_LOCAL_MACHINE<br>"
ts.writeline "</font>"
ts.writeline "<select size=""1"" name=""key"">"

For i = lbound(tabkey) To ubound(tabkey)
	ts.writeline "<option value=""" & tabkey(i) & """>" & tablib(i) & "</option>"
	Next

ts.writeline "</select>"
ts.writeline "<input type=""button"" value=""Ouvrir REGEDIT"" name=""B1"">"
ts.writeline "<hr>"
ts.writeline "Recherche de <b>""HKCR\...\shell\command\open""</b> <br>"
ts.writeline "à partir de l'extension d'un type de fichier<br>"
ts.writeline "Extension : <input type=""text"" size=""5"" name=""extent"">"
ts.writeline "<input type=""button"" value=""Ouvrir REGEDIT"" name=""B2""><hr>"
ts.writeline "<center>"
ts.writeline "<input type=""button"" value=""Quitter"" name=""B0"">"
ts.writeline "</center>"
ts.writeline "</form>"
ts.writeline "<font size=""-2"">JCB © 2003</font>"
ts.writeline "</body>"
ts.writeline "</html>"
ts.close
End Sub
'--------------------------------------------------------------------