' ----------------------------------------------------------
' Script de suppression de l'affectation d'une icône à un 
' dossier dans l'explorateur
' Il se lance :
'   - depuis le menu contextuel dans l'explorateur de Windows
'   - depuis une fenêtre de commandes en lui passant en paramètre
'     le dossier à traiter 
'     raziconfolder[.vbs] <nom-de-dossier> 
' Ce script s'installe automatiquement (modification BDR)
' en l'exécutant sans aucun paramètre
'
' JC BELLAMY © 2002
' ----------------------------------------------------------

Const Normal=0
Const ReadOnly=1
Const Hidden=2
Const System=4
Const Volume=8
Const Directory=16
Const Archive=32
Const Alias=1024
Const Compressed=2048

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const quote = """"

Dim jcbtool,fso,shell,args
Dim dskini
Set args  = Wscript.Arguments
set fso     = wscript.CreateObject("Scripting.FileSystemObject")
set shell   = wscript.CreateObject("WScript.Shell")
jcbCOM="jcb.tools"
TestCOMExists jcbCOM,"jcb.ocx"
TestCOMExists "COMCTL.ListViewCtrl","comctl32.ocx"

set jcbtool = wscript.CreateObject(jcbCOM,"event_")
If args.count=0 Then 
' Auto-installation
	Script=Wscript.ScriptFullName
	register "Folder","iconfolderRAZ","Icône de dossier (retrait)",script
	MsgBox "Script "& Script &" installé", vbInformation, "Icône de dossier"
	wscript.quit
	end if
curdir=args(0)
If not fso.FolderExists(curdir) Then
	MsgBox "Dossier " & curdir & " inexistant",vbExclamation
	wscript.quit
	end if
curdir=jcbtool.GetLongName(curdir)

If right(curdir,1)<>"\" Then curdir=curdir & "\"
desktopini=Curdir & "desktop.ini"

OldLines=""
IconExist=false
If fso.FileExists(desktopini) Then
	Dim lines,KeepLines()
	Set f=fso.getfile(desktopini)
	f.attributes=f.attributes and not System
	f.attributes=f.attributes and not Hidden
	Set dskini=fso.OpenTextFile(desktopini, ForReading, true)
	Content=dskini.ReadAll
	dskini.close
	Lines=split(Content,VBCRLF)
	lineMin=Lbound(Lines)
	lineMax=Ubound(Lines)
	nbLines=lineMax-lineMin+1
	redim KeepLines(nblines)

	For i = lineMin To LineMax
		KeepLines(i)=true
		p=instr(Lines(i),"=")
		If p>0 Then	
			Entry=lcase(trim(left(lines(i),p-1)))
			Value=ltrim(mid(lines(i),p+1))
			Select Case Entry
				Case "iconfile","iconindex","infotip"
					KeepLines(i)=false
					IconExist=true
				End Select
		else
			Lines(i)=lcase(trim(lines(i)))
			end if
		If KeepLines(i) Then
			If OldLines<>"" Then OldLines=OldLines & VBCRLF
			If Lines(i)<>"" Then OldLines=OldLines & Lines(i)		
			End If
		Next
	end if
If 	IconExist Then
	Rep=Msgbox("Voulez vous réellement retirer l'icône?",vbYesNo + vbQuestion, "Icône du dossier " & Curdir)
else
	Rep=VbNo
	Msgbox "Ce dossier n'a pas d'icône",vbOKOnly + vbInformation, "Icône du dossier " & Curdir
	End If
If Rep=VbYes Then
	Set dskini=fso.OpenTextFile(desktopini, ForWriting, true)
	If OldLines<>"" Then dskini.WriteLine OldLines
	dskini.close
	Set f=fso.getfile(desktopini)
	f.attributes=f.attributes or System
	f.attributes=f.attributes or Hidden

	jcbtool.RefreshDesktop
	Set f=fso.Getfolder(curdir)
	f.attributes=f.attributes or System
	jcbtool.RefreshDesktop

	prompt="L'icône affectée au dossier" & VBCRLF
	prompt=prompt & Curdir & VBCRLF
	prompt=prompt & "a été retirée"
	msgbox prompt,vbInformation,"Icônes de dossier" 
	End If
wscript.quit

'--------------------------------------------------------------------
Sub register(typefic,clef,item,script)
Key="HKEY_CLASSES_ROOT\" & typefic & "\shell\" & clef & "\"
shell.RegWrite Key,item
Command="wscript """ & Script & """ ""%1"""
shell.RegWrite Key & "command\",Command
End Sub
'--------------------------------------------------------------------
Sub Setattrib(f,att)
Attrib=f.Attributes
If Attrib and att=0 Then f.Attributes=Attrib+att
End Sub
'--------------------------------------------------------------------
Sub Resetattrib(f,att)
Attrib=f.Attributes
If Attrib and att<>0 Then f.Attributes=Attrib-att
End Sub
'--------------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
End Function
'--------------------------------------------------------------------
Sub TestCOMExists(name,module)
' Vérification d'installation d'un objet COM
on error resume next
clef="HKCR\" & name & "\"
dummy = shell.RegRead(Clef)
if err.number<>0 then 
' contrôle ActiveX non enregistré
	pathmodule=getpath()& module
	If not fso.fileExists(pathmodule) Then
		Mess = "Le contrôle ActiveX " & name & " est requis." & VBCRLF
		Mess=Mess & "Il est contenu dans le fichier " & module & VBCRLF
		Mess=Mess & "Or ce fichier n'a pas été trouvé." & VBCRLF
		Mess=Mess & "Veuillez réinstaller le logiciel IconFolder"
		MsgBox Mess, vbOKOnly + vbExclamation
		wscript.quit
		End If
	err.clear
	shell.Run "regsvr32.exe " & quote & pathmodule & quote, SW_SHOWNORMAL,true
	dummy = shell.RegRead("HKCR\" & name & "\")
	if err.number<>0 then 
		Mess = "Le contrôle ActiveX " & name & " n'a pas pu être enregistré"
		MsgBox Mess, vbExclamation
		wscript.quit
		end if	
	end if
End Sub
'--------------------------------------------------------------------
Function FormatStrR(ch,lmax)
l=len(ch)
If l<lmax Then 
	For k = l+1 To lmax
		ch=" " & ch
		Next
	End If
FormatStrR=ch
End Function
'--------------------------------------------------------------------
Sub Testlib(Dir,Lib)
LibName=Dir & Lib
LibRef=getpath() & Lib
If not fso.fileExists(LibName) Then
	If not fso.fileExists(LibRef) Then
		Mess = "La librairie " & libName & " est requise." & VBCRLF
		Mess=Mess & "Or ce fichier n'a pas été trouvé" & VBCRLF
		Mess=Mess & "Veuillez réinstaller le logiciel IconFolder"
		MsgBox Mess, vbOKOnly + vbExclamation
		wscript.quit
		End If
	fso.copyfile LibRef,LibName,true	
	End If
End Sub
'--------------------------------------------------------------------