[VB6] Adding Custom Tasks and Items to the Jump List (Taskbar Right-click)

[fafalone]

cJump v1.0
Adding to the Jump List with ICustomDestinationList

This project has been a long time coming. Started working on porting a C++ example to VB6 way back in 2014, and wasn't able to get it working despite many many hours playing around with interface definitions. Had tons of hope when Olaf was able to get things working using vbRichClient5 (see this thread). But of course I wanted to use the interfaces through oleexp rather than RC5. Simply changing out the calls in his project still left things not working, and I had tons of frustration as I'd spend countless hours, give up, and revisit and repeat over the years. Today I found the problem; I re-did the conversion, only this time included the class, and it worked. So more hours and hours thinking it needed to be done from a class, until I traced it to a single call and single problem: I had declared an API call wrong, and had copy/pasted the right version into the class. That's that held this all up for 5 years and countless hours trying to figure out the problem.

When you click on one of the items, it launches a new instance of your app with the information on what was clicked passed through the command line, retrieved with the Command$() function in VB. Note that this means nothing will happen if you click an item without having compiled an exe first (and I get an error clicking an item from the IDE in the new instance, but it works fine when compiled). You can then handle the command in any number of ways; have the new instance perform the task, or use various IPC methods to notify the first instance of your app and then exit before loading anything (note that this it not shown in the demo, the demo just creates a block for a non-empty command line).

Requirements
Windows 7 or newer
oleexp v4.5 or higher (Released 01 Aug 2018)
(Older oleexp versions *might* work with or without slight changes, but I had been playing around with the interfaces quite a bit trying to get them to work, so I'm not sure which versions work, which versions don't, or which versions need the calls to be different)

Code

Using oleexp allows simplifying things quite a bit, here's the class:

Option Explicit
'cJump v1.0: Using Jump Lists in VB6
'by fafalone
'
'Requires oleexp.tlb v4.5 or higher

'This is a version of Olaf's demonstration class of doing this with vbRichClient5, to use
'the relavent interfaces through oleexp instead

Private Declare Function SetCurrentProcessExplicitAppUserModelID Lib "shell32" (ByVal psID As Long) As Long 'NOT STRING NOT STRING NOT STRING

Private pCDL As ICustomDestinationList

Public Function InitList(sAppID As String, Optional nMinSlot As Long) As IObjectArray
SetCurrentProcessExplicitAppUserModelID StrPtr(sAppID)
Set pCDL = New DestinationList
pCDL.SetAppID StrPtr(sAppID)
pCDL.BeginList nMinSlot, IID_IObjectArray, InitList
End Function
 
Public Sub AddToList(pList As oleexp.IObjectCollection, Optional sTitle As String, Optional sArgs As String, Optional sToolTip As String, Optional ByVal nIconID As Long)
Dim hr As Long
Dim pLink As ShellLinkW
Dim pStore As IPropertyStore

Set pLink = New ShellLinkW
pLink.SetPath App.Path & "\" & App.EXEName & ".exe"
pLink.SetArguments sArgs
pLink.SetDescription sToolTip
pLink.SetIconLocation "imageres.dll", -nIconID
  
hr = pLink.QueryInterface(IID_IPropertyStore, pStore)

If sTitle <> "" Then
    Dim vTitle As Variant
    vTitle = CVar(sTitle)
    pStore.SetValue PKEY_Title, vTitle
    pStore.Commit
Else
    pStore.SetValue PKEY_AppUserModel_IsDestListSeparator, CVar(True)
    pStore.Commit
End If

pList.AddObject ByVal ObjPtr(pLink)
End Sub


Public Sub AddUserTasks(pList As IObjectCollection)
pCDL.AddUserTasks ByVal ObjPtr(pList)
End Sub

Public Sub AppendCategory(sCat As String, pList As IObjectCollection)
pCDL.AppendCategory ByVal StrPtr(sCat), ByVal ObjPtr(pList)
End Sub

Public Sub AbortList()
pCDL.AbortList
End Sub

Public Sub CommitList()
pCDL.CommitList
End Sub

