VBScript - Renommage automatique des liens Favoris Réseaux

Marsh Posté le 18-10-2005 à 11:42:57

Bonjour a tous,

Comme le précise le titre de mon message, je souhaite changer de façon automatique les liens des favoris réseaux.
En effet, nous avons changés le nom du serveur de fichier (Ici Serveur1 -> Serveur2) et je souhaiterai faire un script en VBS qui changerai tous les liens vers celui ci.

Jusqu'à présent, j'ai juste réussi a traiter les fichiers .LNK et a les faire pointer sur mon nouveau serveur.

Voici le script déja employé:

****************************************************************************
Dim Silent, CurTime
Dim newlink, oldlink, oldfull, fullname, oldfile
Dim w, ws

const ForReading = 1
const ForWriting = 2
const ForAppending = 8

On Error Resume Next

'Find current time that the script runs
set wso = CreateObject("Wscript.Shell" )
set fso = CreateObject("Scripting.FileSystemObject" )

'pull the system's process variables (we'll be using TEMP
' for the output file and WINDIR for default location of
' user's desktop folder - whether 9x or NT/2k/XP)
Set WshSysEnv = wso.Environment("PROCESS" )

'pull the system's profile environment variable
userprofile = wso.ExpandEnvironmentStrings("%userprofile%" )

'set your variables here
'silent = 0/1/2
' 0 - verbose
' 1 - turns off verification prompts
' 2 - turns off verification and initial config prompts
'curserver = server string you wish to replace
'newserver = server string you wish to change curserver to
' above server vars are needed only for when silent = 2
'ouputfile = location of output filename, you can use a string in
' place of all the code after the equal sign (i.e.
' outputfile = "x:\temp," etc.)
'curtime = finds time of execution of script

Silent = 1
OSType = WshSysEnv("OS" )
CurServer = "oldsrvrname"
NewServer = "newsrvrname"
OutputFile = WshSysEnv("TEMP" ) & "\" & "migrate_shortcuts_log.htm"
CurTime = Now
WinDirectory = WshSysEnv("WINDIR" )

If OSType <> "Windows_NT" Then
CheckFolder = Windirectory & "\desktop"
Else
CheckFolder = userprofile & "\desktop"
End If

'check to see if ouputfile exists or not, deletes it if it does
If CheckFileExists(OutputFile) Then
Set oldfile = fso.GetFile(OutputFile)
oldfile.Delete
Else
'wscript.echo oldfile & " does not yet exist."
End If

If Silent <= 1 Then
Call CServer
End If

'Bring up inputbox for old server string
Sub CServer
'CurServer = InputBox ("Type the name of the server that you wish to"_
'& " replace in your shortcuts (LNK Files).","Enter old server name.",CurServer)
CurServer = "Serveur1"
If CurServer = "" Then
wscript.quit
Else
Call NServer
End If

End Sub

'Bring up inputbox for new server string
Sub NServer
'NewServer = InputBox ("Enter the name of the server you would like to"_
'& " replace instances of " & CurServer & " with.","Enter new server"_
'& "name.",NewServer)
NewServer = "Serveur2"
If NewServer = "" Then
Call CServer
Else
Call CFolder
End If
End Sub

'Bring up inputbox for root folder to search (recursive)
Sub CFolder
'CheckFolder = InputBox ("Type the root folder path that you wish to"_
'& "start your scan from (recursive).","Begin shortcut (lnk) scan"_
'& "from:",CheckFolder)
CheckFolder = userprofile
'WScript.Echo CheckFolder
If CheckFolder = "" Then
Call NServer

End If
End Sub

'set fso = Nothing
'set wso = Nothing

