File Verbs - EXE System Shortcut Menu Items

Do Verbs

This article describes how to do the verbs of certain files. These verbs appear as menu items, when a user Right-Clicks on a file.

The most noteworthy verb that can be performed on an executable file, is called, Run as administrator. It can be used to elevate administrative privileges from a "standard" access token, to a "full" token. This is perhaps the most reliable way to elevate any application. It also makes sense that programmatic functions should be provided when a user would be able perform similar actions.

Another interesting verb called "Pin to Taskbar" has been disabled by microsoft, so that programs can't pin themselves anymore. However, a simple vbscript can be created and invoked from VB, to perform the desired verb anyways. You should actually pin shortcuts to the "taskbar" and "start menu", not executables themselves, because the behavior may vary in several ways.

This example uses the ShellExecute API to start a vbscript file that has been created with custom parameters. You will need 2 TextBoxes, 1 ComboBox, and 1 Button.

Private Declare Function apiShellExecute Lib _
"shell32" Alias "ShellExecuteA" _
(ByVal hwnd As Int32, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Int32) As Int32

When the programs loads, we set some default parameters that point to this current executable.

Private Sub frmDoVerb_Load _
(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.Load

    txtFolder.Text = CurDir()
    txtFile.Text = _
    Process.GetCurrentProcess.ProcessName & ".exe"
    GetVerbs()
End Sub

In this case the button down event is a good place to do the verb, so that we can use the button up event to get any new verbs. There may be new verbs to pin/unpin a program etc.

Private Sub btnDo_Down _
(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles btnDo.MouseDown

    DoVerb(txtFolder.Text, txtFile.Text, cmbVerb.Text)
End Sub

I like to just start a new thread to make sure there is enough time for any new verbs to appear on the list.

Private Sub btnDo_Up _
(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles btnDo.MouseUp

    'get any new verbs,ie unpin
    Dim gv As New Threading.Thread _
    (AddressOf GetNewVerbs)
    gv.Start()
End Sub

If the user changes the folder or file, we should update any new verbs, if the file actually exists.

Private Sub txtFileFolder_TextChanged _
(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles txtFolder.TextChanged, _
txtFile.TextChanged

    If IO.File.Exists _
    (txtFolder.Text & "\" & txtFile.Text) _
    = True Then
        GetVerbs()
    End If
End Sub

This is the thread to update the list of current verbs.

Private Sub GetNewVerbs()
    Threading.Thread.Sleep(800)
    GetVerbs()
End Sub

This is the main function that creates a vbscript file, and then opens it with ShellExecute.

Private Function DoVerb _
(ByVal dirName As String, _
ByVal filName As String, _
ByVal sVerb As String) As Integer
    On Error Resume Next

    'If blank assume this current directory
    If dirName = "" Then dirName = CurDir()

    'Create a new vbscript file and name it the verb
    FileOpen(1, sVerb.Replace("&", "") & ".vbs", _
    OpenMode.Output, , OpenShare.Shared)
    'Print out the scripts contents
    PrintLine(1, _
    "On Error Resume Next")
    PrintLine(1, _
    "Set objShell = CreateObject(" & Chr(34) & _
    "Shell.Application" & Chr(34) & ")")
    PrintLine(1, _
    "Set objFolder = objShell.Namespace(" & _
    Chr(34) & dirName & Chr(34) & ")")
    PrintLine(1, _
    "Set objFolderItem = objFolder.ParseName(" & _
    Chr(34) & filName & Chr(34) & ")")
    PrintLine(1, _
    "Set objVerbs = objFolderItem.verbs")
    PrintLine(1, _
    "For Each objVerb In objVerbs")
    PrintLine(1, _
    "If LCase(RePlace(objVerb.Name, " & _
    Chr(34) & Chr(38) & Chr(34) & ", " & Chr(34) & _
    Chr(34) & ")) = " & Chr(34) & _
    LCase(Replace(sVerb, "&", "")) & Chr(34) & " Then")
    PrintLine(1, "objVerb.DoIt")
    PrintLine(1, "End If")
    PrintLine(1, "Next")
    FileClose(1)
    'Give the script a moment to exist
    For i As Int32 = 1 To 20
        Threading.Thread.Sleep(100)
        If IO.File.Exists _
        (sVerb.Replace("&", "") & ".vbs") = True Then
            Exit For
        End If
    Next
    'If it was not created then abort function
    If IO.File.Exists _
    (sVerb.Replace("&", "") & ".vbs") = False Then
        Exit Function
    End If
    Threading.Thread.Sleep(100)
    'Open script with ShellExecute in the directory
    DoVerb = apiShellExecute _
    (0, "open", sVerb.Replace("&", "") & ".vbs", _
    vbNullString, dirName, 1)
End Function

Finally, the function to get the verbs of a file, will need a COM reference to: "Windows Script Host Object Model"

Private Function GetVerbs() As String
    On Error Resume Next
    Dim objShell, objFolder As Object
    Dim objFolderItem, objVerb As Object
    Dim objVerbs As Collections.IEnumerable
    Dim objItem As String
    GetVerbs = ""
    objShell = CreateObject("Shell.Application")
    objFolder = objShell.Namespace(CurDir)
    objFolderItem = objFolder.ParseName(txtFile.Text)
    objVerbs = CType _
    (objFolderItem.verbs, Collections.IEnumerable)
    cmbVerb.Items.Clear()
    For Each objVerb In objVerbs
        objItem = Replace _
        (objVerb.Name.ToString, "&", "")
        'Ignore verbs that cannot be scripted
        If objItem <> "" _
        AndAlso objItem <> "Properties" _
        AndAlso objItem <> "Cut" _
        AndAlso objItem <> "Copy" _
        AndAlso objItem <> "Paste" _
        AndAlso objItem <> "Rename" _
        AndAlso objItem <> "Send To" _
        Then
            'Add verbs to list and combo
            GetVerbs &= objItem & vbCrLf
           cmbVerb.Items.Add(objItem)
        End If
    Next
    'Set the combobox to run as administrator
    If cmbVerb.Items.Count > 0 Then
       cmbVerb.SelectedIndex = 1
    End If
End Function

If you are still experiencing problems with Pinning a certain program to the taskbar, it may have blacklisted strings within it's name. For more information: Can't pin a program to the taskbar?

Here is the same example in VB6.0.

Const CSIDL_SYSTEM As Long = &H25
Private Declare Function apiShellExecute Lib _
"shell32" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Declare Function apiSleep Lib _
"kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long) As Boolean

Private Declare Function apiFileExists Lib _
"shlwapi" Alias "PathFileExistsA" _
(ByVal pszPath As String) As Boolean

Private Sub Form_Load()
   txtFolder.Text = CurDir
   txtFile.Text = App.EXEName & ".exe"
   Call GetVerbs
End Sub

Private Sub cmdGetVerbs_Click()
   Call GetVerbs
End Sub

Private Sub cmdDo_Click()
   Call DoVerb _
   (txtFolder.Text, txtFile.Text, cmbVerb.Text)
End Sub

Private Sub txtFile_Change()
    If apiFileExists _
    (txtFolder.Text & "\" & txtFile.Text) _
     = True Then
        Call GetVerbs
    End If
End Sub

Private Sub txtFolder_Change()
    If apiFileExists _
    (txtFolder.Text & "\" & txtFile.Text) _
     = True Then
        Call GetVerbs
    End If
End Sub

'Add a COM referenct to:
' Windows Script Host Object Model
Private Function GetVerbs() As String
    On Error Resume Next
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
    Dim objVerb As Object
    Dim objVerbs As Object
    Dim objItem As String
    GetVerbs = ""
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(CurDir)
    Set objFolderItem = objFolder.ParseName(txtFile.Text)
    Set objVerbs = objFolderItem.verbs
    'Clear the previous combobox contents
    cmbVerb.Clear
    For Each objVerb In objVerbs
       objItem = Replace _
       (CStr(objVerb.Name), "&", "")

        'Ignore verbs that cannot be scripted
        If objItem <> "" _
        And objItem <> "Properties" _
        And objItem <> "Cut" _
        And objItem <> "Copy" _
        And objItem <> "Paste" _
        And objItem <> "Rename" _
        And objItem <> "Send To" _
        Then
        
            'Add verbs to list and combo
            GetVerbs = GetVerbs & objItem & vbCrLf
            cmbVerb.AddItem (objItem)
        End If
    Next
    
    'Set the combobox to run as administrator
    If cmbVerb.ListCount > 0 Then
      cmbVerb.ListIndex = 1
    End If
End Function

Private Function DoVerb _
(ByVal dirName As String, _
ByVal filName As String, _
ByVal sVerb As String) As Long
  On Error Resume Next
  
   'If blank assume this current directory
  If dirName = "" Then dirName = CurDir
  
  'Create a new vbscript file and name it the verb
  Open Replace(sVerb, "&", "") & ".vbs" For Output Shared As #1
  Print #1, "Set objShell = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
  Print #1, "Set objFolder = objShell.Namespace(" & Chr(34) & dirName & Chr(34) & ")"
  Print #1, "Set objFolderItem = objFolder.ParseName(" & Chr(34) & filName & Chr(34) & ")"
  Print #1, "Set objVerbs = objFolderItem.verbs"
  Print #1, "For Each objVerb In objVerbs"
  Print #1, "If LCase(RePlace(objVerb.Name, " & Chr(34) & Chr(38) & Chr(34) & ", " & _
  Chr(34) & Chr(34) & ")) = " & Chr(34) & LCase(Replace(sVerb, "&", "")) & Chr(34) & " Then"
  Print #1, "objVerb.DoIt"
  Print #1, "End If"
  Print #1, "Next"
  Close #1
  
  'Give it a moment to exist
  apiSleep (100)
  If apiFileExists _
  (Replace(sVerb, "&", "") & ".vbs") = False Then
     apiSleep (400)
  End If
  
  'If file did not exist in a reasonable time then exit
  If apiFileExists _
  (Replace(sVerb, "&", "") & ".vbs") = False Then
     Exit Function
  End If
  apiSleep (100)
  
  'Shell the vbscript
  DoVerb = apiShellExecute _
  (0, "open", Replace(sVerb, "&", "") & ".vbs", _
  vbNullString, dirName, 1)
End Function