This VB6 project and VBScript file provides functionality similar to Windows Vista & 7's "Open file location" context menu for pre-Vista OSes. In Vista & 7, shortcut files have a handy context menu option, that upon clicking, pre-selects that shortcut's target in a new Explorer window. The VB6 project is fully Unicode-aware, capable of accepting Unicode filenames for shortcuts and their targets. It can also deal with Advertised shortcuts. The VBScript file requires an enabled Microsoft Windows Script Host (wscript.exe). To install or uninstall, just open either of the two files without passing any command line parameter. Shown below is the code for the VBScript file.
Attachment 93817
Code:
Option Explicit
Private Const sKEY = "HKCU\Software\Classes\lnkfile\shell\OpenFileLocation\"
'Placing this under HKLM\SOFTWARE\Classes\lnkfile
'enables all user profiles to have this context menu.
Private Const sVALUE = "Open &file location"
'&f immediately selects this menu unlike the default
'&i in Vista which collides with "P&in to Start menu".
Private Const sCMD = "wscript.exe %WINDIR%\OpenFileLocation.vbs ""%1"""
'Save this in a file named "OpenFileLocation.vbs" in the
'"\WINDOWS" directory, or if preferred otherwise, edit
'the location & filename in this constant.
Private Const OFL = "OpenFileLocation"
Private Const CMD = "command\"
Private WSH
Set WSH = WScript.CreateObject("WScript.Shell")
If WScript.Arguments.Count Then 'If arguments were passed to this file, Then
OpenFileLocation ' a shortcut file's location was specified
Else 'Else, no arguments were passed
InstallUninstallOFL ' go to Install/Uninstall mode
End If
Set WSH = Nothing 'Destroy object
Private Sub OpenFileLocation
Dim FSO, oShortcut, sFileSpec, sTarget
On Error Resume Next
'Get the shortcut file's location
sFileSpec = WScript.Arguments(0)
'Instantiate a Shortcut Object
Set oShortcut = WSH.CreateShortcut(sFileSpec)
'Retrieve the shortcut's target
sTarget = oShortcut.TargetPath
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
'If the shortcut points to an existing file or folder
If FSO.FileExists(sTarget) Then
'Pre-select that target in a new Explorer window
WSH.Run "explorer.exe /select,""" & sTarget & """"
ElseIf FSO.FolderExists(sTarget) Then
'Short-circuit the preceding expressions instead of using Or
WSH.Run "explorer.exe /select,""" & sTarget & """"
Else 'complain, er, inform if it's missing
WSH.Popup "Could not find:" & vbNewLine & vbNewLine & _
"""" & sTarget & """", , OFL, vbExclamation
End If
Set FSO = Nothing
Set oShortcut = Nothing 'Destroy objects
End Sub
Private Sub InstallUninstallOFL 'Install/Uninstall mode
Dim iButtons, sPrompt
iButtons = vbYesNoCancel Or vbQuestion Or vbDefaultButton3
sPrompt = "Do you want to add the ""Open file location"" context menu " & _
"option to shortcut files?" & vbNewLine & "(Select NO to remove)"
Select Case MsgBox(sPrompt, iButtons, "Install " & OFL & ".vbs")
Case vbYes: InstallOFL
Case vbNo: UninstallOFL
End Select
End Sub
Private Sub InstallOFL 'Adds the context menu entries to the Registry
On Error Resume Next
WSH.RegWrite sKEY, sVALUE, "REG_SZ"
WSH.RegWrite sKEY & CMD, sCMD, "REG_EXPAND_SZ"
If Err Then
MsgBox Err.Description, vbCritical, Err.Source
Else
MsgBox "Installed successfully!", vbInformation, OFL
End If
End Sub
Private Sub UninstallOFL 'Removes the context menu entries from the Registry
On Error Resume Next
WSH.RegDelete sKEY & CMD
WSH.RegDelete sKEY
If Err Then
MsgBox Err.Description, vbCritical, Err.Source
Else
MsgBox "Uninstalled successfully!", vbInformation, OFL
End If
End Sub