Association Handlers Demo
![]()
IAssocHandler | IEnumAssocHandlers | IAssocHandlerInvoker
Windows Vista and above provider a shell interface to get a list of all handlers registered to open a particular file type that also returns where the icon is and what the friendly name is. Most importantly, it provider an interface to invoke that handler in a much better way than trying to make a command to launch it.
These things were just crying out to be made into an example of how to replicate the Open With menu in VB. There's even two groups: the recommended ones that show up on that menu in Explorer, or if so inclined you could list all the ones that appear on the actual Open With dialog.
Requirements
The project uses the newest version of oleexp.tlb, my Modern Interfaces Type Library project, which is a large expansion of the original olelib. The latest versions of both of those must be referenced, see the link for more details.
Ambition is also a bit of a requirement... using the invoker (which you don't have to) involves getting deep into IShellFolder and pidls, and there's a lot of supporting code.
Basic Outline
SHAssocEnumHandlers is called to get an object that can enumerate all the handlers for the extension passed- IEnumAssocHandlers.
That object lists IAssocHandler interfaces for each handler, and in the demo project we use the information provided by that to list them on a menu.
When one is chosen, the handlers are cycled through again to find the desired one to launch- it's here that we need some complex stuff like IShellFolder and IDataObject.
Main Code
Code:
Dim sFile As String
Dim sExt As String
Dim nIcoIdx As Long
Dim MII() As MENUITEMINFO
Dim miiZ As MENUITEMINFO
Dim uRec() As AssocInfo
Dim i As Long, j As Long, k As Long
Dim ieah As IEnumAssocHandlers
Dim iah As IAssocHandler
Dim hr As Long
Dim lPtr As Long
Dim sApp As String
Dim sIcon As String
Dim hIcon As Long
Dim hBmp As Long
Dim PT As POINTAPI
Dim idCmd As Long
Dim hMenu As Long
Const widBase As Long = 1000
Const sCP As String = "Choose program..."
j = -1
ReDim MII(0)
ReDim uRec(0)
sFile = Text1.Text
sExt = Right(sFile, Len(sFile) - InStrRev(sFile, ".") + 1)
'First, we use an API call to get the object that will list the handlers
'The other flag value will show all handlers- the recommended ones are the
'ones that show up in Explorer's right click open-with menu
hr = SHAssocEnumHandlers(StrPtr(sExt), ASSOC_FILTER_RECOMMENDED, ieah)
If hr <> S_OK Then Exit Sub
'now we're ready to start enumerating the handlers, in this project
'we're going to load them into a popup menu
hMenu = CreatePopupMenu()
'Most IEnum______ classes work exactly like this. .Next fills the IAssocHandler iface
Do While (ieah.Next(1, iah, 0) = 0)
If (iah Is Nothing) = False Then
j = j + 1
ReDim Preserve MII(j)
ReDim Preserve uRec(j) 'in case we need the info later
Call iah.GetUIName(lPtr) 'can't receive a LPWSTR As String like sending it
sApp = BStrFromLPWStr(lPtr)
uRec(j).sUIName = sApp
Call iah.GetName(lPtr)
sApp = BStrFromLPWStr(lPtr)
uRec(j).sPath = sApp
Call iah.GetIconLocation(lPtr, i)
sIcon = BStrFromLPWStr(lPtr)
uRec(j).sIcon = sIcon
uRec(j).nIcon = i
'association interface includes icon info for our menu
Call ExtractIconEx(sIcon, i, ByVal 0&, hIcon, 1)
hBmp = HBitmapFromHIcon(hIcon, 16, 16) 'can't use hIcon directly
With MII(j)
.cbSize = Len(MII(j))
.fMask = MIIM_ID Or MIIM_STRING Or MIIM_BITMAP
.wID = widBase + j
.cch = Len(uRec(j).sUIName)
.dwTypeData = uRec(j).sUIName
.hbmpItem = hBmp
Call InsertMenuItem(hMenu, j, True, MII(j))
Call DestroyIcon(hIcon)
End With
Else
Debug.Print "iah=Nothing"
End If
Set iah = Nothing
Loop
'Add separator and open with other
miiZ.cbSize = Len(miiZ)
miiZ.fMask = MIIM_ID Or MIIM_TYPE
miiZ.fType = MFT_SEPARATOR
miiZ.wID = 9999
Call InsertMenuItem(hMenu, -1, False, miiZ)
miiZ.fMask = MIIM_ID Or MIIM_STRING
miiZ.wID = 3000
miiZ.cch = Len(sCP)
miiZ.dwTypeData = sCP
Call InsertMenuItem(hMenu, -1, False, miiZ)
Call GetCursorPos(PT)
PT.y = PT.y + 5
idCmd = TrackPopupMenu(hMenu, TPM_LEFTBUTTON Or TPM_RIGHTBUTTON Or TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_HORIZONTAL Or TPM_RETURNCMD, PT.x, PT.y, 0, Me.hWnd, 0)
Set ieah = Nothing
If idCmd Then
If idCmd = 3000 Then
OpenWith Text1.Text, OAIF_ALLOW_REGISTRATION Or OAIF_EXEC, Me.hWnd
Else
k = idCmd - widBase
' MsgBox "Handler selected: " & uRec(k).sUIName & vbCrLf & _
' uRec(k).sPath & vbCrLf & _
' "Icon=" & uRec(k).sIcon & "," & uRec(k).nIcon, _
' vbOKOnly, App.Title
'
'i know.. pidl and ishellfolder stuff is confusing, but there's no other way
Dim isf As IShellFolder
Dim pidl As Long, pidlFQ As Long
Dim zc As Long
pidlFQ = PathToPidl(sFile)
pidl = GetPIDLParent(pidlFQ)
Set isf = GetIShellFolder(isfDesktop, pidl)
Dim pidlChild As Long
pidlChild = GetItemID(pidlFQ, GIID_LAST)
'Now that we have the pidl and shellfolder representing our file, we create
'an IDataObject for it, then re-enumerate the handlers- we still have the
'selected one stored in k. it may be possible to just have an array to avoid
'the reenumeration
Dim ido As olelib.IDataObject
Call isf.GetUIObjectOf(0, 1, pidlChild, IID_IDataObject, 0, ido)
Dim invk As IAssocHandlerInvoker
hr = SHAssocEnumHandlers(StrPtr(sExt), ASSOC_FILTER_RECOMMENDED, ieah)
Do While (ieah.Next(1, iah, 0) = 0)
If (iah Is Nothing) = False Then
If zc = k Then
'theoretically, we could take the path to the executable and
'run a launch command, but the actual invoke interfacer is a
'far better choice
Call iah.CreateInvoker(ido, invk)
invk.Invoke
Exit Do
Else
zc = zc + 1
End If
End If
Set iah = Nothing
Loop
End If
End If
If pidlFQ Then CoTaskMemFree pidlFQ
If pidl Then CoTaskMemFree pidl
If pidlChild Then CoTaskMemFree pidlChild
Set ido = Nothing
Set isf = Nothing
Set invk = Nothing
Set iah = Nothing
Set ieah = Nothing
End SubIncluded in ZIP
-All the core and supporting code required to generate a menu like that in the picture.
-The latest versions of oleexp.tlb and olelib.tlb (v1.5 and v1.91 respectively; this version or better is required). TLB files only, for full source visit the main oleexp project thread.
Future Goals
This is the very first release, and I do plan on trying to simplify things a bit as well as test out Unicode support. Please report any and all bugs so they can be fixed in the next version.