'-------------------
'You can remove the following if you have mIID.bas in your project
Private Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
  With Name
    .Data1 = L
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
End Sub
Private Function IID_IObjectArray() As UUID
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H92CA9DCD, CInt(&H5622), CInt(&H4BBA), &HA8, &H5, &H5E, &H9F, &H54, &H1B, &HD8, &HC9)
  IID_IObjectArray = iid
End Function
Private Function IID_IPropertyStore() As UUID
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H886D8EEB, CInt(&H8CF2), CInt(&H4446), &H8D, &H2, &HCD, &HBA, &H1D, &HBD, &HCF, &H99)
  IID_IPropertyStore = iid
End Function
'End of mIID.bas section
'-----------------------------

'-----------------------------
'You can remove the following if you have mPKEY.bas in your project
Private Sub DEFINE_PROPERTYKEY(Name As PROPERTYKEY, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte, pid As Long)
  With Name.fmtid
    .Data1 = L
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
  Name.pid = pid
End Sub
Private Function PKEY_Title() As PROPERTYKEY
Static pkk As PROPERTYKEY
 If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &HF29F85E0, &H4FF9, &H1068, &HAB, &H91, &H8, &H0, &H2B, &H27, &HB3, &HD9, 2)
PKEY_Title = pkk
End Function
Private Function PKEY_AppUserModel_IsDestListSeparator() As PROPERTYKEY
Static pkk As PROPERTYKEY
 If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &H9F4C2855, &H9F79, &H4B39, &HA8, &HD0, &HE1, &HD4, &H2D, &HE1, &HD5, &HF3, 6)
PKEY_AppUserModel_IsDestListSeparator = pkk
End Function
'End of mPKEY.bas section
'---------------------------

I've included the relevant sections of mIID and mPKEY in the class so those are not required.

Using it is pretty simple, again this is pretty much just a conversion of Olaf's version:

Public cJL As New cJump
Private Sub CreateJumpList(sID As String)
cJL.InitList sID
  
Dim MyCat As New EnumerableObjectCollection
cJL.AddToList MyCat, "Item 1", "/cat /arg1", "ToolTip 1", 14
cJL.AddToList MyCat, "Item 2", "/cat /arg2", "ToolTip 2", 23
cJL.AppendCategory "Custom Category", MyCat
  
Dim Tasks As New EnumerableObjectCollection
cJL.AddToList Tasks, "Task 1", "/task /arg1", "ToolTip Task 1", 47
cJL.AddToList Tasks, "Task 2", "/task /arg2", "ToolTip Task 2", 78
cJL.AddToList Tasks 'Leave blank for separator
cJL.AddToList Tasks, "Task 3", "/task /arg3", "ToolTip Task 3", 86
cJL.AddUserTasks Tasks

cJL.CommitList
End Sub

The class uses imageres.dll for the icons, the trailing numbers above are icon indexes within it, but you can change that to anything else with the .SetIconLocation call in AddToList.

---

ITaskbarList
For anyone curious, yes you can use both ICustomDestinationList (this project) with ITaskbarList3/4 (overlay icons, progress, change thumbnail area, and add buttons -- see this demo project). The buttons/changed thumbnail of the latter only appear when the taskbar icon is hovered over, whereas the jump list only appears upon a right-click; so none of the features in either project conflict with any others and can be present in the same taskbar item.

---

Download cJump class and demo project:

[fafalone]

Well as I finally discovered after like 5 more wasted hours, you can in fact do this without a class. So here's a compact version; this version assumes mIID.bas and mPKEY.bas are present, or you can additionally copy those sections from the class in the first post.
Can be placed in either a module or your startup form.

Public Declare Function SetCurrentProcessExplicitAppUserModelID Lib "shell32" (ByVal AppID As Long) As Long 'AppID AS LONG, AS LONG!

Public pCDL As New DestinationList

Public Sub InitCDL(sAppID As String)
SetCurrentProcessExplicitAppUserModelID StrPtr(sAppID)
pCDL.SetAppID StrPtr(sAppID)
Dim pOA As IObjectArray
pCDL.BeginList 0&, IID_IObjectArray, pOA
Dim pCat As New EnumerableObjectCollection
CDL_AddToList pCat, "Cat 3", "/cat /arg1", "ToolTip Cat 1", 14
CDL_AddToList pCat, "Cat 2", "/cat /arg2", "ToolTip Cat 2", 23
pCDL.AppendCategory StrPtr("My Category"), ByVal ObjPtr(pCat)

