Skip to content

Instantly share code, notes, and snippets.

@gioxx
Last active August 29, 2015 14:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save gioxx/11403345 to your computer and use it in GitHub Desktop.
Save gioxx/11403345 to your computer and use it in GitHub Desktop.
Modifica il puntamento dei collegamenti alle cartelle di rete presenti sul Desktop. Accetta parametri via batch (vedi secondo blocco codice). Lo script di partenza è disponibile all'indirizzo community.spiceworks.com/scripts/show/298-change-shortcut-lnk-target-paths-in-bulk
' MODIFICA IN BULK DEGLI SHORTCUT
' Codice originale : Rob Dunn
' Modificato da : GSolone
' Ultima modifica : 29-04-2014 (rev1)
' -------------------------------------------------------------------
' MODIFICHE
' rev1- ho rimosso i popup di richiesta dati e messo di default il parametro Silent a 2 così da non richiedere l'intervento dell'utente. Ho inserito l'objArgs così da potergli passare i parametri direttamente da un batch (logon)
Dim Silent, CurTime, sIsDrive
Dim newlink, oldlink, oldfull, fullname, oldfile, bgcolor
Dim CheckFolder, RootFolder
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")
'objArgs per passargli i parametri da batch
Set objArgs = WScript.Arguments
'pull the system's process variables (we'll be using TEMP
' for the output file and WINDIR to figure out the 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
'ChangePathFrom = string you wish to replace
'ChangePathTo = string you wish to change ChangePathFrom 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
'RootFolder = The folder that you wish to search (silent mode only)
'--------------------------------------------------------------------
' set your variables below...
'--------------------------------------------------------------------
Silent = 2
ChangePathFrom = objArgs(0)
ChangePathTo = objArgs(1)
OutputFile = WshSysEnv("TEMP") & "\" & "BulkShortcut.htm"
RootFolder = objArgs(2)
'--------------------------------------------------------------------
CurTime = Now
OSType = WshSysEnv("OS")
WinDirectory = WshSysEnv("WINDIR")
If Silent > 0 Then
CheckFolder = RootFolder
Else
End If
If CheckFolder = "" Then
If OSType <> "Windows_NT" Then
'Windows 9x/Me desktop folder
CheckFolder = Windirectory & "\desktop"
Else
'Windows NT/2k/XP desktop folder
CheckFolder = userprofile & "\desktop"
End If
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
'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 ("<p align=left>")
w.Writeline ("</th>")
w.Writeline ("</tr>")
w.Writeline ("<h0><B><font face=Arial color=#000033 size=2>"_
& "Shortcuts located in: <font color=#CC0000> "_
& CheckFolder & " <font face=Arial color=#000033 size=2>,"_
& " searching recursively at " & CurTime & "</B></font></h0>")
w.WriteLine ("<TR bgcolor=gray colspan=3 width=100>")
w.WriteLine ("<TD><font face=Arial size=1 color=white> Shortcut Path"_
& "</font></TD>")
w.WriteLine ("<TD><font face=Arial size=1 color=white> Target Path"_
& "</font></TD>")
w.WriteLine ("<TD><font face=Arial size=1 color=white> Updated to"_
& "</font></TD>")
w.WriteLine ("</TR>")
If ChangePathFrom = "" Then
wscript.echo "You have not specified a source string to change."
Call Cserver
ElseIf ChangePathTo = "" Then
wscript.echo "You have not specified a new string name to"_
& " replace" & Chr(34) & ChangePathFrom & Chr(34) & " with."
Call Nserver
ElseIf CheckFolder = "" Then
wscript.echo "You must specify a root folder to begin your"_
& " search from."
Call CFolder
End If
'process the shortcuts
ModifyLinks CheckFolder
Sub ModifyLinks (foldername)
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 '
'process all the files in the folder
For each file in fso.GetFolder(foldername).Files
'check only link files
If strcomp(right(file.name,4),".lnk",vbTexctCompare) = 0 then
'Find full path of shortcut
fullname = fso.GetAbsolutePathName(file)
'Find full path of target within shortcut
set link = wso.CreateShortcut(fullname)
targetpath = LCase(link.targetpath)
oldfull = fullname
oldlink = targetpath
newlink = "Not Updated"
'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
'If the current server (one you want to change) is found in the
' target path, then run the following code
If InStr(1, targetpath, ChangePathFrom) > 0 Then
sChangeTargetTo = ""
sChangePathTo = ""
'Set numerical length of full target path
VarLengthPath = Len(targetpath)
'Set numerical length of ChangePathFrom
VarLengthCPF = Len(ChangePathFrom)
'Find out what's between character 0 and where changepathfrom starts
VarBeginPath = InStr(1, targetpath, ChangePathFrom)
'Subtract 1 from where it begins (all text begins at 1 in a string)
'This is so you will have a '0' value if you type in a root drive or
'UNC to replace - there shouldn't be anything that appears before
''c:\' or '\\server' etc.
VarBeginPath = VarBeginPath - 1
'Parse actual text prior to search string to replace
BeginPath = Null
BeginPath = Left(targetpath, VarBeginPath)
'wscript.echo "VarBeginPath is: " & VarBeginPath & ". " & BeginPath
'Find out how many characters are left after subtracting the beginpath
'and search strings from the whole path
VarEndPath = VarLengthPath - (VarBeginPath + VarLengthCPF)
'Find out what text appears after the search string
EndPath = Right(targetpath, VarEndPath)
'wscript.echo EndPath
workingpath = link.workingdirectory
'Set variable to text before/search string/text after, so you get
'something like: c:\stuffbeforestring\mysearchstring\stuffafterstring
'or c:\temp\docs\mysearchstring\test.doc
sChangePathTo = BeginPath & ChangePathTo & EndPath
'wscript.echo "ChangePathTo is: " & ChangePathTo
'If there is no working directory, then text will show 'not set' during
'script execution
If workingpath = "" Then
workingpath = "not set"
End If
'if you are running in verbose mode, you will be prompted with
'each shortcut and working folder.
If Silent = 0 Then
MyVar = MsgBox ("Path contains " & Chr(34) & ChangePathFrom & "." & Chr(34) & ""_
& " LNK file's full target path is: "_
& targetpath & "." & " Working path is "_
& workingpath & ".",64, fullname)
End If
'Sometimes shortcuts don't have working dirs (not sure why)
'If there is a working dir, then run following code
If workingpath <> "not set" Then
VarBeginPath = InStr(1, workingpath, ChangePathFrom)
If VarBeginPath > 0 Then
VarBeginPath = VarBeginPath - 1
End If
'Parse actual text prior to search string to replace
BeginPath = Null
'wscript.echo "VarBeginPath " & VarBeginPath
BeginPath = Left(workingpath, VarBeginPath)
'wscript.echo "Working beginpath is: " & BeginPath
'Set numerical length of working directory
VarLengthWorking = Len(link.workingdirectory)
VarEndPath = VarLengthWorking - (VarBeginPath + VarLengthCPF)
'wscript.echo "Working path number count is: " & varlengthworking & ""_
'& VBCRLF & "working path end
'wscript.echo "VarEndPath = " & VarEndPath & " = " & VarLengthWorking & ""_
'& " - (" & VarBeginPath & " + " & VarLengthCPF & ")"
'Find out what text appears after the search string
If VarEndPath >= 0 Then
EndPath = Right(workingpath, VarEndPath)
sChangeTargetTo = BeginPath & ChangePathTo & EndPath
'wscript.echo "ChangeTargetTo is: " & sChangeTargetTo
WorkingMSG = "Also change working directory to " & sChangeTargetTo & "?"
End If
'wscript.echo "End of working folder :" & EndPath
Else
link.workingdirectory = ""
WorkingMSG = "No working directory will be set at this time."
End If
'wscript.echo "Path of shortcut is " & targetpath & ""_
'& VBCRLF & ". Working folder is " & workingpath & "."
'Display input box to modify each shortcut as the script finds them
If Silent = 0 Then
ModifyPath = InputBox ("Modifying " & fullname & "." & VBCRLF & ""_
& VBCRLF & "Modify path for " & targetpath & " "_
& "and replace with " & sChangePathTo & "?" & VBCRLF & VBCRLF & ""_
& WorkingMSG,""_
& "Type 'yes' to modify")
ElseIf Silent >= 1 Then
ModifyPath = "yes"
End If
If ModifyPath = "yes" Then
bgcolor = "#99CCFF"
'Set link target path attribute to
link.targetpath = Chr(34) & sChangePathTo & Chr(34)
newlink = link.targetpath
'wscript.echo newlink
If VarLengthWorking <> "" Then
'Set link working dir attribute to
' \\ChangePathToname\workingpath
link.workingdirectory = Chr(34) & sChangeTargetTo & Chr(34)
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
End if
'Clear link variable
MyPos = 0
MyPosEnd = 0
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 to write change history to logfile in outputfile path
'--------------------------------------------------------------------------
Function WriteEntry
If newlink <> "0" Then
w.WriteLine ("<TR bgcolor=" & Chr(34) & bgcolor & Chr(34) & ">")
w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
& oldfull & "</font></TD>")
w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
& oldlink & "</font></TD>")
w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
& newlink & "</font></TD>")
w.WriteLine ("</TR>")
oldfull = "0"
newlink = "0"
oldlink = "0"
bgcolor = "white"
End If
End Function
'----------------------------------------------------------------------------
'Function to see if outputfile already exists
'----------------------------------------------------------------------------
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment