Jump to content
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble

MSFN is made available via donations, subscriptions and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, register and become a site sponsor/subscriber and ads will be disabled automatically. 


  • Content count

  • Donations

  • Joined

  • Last visited

Community Reputation

0 Neutral

About danp129

  1. Here's a script I made for this. 'Filename: FindTarget.vbs 'Description: Simulates 'Find Target' button in shortcut properties dialog. 'Created by: Danp129 '@yahoo.com 'Usage: Double click FindTarget.vbs and click 'Yes' to register file. ' Right click a shortcut and click 'Find Target' ' If previous 'Find Target' context menu exists it can backup old ' setting to backup.txt in same path this file is executed from. option explicit Dim objShell, sAppPath, ret, sNewRegVal Const ForAppending = 8 Set objShell = CreateObject("WScript.Shell") sNewRegVal = "cscript /nologo """ & Wscript.ScriptFullName & """ ""%1""" sAppPath = Mid(Wscript.ScriptFullName, 1, InStrRev(Wscript.ScriptFullName, "\") - 1) if WScript.Arguments.count > 0 then 'Script was called from context menu call FindTarget else 'Script was not sent arguments, was likely double clicked on if sNewRegVal<>GetCurRegVal or isnull(GetCurRegVal) then 'Ask user if they wish to add Find Target context menu ret=msgbox("Register this file as your 'Find Target' handler?", vbYesNo, "Add 'Find Target' context menu?") if ret=vbYes then 'Call sub to create context menu using this file to handle requests call CreateContextMenu end if else msgbox "This file is already registered to handle 'Find Target' context menu." & vbcrlf & _ vbcrlf & "To use, simply right-click a shortcut and click 'Find Target'.", vbOKOnly, "Incorrect use" end if end if Set objShell = nothing Sub FindTarget() Dim sMainFile, sCmd, sArgs, sPath, arArgOverride, sArgOverride, i, fso, arTmp, sTmp 'Specify lower-case exe files to check if an argument exists ' and should attempt to browse to the argument if it's a ' valid path instead of executable 'Use pipe "|" to seperate files ' e.g. ("notepad.exe|anotherapp.exe") arArgOverride=split("notepad.exe") 'Shell command for explorer.exe sCmd = "explorer.exe /select," 'Main file the link refers to e.g. notepad.exe in 'c:\windows\notepad.exe c:\file.txt' sMainFile=lcase(CreateObject("WScript.Shell").CreateShortcut(WScript.Arguments(0)).TargetPath) 'Additional arguments in link e.g. c:\file.txt in 'notepad.exe c:\arg.txt' sArgs=CreateObject("WScript.Shell").CreateShortcut(WScript.Arguments(0)).Arguments 'Check to see if we should browse to arg if specified, if so set blnUseArg to true if sArgs <> "" then 'get filename only arTmp=split(smainfile, "\") sTmp=arTmp(ubound(arTmp)) 'Search override filenames for a match for i = 0 to ubound(arArgOverride) if sTmp=arArgOverride(i) then 'Create FSO object Set fso = CreateObject("Scripting.FileSystemObject") 'Remove quotes and leading spaces from args or fso.FileExists will fail sArgs=trim(replace(sArgs, """", "")) 'See if args is a valid path if fso.FileExists(sArgs) or fso.FolderExists(sArgs) then 'Use args for path sPath=sArgs end if exit for end if next 'iArgO 'Use main file if args was not a valid path if sPath="" then sPath=sMainFile else 'No arguments in the shortcut.. Use main file for path sPath=sMainFile end if 'Have Explorer open folder containing path objShell.Run sCmd & sPath set fso=nothing end sub sub CreateContextMenu() Dim sRegKey, fso, sBackupFile, oTextFile sBackupFile=sAppPath & "\" & "backup.txt" sRegKey = GetCurRegVal if not isnull(sRegKey) then 'Add some prompts to backup current value if sRegKey<>sNewRegVal and sRegKey<>"" then ret=msgbox("'Find Target' context menu already exists, would you like to backup the current setting before making changes?", vbYesNoCancel, "Backup current settings?") if ret=vbCancel then exit sub if ret=vbYes then 'Save current value to text file, append if backup already exists. Set fso = CreateObject("Scripting.FileSystemObject") set oTextFile = fso.OpenTextFile(sBackupFile, ForAppending, true) oTextFile.Writeline sRegKey oTextFile.Close set fso=nothing set oTextFile=nothing end if end if end if 'Write to registry objShell.RegWrite "HKCU\Software\Classes\lnkfile\Shell\Find Target\command\", sNewRegVal, "REG_SZ" end sub function GetCurRegVal on error resume next GetCurRegVal=objShell.RegRead("HKCU\Software\Classes\lnkfile\Shell\Find Target\command\") if err.number <> 0 then GetCurRegVal=null end if on error goto 0 end function