Dim pTask As New EnumerableObjectCollection
CDL_AddToList pTask, "Task 1", "/task /arg1", "ToolTip Task 1", 47
CDL_AddToList pTask, "Task 2", "/task /arg2", "ToolTip Task 2", 78
CDL_AddToList pTask, "", "", "", 0 'Leave blank for separator
CDL_AddToList pTask, "Task 3", "/task /arg3", "ToolTip Task 3", 86
pCDL.AddUserTasks ByVal ObjPtr(pTask)

pCDL.CommitList
End Sub
Private Sub CDL_AddToList(pList As IObjectCollection, sTitle As String, sArgs As String, sToolTip As String, nIconID As Long)
Dim shl As New ShellLinkW
shl.SetPath App.Path & "\" & App.EXEName & ".exe"
shl.SetArguments sArgs
shl.SetDescription sToolTip
shl.SetIconLocation "imageres.dll", -nIconID

Dim pps As IPropertyStore
shl.QueryInterface IID_IPropertyStore, pps
If sTitle <> "" Then
    pps.SetValue PKEY_Title, CVar(sTitle)
Else
    pps.SetValue PKEY_AppUserModel_IsDestListSeparator, CVar(True)
End If
pps.Commit
pList.AddObject ByVal ObjPtr(shl)
End Sub

Then you just call InitCDL from your Sub Main or Form_Load.

[yokesee]

Very good custom.
I use Windows 10 and I can only have 1 group.
I have searched all the options and I have not seen anything.
I don't know if it happens to more people like that.


greetings and good work

[fafalone]

Which version of Win10 are you on?

And are you running the demos as-is, if not sure it's not just a mistake? Both Custom Categories and Tasks are working on Win10 for me, with both the class and the compact version, for both IDE and compiled:

[Eduardo-]

I experience the same thing here. AddUserTasks works but AppendCategory doesn't work.
I also have Windows 10 in Spanish (I mention it as a guess of a possible cause).
My Windows 10 version is 1903.

[yokesee]

If I also use windows 10 1803 in Spanish.
double possibilities of language.
Greetings

[fafalone]

Do custom categories work in other applications?

[Eduardo-]

Do custom categories work in other applications?

From the applications that I currently have pinned in the taskbar, none has custom categories.
Do you know of any app that has custom categories and I could check?

[fafalone]

Firefox. It has 'Frequent' as a category with your most visited sites, then new window etc as Tasks. And if that's not your browser already, hey good excuse
Works correctly for me on 10 as well. If it doesn't work for you guys, well sounds like I'm off the hook and MS screwed the pooch

[Eduardo-]

Firefox. It has 'Frequent' as a category with your most visited sites, then new window etc as Tasks. And if that's not your browser already, hey good excuse

I have disabled some options of Windows tracking, that perhapes the reason why Firefox doesn't show most visited sites, but it shows a couple of sites "Pinned" ("Anclado" in Spanish) that I neved put there. That's another category I guess.



It lists a shortcut that I have in the desktop and a rar file that it doesn't exist any more. Besides the *.rar extension is associated with Winrar, not with Firefox so I don't know why it lists that. I suppose I never opened such file with Firefox...

[fafalone]

Ugh so it might be my fault

Other Win10 users: Please can you report Version, Language, and whether the custom category group works?
First need to see if this is a problem for only specific versions/locales

Also, tried changing the / to - and using different strings? Maybe it's getting tripped up there.

Edit: One more thought, grab the result of AppendCategory. It's declared as a function already in the tlb.

Dim hr As Long
hr = pCDL.AppendCategory(StrPtr("My Category"), ByVal ObjPtr(pCat))
Debug.Print "hr=0x" & Hex$(hr)

[Eduardo-]

Also, tried changing the / to - and using different strings? Maybe it's getting tripped up there.

If you mean changing "/cat /arg#" to "-cat -arg#" I just tested it and I get the same result.

Edit: One more thought, grab the result of AppendCategory. It's declared as a function already in the tlb.

Dim hr As Long
hr = pCDL.AppendCategory(StrPtr("My Category"), ByVal ObjPtr(pCat))
Debug.Print "hr=0x" & Hex$(hr)

