[VB6, VBS] Open File Location

Attachment 93817

This VB6 project and VBScript file provides functionality similar to Windows Vista & 7's "Open file location" context menu for pre-Vista OSs. In Vista & 7, shortcut files have a handy context menu option, that upon clicking, preselects 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 the VBS or EXE file, just open either of the two files without passing any command line parameter. Shown below is the code for the VBS file.

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



---