'Start writing the HTM Log file...
Set w = fso.OpenTextFile (OutputFile, ForAppending, True)
w.Writeline ("<html>" )
w.Writeline ("<title>Changing Shortcuts in root folder "_
& CheckFolder & "</title>" )
w.Writeline ("<table BORDER=0 width=100% cellspacing=0 cellpadding=3>" )
w.Writeline ("<tr>" )
w.Writeline ("<th bgcolor=#000080 colspan=3 width=100>" )
w.Writeline ("" )
w.Writeline ("</th>" )
w.Writeline ("</tr>" )
w.Writeline ("<h0>"_
& "Raccourcis trouvés dans: "_
& CheckFolder & " ,"_
& "Recherche périodiquement à " & CurTime & "</h0>" )
w.WriteLine ("<TR bgcolor=gray colspan=3 width=100>" )
w.WriteLine ("<TD> Chemin du raccourci"_
& "</TD>" )
w.WriteLine ("<TD> Chemin Cible"_
& "</TD>" )
w.WriteLine ("<TD> Changé en"_
& "</TD>" )
w.WriteLine ("</TR>" )

If CurServer = "" Then
wscript.echo "Vous n'avez pas spécifié de Serveur à changer!"
Call Cserver
ElseIf NewServer = "" Then
wscript.echo "Vous n'avez pas spécifié de nouveau nom de serveur"_
& " remplace" & curserver & " Par"
Call Nserver
ElseIf CheckFolder = "" Then
: wscript.echo "Vous evez spécifier un nom de serveur pour"_
& " débuter le changement."
Call CFolder
End If

'Recherche des raccourcis
ModifyLinks CheckFolder

Sub ModifyLinks (foldername):
CurServer = LCase(CurServer)

dim file 'for stepping through the files collection '
dim folder 'for stepping through the subfolders collection '
dim fullname 'fully qualified link file name '
dim link 'object connected to the link file '

'Changer tous les fichiers du dossier
For each file in fso.GetFolder(foldername).Files

'Vérifier seulement les fichiers lnk
If strcomp(right(file.name,4),".lnk",vbTexctCompare) = 0 then

'Trouver le chamin complet des raccourcis
fullname = fso.GetAbsolutePathName(file)
oldfull = fullname

'trouver le chemin complet de la cible dans le raccourci
set link = wso.CreateShortcut(fullname)
'targetpath = link.targetpath
targetpath = LCase(link.targetpath)
oldlink = link
newlink = "Pas changé"

'Displays current shortcut that is being checked (good for
' troubleshooting the script).
'If Silent = 0 Then
'MsgBox "Checking shortcut: " & fullname & "." & VBCrlf_
'& "Shortcut target: " & targetpath
'End If

'Figures the starting position of the server name
'MyPos should = 3 if it finds curserver in shortcut
' leading slashes would populate positions 1 & 2
MyPos = InStr(1, targetpath, CurServer)

'If the current server (one you want to change) is found in the
' target path, then run the following code
If InStr(1, targetpath, CurServer) > 0 Then

If link.workingdirectory = "" Then
link.workingdirectory = "not set"
End If

'En cas d'exécution en mode Affiché, Vous Afficherez chaque raccourci et son Dossier de travail
If Silent = 0 Then
MsgBox "Le chemin contient" & CurServer & ". Le chemin complet est: "_
& targetpath & "." & " Le chemin de la cible est: "_
& link.workingdirectory & "."
End If

'Sélectionner la longueur du nom du serveur d'origine
VarLengthSrv = Len(CurServer)

'Add 2 to VarLengthSrv to account for leading backslashes
VarLengthSrv = VarLengthSrv + 2

'Sélectionner la longueur du nom du serveur final
VarLengthPath = Len(targetpath)

'Subtract length of \\servername from full path to parse rest
' of path to PathwoServer
PathwoServer = VarLengthPath - VarLengthSrv

'Sometimes shortcuts don't have working dirs (not sure why)
'If there is a working dir, then run following code
If link.workingdirectory <> "Not Set" then

'Set numerical length of working directory
VarLengthWorking = Len(link.workingdirectory)

'Subtract server length from total working dir length to
'parse rest of path to WorkingPathwoServer
WorkingDir = VarLengthWorking - VarLengthSrv
Else
link.workingdirectory = ""
End If

