' ---------------------------------------------------------- ' Extraction de nom court à partir d'un nom long ' le nom peut désigner un fichier ou un dossier, ' existant ou non, avec ou sans chemin ' ' JC BELLAMY © 2002 ' ---------------------------------------------------------- ' Dim args, fso, f , d Dim part() Set fso=WScript.CreateObject("Scripting.FileSystemObject") Set args = Wscript.Arguments If args.count=0 Then nomlong=InputBox("Nom long à convertir","Conversion de nom long") else nomlong=args(0) end if nomlong=trim(nomlong) if len(nomlong)=0 then wscript.quit ' Si le nom se termine par "\", suppression du \ final if right(nomlong,1)="\" then nomlong=left(nomlong,len(nomlong)-1) longnom=fso.GetAbsolutePathName(nomlong) ' Si le nom se résume à un nom de disque, retour if len(nomlong)<=3 then PrintNomCourt nomlong,"" wscript.quit end if ' Test d'existence de dossier If fso.FolderExists(nomlong) Then set d=fso.GetFolder(nomlong) shortname=d.ShortName shortpath=d.ShortPath PrintNomcourt shortpath,shortname wscript.quit else ' Test d'existence de fichier If fso.FileExists(nomlong) Then set f=fso.GetFile(nomlong) shortname=f.ShortName shortpath=f.ShortPath PrintNomcourt shortpath,shortname wscript.quit end if End If ' ---- Fichier ou dossier non existant ---- ' Test si un chemin figure dans le nom pslash1=InstrRev(nomlong,"\") existedir=true If pslash1>0 Then path=Left(nomlong,pslash1-1) ' test d'existence du chemin ' s'il n'existe pas, on le crée (temporairement) ' création récursive If not fso.FolderExists(path) Then existedir=false level=0 SuperCreateFolder path End If end if ' Création temporaire du fichier fso.CreateTextFile(nomlong) set f=fso.GetFile(nomlong) shortname=f.ShortName shortpath=f.ShortPath PrintNomcourt shortpath,shortname ' Suppression du fichier f.Delete ' Suppression des parties du chemin qui n'existaient pas au départ If not existedir Then For i = level To 1 step -1 set d=fso.GetFolder(part(i)) d.Delete Next end If wscript.quit ' ------------------------------------- Sub PrintNomCourt(path,name) pslash2=InstrRev(path,"\") If pslash2>0 Then path=Left(path,pslash2-1) NomCourt=path & "\" & name If args.count=0 Then MsgBox NomCourt, vbOKOnly + vbInformation, nomlong _ else wscript.echo Nomcourt End Sub ' ------------------------------------- ' Création récursive de dossier Sub SuperCreateFolder(fd) If fd="" Then exit sub bs=InstrRev(fd,"\") parent=left(fd,bs-1) If len(parent)>2 Then If not fso.FolderExists(parent) then SuperCreateFolder Parent End If ' mémorisation de chaque niveau pour suppression ultérieure level=level+1 redim preserve part(level) part(level)=fd ' création du dossier fso.CreateFolder(fd) End Sub ' -------------------------------------