1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Script vbs d'impression ou affichage d'un répertoire depuis le menu contextuel

Script vbs d'impression ou affichage d'un répertoire depuis le menu contextuel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 335 fois - Téléchargée 18 fois

Commenter

Contenu du snippet

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"

Source / Exemple : 


' 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
' -------------------------------------

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
291
Date d'inscription
vendredi 21 février 2003
Statut
Membre
Dernière intervention
13 mars 2015
Meci
Signaler
Messages postés
7288
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 mars 2021
 120
Bonjour,
le fichier d'aide est sur ce site de même que cette source

http://www.bellamyjc.org/fr/vbsdownload.html#printdir

@+
Signaler
Messages postés
291
Date d'inscription
vendredi 21 février 2003
Statut
Membre
Dernière intervention
13 mars 2015
Très intéressant.
Par contre le fichier d'aide se trouve ou ?
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (djebbipgm)