' ----------------------------------------------------------
' Script affichant la liste des extensions de fichiers
' supportant la recherche "plaintext" (Windows XP seulement)
'
' Permet ensuite d'ajouter de nouvelles extensions
'
' JC BELLAMY © 2002
' ----------------------------------------------------------
Dim shell, fso, args
Const SW_HIDE=0
Const SW_SHOWNORMAL=1 
Const HKEY_CLASSES_ROOT  = &H80000000 
Const HKEY_CURRENT_USER  = &H80000001 
Const HKEY_LOCAL_MACHINE = &H80000002 
Const HKEY_USERS         = &H80000003 
Quote = chr(34)

Prompt="Liste des extensions à ajouter dans la recherche," & VBCRLF _
& "   - séparées par les caractères :" & VBCRLF _
& "       virgule, point-virgule ou slash, " & VBCRLF _
& "   - avec ou sans le point initial" & VBCRLF _
& "   NB : les caractères génériques * et ? sont interdits" & VBCRLF & VBCRLF _
& "   Exemple : .c/.cpp/java/pas;.php "

Set shell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set args  = Wscript.Arguments
nbargs=args.count
defmoteur="cscript"
If nbargs=0 Then
	Interactif=true
	silence=false
	oldlist=true
Else
	Interactif=false
	If testarg("?") or testarg("h") Then
		msg="Extensions de fichiers supportant la recherche ""plaintext""" & VBCRLF
		msg=msg & "(Windows XP seulement) - JCB © 2002" & VBCRLF
		msg=msg & "-----------------------------------" & VBCRLF
		msg=msg & "Syntaxe : " & VBCRLF & VBCRLF 
		msg=msg & "1) mode interactif :" & VBCRLF 
		msg=msg & "   plaintext" & VBCRLF & VBCRLF
		msg=msg & "2) mode ligne de commandes :" & VBCRLF
		msg=msg & "   plaintext  [-c] [-w] [-s] [-a] [-e:<liste>]" & VBCRLF
		msg=msg & "   plaintext  [/c] [/w] [/s] [/a] [/e:<liste>]" & VBCRLF & VBCRLF
		msg=msg & "   options :" & VBCRLF
		msg=msg & "   c : exécution avec CScript (option par défaut)" & VBCRLF 
		msg=msg & "   w : exécution avec WScript" & VBCRLF 
		msg=msg & "   NB: w et c sont exclusives" & VBCRLF 
		msg=msg & "   s : fonctionnement ""silencieux"" (absence de messages)" & VBCRLF
		msg=msg & "   a : affiche la liste des extensions actuellement traitées" & VBCRLF
		msg=msg & "   e : nouvelles extensions à traiter" & VBCRLF
		msg=msg & "   <liste> : " & prompt & VBCRLF
		wscript.echo msg
		wscript.quit
	Else
		If testarg("w") Then defmoteur="wscript"
		If testarg("c") Then defmoteur="cscript"
		silence=testarg("s")
		oldlist=testarg("a")
		newlist=testarg("e:")
		If newlist Then
			Liste=getarg("e:")
			End If
		End If
	End If

' Test du moteur utilisé
Call TestHost

KeyVer="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"
OKscript=false
on error resume next
PN=shell.RegRead(keyver)
if err.number=0 then
	If PN="Microsoft Windows XP" Then OKscript=true
	End If
on error goto 0
If not OKscript Then
	msg="Ce script ne fonctionne que sous Windows XP !"
	If PN="Microsoft Windows 2000" Then 
		msg=msg & VBCRLF & "(Il n'y a pas de restrictions de recherche sous Windows 2000)"
		end if
	If not silence Then wscript.echo msg
	wscript.quit
	End If

IDref="{5e941d80-bf96-11cd-b579-08002b30bfeb}"

Dim sKeys,sKeysEdit(), objRegistry
Set objRegistry = GetObject("winmgmts:root\default:StdRegProv")
lRC = objRegistry.EnumKey(HKEY_CLASSES_ROOT, "", sKeys)
msg="Liste des extensions supportant la recherche ""plaintext"" sous Windows XP" & VBCRLF
msg=msg & "JCB © 2002"  & VBCRLF
msg=msg & "----------"  & VBCRLF
nkeys=0
If (lRC = 0) And (Err.Number = 0) Then
	For i= LBound(sKeys) To UBound(sKeys)
		curkey=sKeys(i)
		If left(curkey,1)="." Then
			Key="HKEY_CLASSES_ROOT\" & curkey & "\PersistentHandler\"	
			on error resume next
			ID=shell.RegRead(key)
			if err.number =0 then
				If ID=IDref Then
					nkeys=nkeys+1
					redim preserve skeysedit(nkeys+1)
					skeysedit(nkeys)=curkey
					msg=msg & VBCRLF & curkey
					End If
				End if
			on error goto 0
			End If
		Next
	msg=msg & VBCRLF & nkeys & " extensions" 
	If not silence and oldlist Then wscript.echo msg