'Parse the actual text of PathwoServer by using the numerical
' length of the path without the \\servername; do the same
' for WorkingPathwoServer
PathwoServer = Right(targetpath,PathwoServer)
WorkingPathwoServer = Right(link.workingdirectory,WorkingDir)

'wscript.echo "Path of shortcut is " & PathwoServer_
'& ". Working folder is " & WorkingPathwoServer & "."

'Display input box to modify each shortcut as the script finds them
If Silent = 0 Then
ModifyPath = InputBox ("Modify path for " & targetpath & ""_
& "and replace with \\" & NewServer & PathwoServer & "?",""_
& "Type 'yes' to modify." )
ElseIf Silent >= 1 Then
ModifyPath = "yes"
End If
If ModifyPath = "yes" Then
'wscript.echo "Now setting path to \\"_
' & NewServer & PathwoServer

oldlink = targetpath
'Set link target path attribute to
' \\newservername\targetpath
link.targetpath = "\\" & NewServer & PathwoServer
newlink = link.targetpath
oldfull = link

'wscript.echo newlink

If VarLengthWorking <> "" Then
'Set link working dir attribute to
' \\newservername\workingpath
link.workingdirectory = "\\" & NewServer & ""_
& WorkingPathwoServer
End If

'Save the shortcut with the new information
link.save

'If answer above is anything but yes, the script will proceed
' to the next shortcut

Else
oldfull = "Pas de changement"
End if

'Clear link variable

End if

'write output to logfile
Call WriteEntry
End If

Next

'process all the subfolders in the folder
For each folder in fso.GetFolder(foldername).Subfolders
call ModifyLinks(folder.path)

Next
End Sub

'********************************************************************
'********************************************************************
'Recherche des raccourcis default user

CheckFolder = "C:\Documents and Settings\Default User"
ModifyLinks CheckFolder

Sub ModifyLinks (foldername):
CurServer = LCase(CurServer)

dim file 'for stepping through the files collection '
dim folder 'for stepping through the subfolders collection '
dim fullname 'fully qualified link file name '
dim link 'object connected to the link file '

'Changer tous les fichiers du dossier
For each file in fso.GetFolder(foldername).Files

'Vérifier seulement les fichiers lnk
If strcomp(right(file.name,4),".lnk",vbTexctCompare) = 0 then

'Trouver le chamin complet des raccourcis
fullname = fso.GetAbsolutePathName(file)
oldfull = fullname

'trouver le chemin complet de la cible dans le raccourci
set link = wso.CreateShortcut(fullname)
'targetpath = link.targetpath
targetpath = LCase(link.targetpath)
oldlink = link
newlink = "Pas changé"

'Displays current shortcut that is being checked (good for
' troubleshooting the script).
'If Silent = 0 Then
'MsgBox "Checking shortcut: " & fullname & "." & VBCrlf_
'& "Shortcut target: " & targetpath
'End If

'Figures the starting position of the server name
'MyPos should = 3 if it finds curserver in shortcut
' leading slashes would populate positions 1 & 2
MyPos = InStr(1, targetpath, CurServer)

'If the current server (one you want to change) is found in the
' target path, then run the following code
If InStr(1, targetpath, CurServer) > 0 Then

If link.workingdirectory = "" Then
link.workingdirectory = "not set"
End If

'En cas d'exécution en mode Affiché, Vous Afficherez chaque raccourci et son Dossier de travail
If Silent = 0 Then
MsgBox "Le chemin contient" & CurServer & ". Le chemin complet est: "_
& targetpath & "." & " Le chemin de la cible est: "_
& link.workingdirectory & "."
End If

'Sélectionner la longueur du nom du serveur d'origine
VarLengthSrv = Len(CurServer)

'Add 2 to VarLengthSrv to account for leading backslashes
VarLengthSrv = VarLengthSrv + 2

'Sélectionner la longueur du nom du serveur final
VarLengthPath = Len(targetpath)

