Option Explicit Const ATTRIBUTEREADONLY = 1 Const ATTRIBUTESYSTEM = 4 Const WINDOW_HANDLE = 0 Const FOLDERDIALOG_ONLYSELECT = 0 Const FOLDERDIALOG_WITHTEXT = &H10& Const MY_COMPUTER = &H11& dim shortdocu shortdocu = "Tool for repairing shortcuts (links) whose targets are located in a subtree that has been moved or copied to a new location." & vbcrlf shortdocu = shortdocu & "Usage:" & vbcrlf shortdocu = shortdocu & "1. Select the folder containing the LNK-files to be processed. (Do not select a system folder.)" & vbcrlf shortdocu = shortdocu & "2. Enter the name of an arbitrary LNK-file from the selected folder or the (relative or absolute) path of an arbitrary LNK-file from any location. (Do not enter the name or the path of a system file.)" & vbcrlf shortdocu = shortdocu & "3. Select the folder containing the target of the specified LNK-file. (Do not select a system folder.)" & vbcrlf shortdocu = shortdocu & "4. Unselect/select the 'all LNK-files' option." & vbcrlf shortdocu = shortdocu & "5. Unselect/select the 'recursive' option." & vbcrlf shortdocu = shortdocu & "In the default mode, the program first determines a string operation (exchanging a substring of minimum possible length at the beginning of the path) that transforms the target path of the specified LNK-file into the selected new target path. Then all LNK-files in the first selected folder are processed: if the target of an LNK-file does not exist, then the exchange operation is executed on the target path, and if the resulting target exists, then it becomes the new target of the LNK-file (and the folder of the new target becomes the new working directory of the LNK-file if this makes sense)." & vbcrlf shortdocu = shortdocu & "With the 'all LNK-files' option, the program tries to change the targets of all LNK-files (that is, even of those LNK-files whose current targets exist)." & vbcrlf shortdocu = shortdocu & "With the 'recursive' option, the program also processes recursively all subfolders of the first selected folder." & vbcrlf shortdocu = shortdocu & "Version: 1.1.2012. (c) M. Dom, 2010-2012. All rights reserved. http://www.mdom.de" Wscript.Echo shortdocu dim abortmsg abortmsg=" The program will abort. No LNK-file has been changed." dim objShellApplication Set objShellApplication = CreateObject("Shell.Application") dim objSelectFolder Set objSelectFolder = objShellApplication.Namespace(MY_COMPUTER) Set objSelectFolder = objSelectFolder.Self Set objSelectFolder = objShellApplication.BrowseForFolder(WINDOW_HANDLE, "Select the folder containing the LNK-files to be processed: (Do not select a system folder.)", FOLDERDIALOG_ONLYSELECT, objSelectFolder.Path) If objSelectFolder Is Nothing Then Wscript.Echo "No folder selected." & abortmsg Wscript.Quit End If Set objSelectFolder = objSelectFolder.Self dim folderpath, folderpathbsl folderpath = withoutbsl(objSelectFolder.Path) folderpathbsl = withbsl(folderpath) Set objSelectFolder = nothing dim strResult strResult = InputBox("Enter the name of an arbitrary LNK-file from '" & folderpath & "' or the path of an arbitrary LNK-file from any location: (Do not enter the name or the path of a system file.)", "Select LNK-File") if StrComp(strResult,"")=0 then Wscript.Echo "No file specified." & abortmsg Wscript.Quit end if dim selectedshortcutpath selectedshortcutpath = "" dim objSelectFSO Set objSelectFSO = CreateObject("Scripting.FileSystemObject") if StrComp(Right(strResult,4),".lnk",VBTEXTCOMPARE)<>0 then if objSelectFSO.FileExists(folderpathbsl & strResult & ".lnk") and not objSelectFSO.FileExists(folderpathbsl & strResult) then if msgbox("Do you mean the file '" & folderpathbsl & strResult & ".lnk'?",vbYesNo)=vbYes then selectedshortcutpath = folderpathbsl & strResult & ".lnk" end if end if if StrComp(selectedshortcutpath,"")=0 and StrComp(strResult,getfilename(strResult))<>0 then if objSelectFSO.FileExists(folderpathbsl & getfilename(strResult) & ".lnk") and not objSelectFSO.FileExists(folderpathbsl & getfilename(strResult)) then if msgbox("Do you mean the file '" & folderpathbsl & getfilename(strResult) & ".lnk'?",vbYesNo)=vbYes then selectedshortcutpath = folderpathbsl & getfilename(strResult) & ".lnk" end if end if end if if StrComp(selectedshortcutpath,"")=0 then if objSelectFSO.FileExists(strResult & ".lnk") and not objSelectFSO.FileExists(strResult) then if msgbox("Do you mean the file '" & strResult & ".lnk'?",vbYesNo)=vbYes then selectedshortcutpath = strResult & ".lnk" end if end if end if if StrComp(selectedshortcutpath,"")=0 then Wscript.Echo "The specified file '" & strResult & "' is no LNK-file." & abortmsg Wscript.Quit end if else if objSelectFSO.FileExists(folderpathbsl & strResult) then if msgbox("Do you mean the file '" & folderpathbsl & strResult & "'?",vbYesNo)=vbYes then selectedshortcutpath = folderpathbsl & strResult end if end if if StrComp(selectedshortcutpath,"")=0 and StrComp(strResult,getfilename(strResult))<>0 then if objSelectFSO.FileExists(folderpathbsl & getfilename(strResult)) then if msgbox("Do you mean the file '" & folderpathbsl & getfilename(strResult) & "'?",vbYesNo)=vbYes then selectedshortcutpath = folderpathbsl & getfilename(strResult) end if end if end if if StrComp(selectedshortcutpath,"")=0 then if objSelectFSO.FileExists(strResult) then if msgbox("Do you mean the file '" & strResult & "'?",vbYesNo)=vbYes then selectedshortcutpath = strResult end if end if end if if StrComp(selectedshortcutpath,"")=0 then Wscript.Echo "The specified file '" & strResult & "' cannot be found." & abortmsg Wscript.Quit end if end if Set objSelectFSO = nothing Set objSelectFolder = objShellApplication.Namespace(MY_COMPUTER) Set objSelectFolder = objSelectFolder.Self Set objSelectFolder = objShellApplication.BrowseForFolder(WINDOW_HANDLE, "Select the folder containing the target of the selected LNK-file: (Do not select a system folder.)", FOLDERDIALOG_ONLYSELECT, objSelectFolder.Path) If objSelectFolder Is Nothing Then Wscript.Echo "No folder selected." & abortmsg Wscript.Quit End If Set objSelectFolder = objSelectFolder.Self dim repairfolderpath, repairfolderpathbsl repairfolderpath = withoutbsl(objSelectFolder.Path) repairfolderpathbsl = withbsl(repairfolderpath) Set objSelectFolder = nothing Set objShellApplication = nothing dim changeall if msgbox("Try to change only the targets of those LNK-files whose current targets do not exist? (Selecting 'No' means: try to change all targets.)",vbYesNo)=vbNo then if msgbox("Try to change all targets: Are you sure?",vbYesNo)<>vbYes then Wscript.Echo "Selection not confirmed." & abortmsg Wscript.Quit else changeall=true end if else changeall=false end if dim recursive if msgbox("Process only the LNK-files in '" & folderpath & "'? (Selecting 'No' means: also process recursively all subfolders.)",vbYesNo)=vbNo then if msgbox("Also process recursively all subfolders: Are you sure?",vbYesNo)<>vbYes then Wscript.Echo "Selection not confirmed." & abortmsg Wscript.Quit else recursive=true end if else recursive=false end if dim objShell Set objShell = CreateObject("WScript.Shell") dim selectedshortcut Set selectedshortcut = objShell.CreateShortcut(selectedshortcutpath) dim oldtargetfolderpath, oldtargetfolderpathbsl oldtargetfolderpath = getfolderpath(selectedshortcut.TargetPath) oldtargetfolderpathbsl = withbsl(oldtargetfolderpath) Set selectedshortcut = nothing dim oldtargetfolderpathbsllen, repairfolderpathbsllen oldtargetfolderpathbsllen = len(oldtargetfolderpathbsl) repairfolderpathbsllen = len(repairfolderpathbsl) dim minlen if repairfolderpathbsllen<=oldtargetfolderpathbsllen then minlen=repairfolderpathbsllen else minlen=oldtargetfolderpathbsllen end if dim throwawaypart, newpart dim identicallen, testlen dim breakloop identicallen=0 breakloop=false do if identicallenthrowawaypartlen then if StrComp(Left(targetpath,throwawaypartlen),throwawaypart,VBTEXTCOMPARE)=0 then repairtargetpath = newpart & mid(targetpath,throwawaypartlen+1) If objFSO.FolderExists(repairtargetpath) or objFSO.FileExists(repairtargetpath) Then if (file.attributes and ATTRIBUTEREADONLY)<>0 then if recursive then Wscript.Echo "The LNK-file '" & shortcutpath & "' is read-only." & abortmsg else Wscript.Echo "The LNK-file '" & getfilename(shortcutpath) & "' is read-only." & abortmsg end if Wscript.Quit end if end if end if end if end if Set shortcut = nothing End If End If Next set objAllfiles = nothing if recursive then dim objAllsubfolders Set objAllsubfolders = objFolder.Subfolders dim subfolder For Each subfolder in objAllsubfolders If (subfolder.attributes and ATTRIBUTESYSTEM)=0 then preprocessdirectory subfolder, throwawaypart, changeall, true, objFSO, objShell, abortmsg End If Next Set objAllsubfolders = nothing end if end sub sub processdirectory(objFolder, throwawaypart, newpart, changeall, recursive, objFSO, objShell) dim objAllfiles Set objAllfiles = objFolder.Files dim throwawaypartlen throwawaypartlen=len(throwawaypart) dim file dim extension dim shortcutpath dim shortcut dim targetpath dim repairtargetpath For Each file in objAllfiles If (file.attributes and ATTRIBUTESYSTEM)=0 then extension = objFSO.GetExtensionName(LCase(file.name)) If extension = "lnk" then shortcutpath = objFSO.GetAbsolutePathName(file) Set shortcut = objShell.CreateShortcut(shortcutpath) targetpath = shortcut.TargetPath If changeall or (not objFSO.FolderExists(targetpath) and not objFSO.FileExists(targetpath)) Then if len(targetpath)>throwawaypartlen then if StrComp(Left(targetpath,throwawaypartlen),throwawaypart,VBTEXTCOMPARE)=0 then repairtargetpath = newpart & mid(targetpath,throwawaypartlen+1) If objFSO.FolderExists(repairtargetpath) or objFSO.FileExists(repairtargetpath) Then shortcut.TargetPath = repairtargetpath if StrComp(withoutbsl(shortcut.WorkingDirectory), getfolderpath(targetpath), VBTEXTCOMPARE)=0 then shortcut.WorkingDirectory = getfolderpath(repairtargetpath) end if shortcut.save end if end if end if end if Set shortcut = nothing End If End If Next set objAllfiles = nothing if recursive then dim objAllsubfolders Set objAllsubfolders = objFolder.Subfolders dim subfolder For Each subfolder in objAllsubfolders If (subfolder.attributes and ATTRIBUTESYSTEM)=0 then processdirectory subfolder, throwawaypart, newpart, changeall, true, objFSO, objShell End If Next Set objAllsubfolders = nothing end if end sub function withbsl (folderpathOrFoldername) if isnull(folderpathOrFoldername) then withbsl=null elseif StrComp(folderpathOrFoldername,"")=0 then withbsl="" elseif StrComp(Right(folderpathOrFoldername,1),"\")=0 then withbsl=folderpathOrFoldername else withbsl=folderpathOrFoldername & "\" end if end function function withoutbsl (folderpathOrFoldername) if isnull(folderpathOrFoldername) then withoutbsl=null elseif StrComp(folderpathOrFoldername,"")=0 then withoutbsl="" elseif StrComp(Right(folderpathOrFoldername,1),"\")=0 then withoutbsl=left(folderpathOrFoldername,len(folderpathOrFoldername)-1) else withoutbsl=folderpathOrFoldername end if end function function getfolderpath (filepath) if isnull(filepath) then getfolderpath=null exit function end if dim myfilepath myfilepath=withoutbsl(filepath) dim bslpos, nextbslpos bslpos=0 do nextbslpos=InStr(bslpos+1,myfilepath,"\") If nextbslpos>0 Then bslpos=nextbslPos loop until nextbslpos=0 if bslpos>0 then getfolderpath = left(myfilepath,bslPos-1) else ' cannot happen? getfolderpath="" end if end function function getfilename (filepathOrFilename) if isnull(filepathOrFilename) then getfilename=null exit function end if dim myfilepathOrFilename myfilepathOrFilename=withoutbsl(filepathOrFilename) dim bslpos, nextbslpos bslpos=0 do nextbslpos=InStr(bslpos+1,myfilepathOrFilename,"\") If nextbslpos>0 Then bslpos=nextbslPos loop until nextbslpos=0 if bslpos>0 then getfilename = mid(myfilepathOrFilename,bslPos+1) else getfilename = myfilepathOrFilename end if end function