Else
	If not silence Then wscript.echo "Erreur Winmgmts"
	wscript.quit
	End If

If interactif Then 
	Liste=InputBox(prompt,"Recherche Plaintext Windows XP")
else
	If not newlist Then wscript.quit
	end if
Liste=replace(Liste," ","")
Liste=replace(Liste,",",";")
Liste=replace(Liste,"/",";")
If InStr(liste,"*")>0 or InStr(liste,"?")>0 Then
	If not silence Then wscript.echo "Les caractères génériques sont interdits!"
	wscript.quit
	End If

If len(liste)>0 Then
	Dim newext
	newext=split(liste,";")
	n=ubound(newext)-lbound(newext)+1
	neff=0
	msg= "Demande d'ajout de " & n & " nouvelle(s) extension(s)" & VBCRLF
	For i = lbound(newext) To ubound(newext)
		curkey=newext(i)
		If len(curkey)=0 Then Exit for
		If left(curkey,1)<>"." Then curkey="." & curkey
		Modif=true
		For j  = 1 To nkeys
			If curkey=skeysedit(j) Then
				msg=msg & curkey & " déjà activée avec le composant filtre ""plaintext""!" & VBCRLF
				Modif=false
				exit for
				end if
			next
		If Modif Then
			Key="HKEY_CLASSES_ROOT\" & curkey & "\PersistentHandler\"
			on error resume next
			ID=shell.RegRead(key)
			if (err.number =0) and (ID<>IDref) then
				msg=msg & curkey & "  déjà activée avec un autre composant filtre" & VBCRLF
				msg=msg & "(" & ID & ")" & VBCRLF
			else
				err.Clear    
				shell.RegWrite key,IDref
				if err.number =0 then
					msg=msg & curkey & " activée!" & VBCRLF
					neff=neff+1
				else
					err.Clear 
					msg=msg & "Erreur à la création de la clef :" & VBCRLF & "   " & Key & VBCRLF
					end if
				end if
			on error goto 0
			End If
		Next
	msg=msg & neff & " extension(s) ajoutée(s)"
	If not silence Then wscript.echo msg
	End If
Wscript.quit

'--------------------------------------------------------------------
' Sous programme de test du moteur
Sub TestHost
dim rep
strFullName =lcase(WScript.FullName)
strappli=lcase(Wscript.ScriptFullName)
i=InStr(1,strFullName,".exe",1)
j=InStrRev(strFullName,"\",i,1)
strCommand=Mid(strFullName,j+1,i-j-1)
if strCommand<>defmoteur then
	If interactif Then
		rep=MsgBox( _
		"Pour faciliter l'affichage, il est recommandé" & VBCRLF & _
		"de lancer ce script avec """ & defmoteur & """" & VBCRLF & _ 
		"Cela peut être rendu permanent avec la commande" & VBCRLF & _
		"cscript //H:" & defmoteur &" //S /Nologo" & VBCRLF & _
		"Voulez-vous que ce soit fait automatiquement?", _
		vbYesNo + vbQuestion,strappli)
	Else
		rep=vbYes	
		End If
	if rep=vbYes  then 
		nomcmd="setscript.bat"
		Set ficcmd = fso.CreateTextFile(nomcmd)
		ficcmd.writeline "@echo off"
		ficcmd.writeline "cscript //H:" & defmoteur & " //S /Nologo"
		If interactif Then ficcmd.writeline "pause"
		params=""
		For i = 0 To nbargs-1 
			params=params & " " & args(i)
			next
		ficcmd.writeline chr(34) & strappli & chr(34) & params
		If interactif Then ficcmd.writeline "pause"
		ficcmd.close
		shell.Run nomcmd, SW_SHOWNORMAL,true
	    WScript.Quit
		end if
	end if
end sub
'--------------------------------------------------------------------
Function testarg(param)
testarg=false
For i = 0 To nbargs-1
	curarg=lcase(args(i))
	If left(curarg,1)="/" or left(curarg,1)="-" Then
		If mid(curarg,2,len(param))=param Then
			testarg=true
			exit function
			End If
		End If
	Next
End Function
'--------------------------------------------------------------------
Function getarg(param)
getarg=""
For i = 0 To nbargs-1
	curarg=lcase(args(i))
	If left(curarg,1)="/" or left(curarg,1)="-" Then
		If mid(curarg,2,len(param))=param Then
			getarg=mid(curarg,2+len(param))
			exit function
			End If
		End If
	Next
End Function
'--------------------------------------------------------------------