'Subtract length of \\servername from full path to parse rest
' of path to PathwoServer
PathwoServer = VarLengthPath - VarLengthSrv

'Sometimes shortcuts don't have working dirs (not sure why)
'If there is a working dir, then run following code
If link.workingdirectory <> "Not Set" then

'Set numerical length of working directory
VarLengthWorking = Len(link.workingdirectory)

'Subtract server length from total working dir length to
'parse rest of path to WorkingPathwoServer
WorkingDir = VarLengthWorking - VarLengthSrv
Else
link.workingdirectory = ""
End If

'Parse the actual text of PathwoServer by using the numerical
' length of the path without the \\servername; do the same
' for WorkingPathwoServer
PathwoServer = Right(targetpath,PathwoServer)
WorkingPathwoServer = Right(link.workingdirectory,WorkingDir)

'wscript.echo "Path of shortcut is " & PathwoServer_
'& ". Working folder is " & WorkingPathwoServer & "."

'Display input box to modify each shortcut as the script finds them
If Silent = 0 Then
ModifyPath = InputBox ("Modify path for " & targetpath & ""_
& "and replace with \\" & NewServer & PathwoServer & "?",""_
& "Type 'yes' to modify." )
ElseIf Silent >= 1 Then
ModifyPath = "yes"
End If
If ModifyPath = "yes" Then
'wscript.echo "Now setting path to \\"_
' & NewServer & PathwoServer

oldlink = targetpath
'Set link target path attribute to
' \\newservername\targetpath
link.targetpath = "\\" & NewServer & PathwoServer
newlink = link.targetpath
oldfull = link

'wscript.echo newlink

If VarLengthWorking <> "" Then
'Set link working dir attribute to
' \\newservername\workingpath
link.workingdirectory = "\\" & NewServer & ""_
& WorkingPathwoServer
End If

'Save the shortcut with the new information
link.save

'If answer above is anything but yes, the script will proceed
' to the next shortcut

Else
oldfull = "Pas de changement"
End if

'Clear link variable

End if

'write output to logfile
Call WriteEntry
End If

Next

'process all the subfolders in the folder
For each folder in fso.GetFolder(foldername).Subfolders
call ModifyLinks(folder.path)

Next
End Sub

'********************************************************************
'********************************************************************

'--------------------
' Function WriteEntry pour écrire les changement dans le fichier LOG
'--------------------

Function WriteEntry
If newlink <> "0" Then
w.WriteLine ("<TR>" )
w.WriteLine ("<TD>" & ""_
& oldfull & "</TD>" )
w.WriteLine ("<TD>" & ""_
& oldlink & "</TD>" )
w.WriteLine ("<TD>" & ""_
& newlink & "</TD>" )
w.WriteLine ("</TR>" )
oldfull = "0"
newlink = "0"
oldlink = "0"

End If
End Function

'-------------------
'Fonction pour voir si le fichier de sortie existe
'-------------------

Function CheckFileExists(sFileName)

Dim FileSystemObject
Set FileSystemObject = CreateObject("Scripting.FileSystemObject" )
If (FileSystemObject.FileExists(sFileName)) Then
CheckFileExists = True
Else
CheckFileExists = False
End If
Set FileSystemObject = Nothing
End Function

w.Writeline ("</html>" )

'if silent = 2, then it will not open the log file
If Silent <= 1 Then
'set command variable with path in quotes (for long filenames)
Command = Chr(34) & OutputFile & Chr(34)

'run htm file in your default browser
wso.Run Command
End If

WScript.Echo " Done "

***********************************************************************

Peut être que la sollution est de connaitre l'extension des liens des Favoris réseaux et de procéder de la même façon.

Il ne resterai plus que les mappages réseaux a modifier, mais la je n'ai aucune idée de comment procéder.

Pouvez vous m'aider ou m'aiguiller car je tourne un peu en rond.

A+
Vince

Marsh Posté le 18-10-2005 à 11:42:57

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed

Name *

Email *

URL

Message *