Changing

Public Sub AppendCategory(sCat As String, pList As IObjectCollection)
pCDL.AppendCategory ByVal StrPtr(sCat), ByVal ObjPtr(pList)
End Sub

to

Public Sub AppendCategory(sCat As String, pList As IObjectCollection)
Dim l As Long
l = pCDL.AppendCategory(ByVal StrPtr(sCat), ByVal ObjPtr(pList))
Debug.Print l, Hex(l)
End Sub

I get:
-2147024891 80070005

[fafalone]

That seems to be an Access Denied error... which seems.. odd.. if it allows tasks, which aren't really different. Does it work running as administrator? Is your Firefox running as admin? It doesn't need to on my version but maybe that's where the error is?

Edit: Ooh looks like this isn't the first case of Access Denied errors with ICustomDestinationList on isolated versions of Win10
https://www.devexpress.com/Support/C...ult-0x80040f07 with possible solution -- problem seems to be a Read Only issue?


Edit 2: Found another potential problem. You mentioned you had turned off tracking; does that include recent files? If Windows has recent file tracking turned off, AppendCategory is disabled regardless of whether you're using it for recent files or not according to https://www.codeproject.com/script/C...obtid=2&ovid=4

That doesn't explain how Firefox is getting around it though... maybe something to do with how the IShellLink is constructed?

[Eduardo-]

Does it work running as administrator?

No, it doesn't work and I get the same error number.

Is your Firefox running as admin? It doesn't need to on my version but maybe that's where the error is?

I can have these entries even if Firefox is not running, just with the FF icon pinned at the taskbar I have these additional entries.

Edit 2: Found another potential problem. You mentioned you had turned off tracking; does that include recent files?

Yes, but now I don't remember where I had to go to turn it on again to test...

If Windows has recent file tracking turned off, AppendCategory is disabled regardless of whether you're using it for recent files or not according to https://www.codeproject.com/script/C...obtid=2&ovid=4

It must be that, then!

That doesn't explain how Firefox is getting around it though... maybe something to do with how the IShellLink is constructed?

As I said above, FF shows these additional options (or "category") even when it is not running, so it has to do it in some other way.

[fafalone]

Compile and pin the demo program --- Windows remembers the commands, and they'll appear for that too.
(They're saved as a file in an unlisted folder invisible in Explorer only accessible by manually entering the path, C:\Users\[UserName]\AppData\Roaming\Microsoft\Windows\Recent\CustomDestinations)

[Eduardo-]

Compile and pin the demo program --- Windows remembers the commands, and they'll appear for that too.
(They're saved as a file in an unlisted folder invisible in Explorer only accessible by manually entering the path, C:\Users\[UserName]\AppData\Roaming\Microsoft\Windows\Recent\CustomDestinations)

Yes, I didn't konw that, thanks.

[yokesee]

I found the solution in windows was deactivated I think that as Eduardo I also deactivated many things of windows.
The solution that simple.


otherwise avast antivirus detects the exe as a virus.

greetings sorry for the confusion your contributions are greatly appreciated

[Eduardo-]

OK yokesee, thank you.

I'm glad that the issue is cleared.

[fafalone]

Still need to figure out why Firefox would work, but glad there's at least a way to get it completely working. Thanks for finding that setting.

[AngelV]

Hi fafalone.

Fisrt of all, thank you for sharing this.

Is there some interface(s) out there that manage existing applications jump lists ? ie : not adding a brand new jump list to some application, but managing existing ones, like adding or removing items from the jump list.

Regards.

[fafalone]

Not at a high level like here, you have to dig into the stored data directly; the jump lists are on the disk as structured storage files- you can read/write the .automaticDestinations-ms and .customDestinations-ms files in AppData\Microsoft\Windows\Recent\ with IPropertyStorage and IPropertySetStorage, see https://learn.microsoft.com/en-us/wi...iteread-sample

I don't think there's a ready-made VB6 example though. You have that C++ example which is pretty easy to port to VB6 and for C# there's a good library, OpenMCDF, that would be a bit harder to port.

[AngelV]

@fafalone.

Thanks a lot for pointing me in the right direction. I will study the subject.