' ----------------------------------------------------------
' Script VBS d'impression ou affichage d'un répertoire 
' depuis le menu contextuel de l'explorateur de Windows 
' Une boite de dialogue s'ouvre afin de permettre
' la saisie de paramètres de sélection et paramètres
' de la commande "dir"
' Ce script est livré avec un ficher d'aide qui rappelle
' la syntaxe de "dir"
'
' Il est autoinstallable par exécution sans paramètres
'
' JC BELLAMY © 2005
' ----------------------------------------------------------

' Constantes
SW_HIDE	      = 0 
SW_SHOWNORMAL = 1 
ForReading = 1
ForWriting = 2
' Tableau de correpsondance OEM->ANSI
' car la commande dir génère de l'OEM
Dim oem
oem=array( _
"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F", _
"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F", _
"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F", _
"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F", _
"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F", _
"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F", _
"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F", _
"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F", _
"C7","FC","E9","E2","E4","E0","E5","E7","EA","EB","E8","EF","EE","EC","C4","C5", _
"C9","E6","C6","F4","F6","F2","FB","F9","FF","D6","DC","F8","A3","D8","D7","83", _
"E1","ED","F3","FA","F1","D1","AA","BA","BF","AE","AC","BD","BC","A1","AB","BB", _
"A6","A6","A6","A6","A6","C1","C2","C0","A9","A6","A6","2B","2B","A2","A5","2B", _
"2B","2D","2D","2B","2D","2B","E3","C3","2B","2B","2D","2D","A6","2D","2B","A4", _
"F0","D0","CA","CB","C8","69","CD","CE","CF","2B","2B","A6","5F","A6","CC","AF", _
"D3","DF","D4","D2","F5","D5","B5","FE","DE","DA","DB","D9","FD","DD","AF","B4", _
"AD","B1","3D","BE","B6","A7","F7","B8","B0","A8","B7","B9","B3","B2","A6","A0")

Dim ansi
ansi=array( _
"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F", _
"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F", _
"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F", _
"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F", _
"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F", _
"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F", _
"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F", _
"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F", _
"5F","5F","27","9F","22","2E","C5","CE","5E","25","53","3C","4F","5F","5A","5F", _
"5F","27","27","22","22","07","2D","2D","7E","54","73","3E","6F","5F","7A","59", _
"FF","AD","BD","9C","CF","BE","DD","F5","F9","B8","A6","AE","AA","F0","A9","EE", _
"F8","F1","FD","FC","EF","E6","F4","FA","F7","FB","A7","AF","AC","AB","F3","A8", _
"B7","B5","B6","C7","8E","8F","92","80","D4","90","D2","D3","DE","D6","D7","D8", _
"D1","A5","E3","E0","E2","E5","99","9E","9D","EB","E9","EA","9A","ED","E8","E1", _
"85","A0","83","C6","84","86","91","87","8A","82","88","89","8D","A1","8C","8B", _
"D0","A4","95","A2","93","E4","94","F6","9B","97","A3","96","81","EC","E7","98")


' Variables
Dim shell, args, fso, dirtemp, fictemp,ficoem, fictxt
Set shell = WScript.CreateObject("WScript.Shell")
Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set args  = Wscript.Arguments
'
Script=Lcase(Wscript.ScriptFullName)
HelpFile=Left(Script,len(script)-3) & "hlp"
If args.count=0 Then
' Auto-installation
	Key="HKEY_CLASSES_ROOT\folder\shell\printdir\"
	shell.RegWrite Key,"Impression du contenu du répertoire"
	Command="wscript """ & Script & """ ""%L"""
	shell.RegWrite Key & "command\",Command
	MsgBox "Script "& Script &" installé", vbInformation, "Exécution dans une console"
	WScript.quit
	end if
curdir=args(0)
If right(curdir,1)="\" Then curdir=left(curdir,len(curdir)-1)
Prompt="Indiquer le répertoire à imprimer, suivi du" & vbcrlf & _
"critère de sélection éventuel, ainsi que des"  & vbcrlf & _
"commutateurs habituels de la commande " & chr(34) & "dir" & chr(34) & "." _
& vbcrlf & vbcrlf & _
"(Appuyer sur le bouton d'aide pour plus de détails)"
critere=InputBox(Prompt, "Impression de contenu de répertoire", _
curdir & "\*.*",,,helpfile,1)
If Len(critere)=0 Then Wscript.quit
p=InStr(1,critere,"/",vbTextCompare)
If p>0 then
	switch=mid(critere,p)
	critere=trim(left(critere,p-1))
Else
	switch=""
	End If

' Création de nom de fichiers dans le répertoire temporaire

Set dirtemp = fso.GetSpecialFolder(2)
nomcmd = dirtemp & "\printdir.bat"
nomoem = dirtemp & "\printdir.oem"
nomtxt = dirtemp & "\printdir.txt"

' Fichier batch exécutant la commande "dir"
' avec sortie redirigée vers un fichier
Set ficTemp = fso.CreateTextFile(nomcmd)
fictemp.writeline "@echo off"
fictemp.writeline ansi2oem("dir """ &  critere & """ " & switch & " > " & nomoem)
ficTemp.close

shell.Run nomcmd, SW_HIDE,true

' Retraitement du fichier résultats
' Conversion OEM -> ANSI
Set ficoem=fso.OpenTextFile(nomoem, ForReading)
Set fictxt=fso.OpenTextFile(nomtxt, ForWriting,true)
While not ficoem.AtEndOfStream
	oldline=ficoem.ReadLine
	newline=""
	For i = 1 To len(oldline)
		oldc=asc(mid(oldline,i,1))
		newc=oem(oldc)
		newline=newline & chr(hextobyte(newc))
		Next
	fictxt.WriteLine newline
	Wend
fictxt.close
ficoem.close

prompt="Le contenu du répertoire a été stocké dans" & VBCRLF & _
"le fichier " & nomtxt & VBCRLF & _
"Appuyer sur :" & VBCRLF & _
"  OUI pour l'imprimer" & VBCRLF & _
"  NON pour l'ouvrir avec le bloc-notes"
rep=MsgBox(prompt, vbYesNo + vbQuestion, curdir)

If rep=vbYes Then 
	commutateur=" /p " 
	show=SW_HIDE
else 
	commutateur=" "
	show=SW_SHOWNORMAL
	end if
' Impression ou affichage du fichier à l'aide du bloc-notes
commande=shell.ExpandEnvironmentStrings("%windir%\notepad.exe" &  commutateur & chr(34) & nomtxt & chr(34)) 
shell.Run commande, show, true
Wscript.quit

' Utilitaires de conversion hexadécimale
' -------------------------------------
Function hextobyte(s)
c1=Left(s,1)
c2=Right(s,1)
hextobyte=hextobin(c1)*16+hextobin(c2)
End Function
' -------------------------------------
Function hextobin(c)
Select Case c
	Case "0","1","2","3","4","5","6","7","8","9" 
		hextobin=asc(c)-asc("0")		   
	Case else
		hextobin=asc(c)-asc("A")+10
	End Select	
End Function
' -------------------------------------
Function ansi2oem(oldline)
newline=""
For i = 1 To len(oldline)
	oldc=asc(mid(oldline,i,1))
	newc=ansi(oldc)
	newline=newline & chr(hextobyte(newc))
	Next
ansi2oem=newline
end function
' -------------------------------------