'--------------------------------------------------------------------
' Script de création de raccourci de fichier ou dossier épinglé sur la barre de tâches
'
' Syntaxe :
'	Epingle [<\\machine\nom_de_partage>]<nom_du_fichier> [<dossier_de_démarrage>]
'   Epingle [<\\machine\nom_de_partage>]<nom_du_dossier>
'
' Le nom de fichier ou de dossier peut être complet ou relatif
' NB: ne pas oublier d'encadrer par des guillemets s'il y a 
'     des espaces dans les noms 
' Exemples :
'	Epingle "m:\docs\rapport d'essai.doc" m:\docs
'   Epingle d:\winnt\system32\drivers\etc
'	Epingle \\springfield\d
'
' JC BELLAMY © 2012
'--------------------------------------------------------------------
Const CSIDL_COMMON_PROGRAMS = &H17 
Const CSIDL_PROGRAMS = &H2 
Set ShellAppli = CreateObject("Shell.Application") 
Set Shell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set args=Wscript.Arguments
If args.Count=0 Then Aide ""
lnkName=args(0)
TaskbarPath=shell.ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar" 

' Fichier ou dossier
Fichier=true
' Test d'existence du fichier
If not fso.FileExists(lnkName) Then
	Fichier=false
' Test si c'est un dossier	
	If not fso.FolderExists(lnkName) Then _ 
		Aide "Le fichier ou le dossier " & lnkName & " n'existe pas!"
	End If
' Test si ressource réseau
reseau=false
hostname=""
sharename=""
If  left(lnkName,2)="\\" Then
	reseau=true
	name2=right(lnkName,len(lnkname)-2)
	p=instr(name2,"\")
	hostname=" (" & left(name2,p-1) & ")"
	resname=right(name2,len(name2)-p)
	p=instr(resname,"\")
	If p>0 Then sharename=left(resname,p-1)	Else sharename=resname
	end if

If fichier Then
    parameters=""
	description="Raccourci sur le fichier "
	set f=fso.GetFile(lnkName)
	nom=f.name
	fullname=f.path
' Si le dossier de démarrage n'est pas spécifié, 
' on prend celui du fichier
	If args.Count=1 Then lnkPath=f.ParentFolder Else lnkPath=args(1)	
' Test d'existence du dossier de démarrage
	If not fso.FolderExists(lnkPath) Then _
		Aide "Le dossier " & lnkPath & "n'existe pas"
Else
' On ne peut pas épingler directement des raccourcis de dossier
' Il fait passer par un raccourci sur "explorer.exe", auquel on passe
' le dossier voulu en paramètre.
	set f=fso.GetFolder(lnkName)
	nom=f.name
	If len(nom)=0 Then 
		nom=sharename 
		description="Raccourci sur le partage "
	else 
		description="Raccourci sur le dossier "
		end if
	fullname=f.path
	lnkPath=fullname
' Chemin de explorer.exe
    fullname=shell.ExpandEnvironmentStrings("%systemroot%") & "\explorer.exe "
	parameters="""" & lnkPath & """"
	End If

' extraction du nom sans extension
pospoint=InstrRev(nom, ".")
If pospoint>0 Then nomse=Left(nom,pospoint-1) Else nomse=nom
nomse=nomse & hostname
ShortcutName=nomse & ".lnk"
Set lnk=Shell.CreateShortCut(TaskbarPath & "\" & ShortcutName)
lnk.TargetPath=fullname
lnk.Arguments=parameters
lnk.WorkingDirectory=lnkPath
lnk.Description=Description & nom & hostname
lnk.Save
Call PinShortCut(ShortcutName,lnkName,Description) 
wscript.quit

'--------------------------------------------------------------------
Sub PinShortCut(ShortcutName,lnkName,Description)
Set objFolder = ShellAppli.Namespace(TaskbarPath) 
Set objFolderItem = objFolder.ParseName(ShortcutName) 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Épingler à la barre des tâches" Then objVerb.DoIt 
	Next
Wscript.echo Description & " " & lnkName & " épinglé dans la barre de tâches"
End Sub

'--------------------------------------------------------------------
Sub Aide(erreur)
If erreur="" Then
	msg= "Script de création de raccourci" & VBCRLF &"épinglé dans la barre de tâches" & VBCRLF &"JCB © 2011" & VBCRLF
Else
	msg=erreur & VBCRLF
	End If
msg=msg & "--------------------------------------------" & VBCRLF
msg=msg & "Syntaxe :" & VBCRLF
msg=msg & "   Epingle [<\\machine\partage>]<fichier> [<dossier_démarrage>]" & VBCRLF
msg=msg & "       NB: si <dossier_de_démarrage> est omis,"  & VBCRLF
msg=msg & "       le dossier du fichier est retenu" & VBCRLF
msg=msg & "   Epingle [<\\machine\partage>]<dossier>" & VBCRLF
wscript.echo msg
Wscript.Quit
End Sub
'--------------------------------------------------------------------