' ---------------------------------------------------------------- ' Script de création de raccourcis URL à partir d'un fichier texte ' ' JC BELLAMY © 2001 ' ---------------------------------------------------------------- Dim shell, args, fso, f, Ushct Const ForReading = 1 Set shell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") strappli=lcase(Wscript.ScriptFullName) i=InStr(1,strappli,".vbs",1) j=InStrRev(strappli,"\",i,1) strscript=Mid(strappli,j+1,i-j-1) ' Test du moteur utilisé Call TestHost(true) ' Set args = Wscript.Arguments If args.count<2 Then wscript.echo "-----------------------------------------------------" wscript.echo "Script """ & strscript & """ - JCB © 2001" wscript.echo wscript.echo "Syntaxe :" wscript.echo " " & strscript & " " wscript.echo wscript.echo " Paramètres :" wscript.echo " " wscript.echo " fichier texte existant contenant" wscript.echo " séquentiellement des URL" wscript.echo " (un par ligne)" wscript.echo wscript.echo " " wscript.echo " répertoire existant ou non dans lequel" wscript.echo " seront créés les raccourcis Internet" wscript.echo "-----------------------------------------------------" wscript.quit End If srcfile=args(0) destfolder=args(1) If not fso.FileExists(srcfile) Then wscript.echo "Le fichier " & srcfile & " n'existe pas!" wscript.quit End If If not fso.FolderExists(destfolder) Then SuperCreateFolder(destfolder) End If Set f=fso.OpenTextFile(srcfile,ForReading) n=0 Do While not f.AtEndOfStream curline=f.readline n=n+1 Name=Right(curline,Len(curline)-7) Name=Replace(Name,"www.","") Name=Replace(Name,"/","_") path=destfolder & "\" & Name & ".url" Set Ushct=Shell.CreateShortCut(path) Ushct.TargetPath=curline Ushct.Save Loop wscript.echo n & " raccourci(s) créé(s)" wscript.quit '-------------------------------------------------------------------- 'Sous-programme de création récursive de répertoire Sub SuperCreateFolder(curfolder) k=InStrRev(curfolder,"\") parentfolder=left(curfolder,k-1) If not fso.FolderExists(parentfolder) Then _ SuperCreateFolder(parentfolder) fso.CreateFolder(curfolder) wscript.echo "Le dossier " & curfolder & " a été créé" End Sub '-------------------------------------------------------------------- 'Sous-programme de test du moteur 'Vu les sorties générées, c'est CSCRIPT (et non pas WSCRIPT) 'qui doit être utilisé de préférence Sub TestHost(force) dim rep strappli=lcase(Wscript.ScriptFullName) strFullName =lcase(WScript.FullName) i=InStr(1,strFullName,".exe",1) j=InStrRev(strFullName,"\",i,1) strCommand=Mid(strFullName,j+1,i-j-1) if strCommand<>"cscript" then If force then Init="Ce script doit être lancé avec CSCRIPT" Else Init="Il est préférable de lancer ce script avec CSCRIPT" End If rep=MsgBox(Init & VBCRLF & _ "Cela peut être rendu permanent avec la commande" & VBCRLF & _ "cscript //H:CScript //S /Nologo" & VBCRLF & _ "Voulez-vous que ce soit fait automatiquement?", _ vbYesNo + vbQuestion,strappli) if rep=vbYes then nomcmd="setscript.bat" Set ficcmd = fso.CreateTextFile(nomcmd) ficcmd.writeline "@echo off" ficcmd.writeline "cscript //H:CScript //S /Nologo" ficcmd.writeline "pause" params="" For i = 0 To nbargs-1 params=params & " " & args(i) next ficcmd.writeline chr(34) & strappli & chr(34) & params ficcmd.writeline "pause" ficcmd.close shell.Run nomcmd, SW_SHOWNORMAL,true force=true end if If force then WScript.Quit end if end sub '--------------------------------------------------------------------