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