Making certain programs' tray icons "always show" programatically

J

Josh Miller

I was looking for a way to automate the process of picking what
programs "Hide always", "Show always" or "Hide when unused" etc like
you can do manually by right clicking on your taskbar, going into
properties, then clicking the "Customize" button in the Notification
Area. I wrote a program that uses a tray icon and I didn't want the
icon to disappear but couldn't figure out a way to force XP to make my
icon "always show". A did a search but couldn't come up with anything
except someone else looking to do the same:

http://groups.google.com/groups?hl=...564.02000101092001%40enews.newsguy.com&rnum=1

Well I figured it out and decided I'd save someone some time should
they ever want to do the same thing. This is mainly for the
programmers out there so I will post it in a programming NG as well as
here in windowsxp.customize where the initial question was posed.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public Const HKCU = &H80000001
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_CREATE_LINK = &H20
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE
Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Public Const ERROR_SUCCESS = 0&
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_MORE_DATA = 234&
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const ERROR_BADKEY = 1010&
Public Const ERROR_CANTOPEN = 1011&
Public Const ERROR_CANTREAD = 1012&
Public Const ERROR_REGISTRY_CORRUPT = 1015&

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As
Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal lpReserved As Long, lpType As Long, lpData As Any, dwSize As
Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal dwReserved As Long, ByVal dwType As Long, lpValue As Any, ByVal
dwSize As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long,
ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES,
phkResult As Long, lpdwDisposition As Long) As Long

Public Function ReadReg(hKey As Long, SubKey As String, DataName As
String, DefaultData As Variant) As Variant
Dim hKeyResult As Long, lData As Long, result As Long
Dim DataType As Long, DataSize As Long
Dim sData As String, baData() As Byte

ReadReg = DefaultData
result = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, hKeyResult)
If result <> ERROR_SUCCESS Then Exit Function

result = RegQueryValueEx(hKeyResult, DataName, 0&, DataType, ByVal
0, DataSize)
If result <> ERROR_SUCCESS Or DataSize = 0 Then
RegCloseKey hKeyResult
Exit Function
End If
Select Case DataType
Case REG_SZ, REG_EXPAND_SZ
sData = Space(DataSize + 1)
result = RegQueryValueEx(hKeyResult, DataName, 0&, DataType,
ByVal sData, DataSize)
sData = RTrim(StripNulls(sData))
If result = ERROR_SUCCESS And sData <> "" Then ReadReg =
CVar(sData)
Case REG_DWORD
result = RegQueryValueEx(hKeyResult, DataName, 0&, DataType,
lData, 4)
If result = ERROR_SUCCESS Then ReadReg = CVar(lData)
Case REG_BINARY
ReDim baData(DataSize - 1)
result = RegQueryValueEx(hKeyResult, DataName, 0&, DataType,
baData(0), DataSize)
If result = ERROR_SUCCESS Then ReadReg = baData
End Select
RegCloseKey hKeyResult
End Function

Public Function StripNulls(ByVal s As String) As String
Dim i As Integer
StripNulls = s
i = InStr(s, vbNullChar)
If i > 0 Then _
StripNulls = Left(s, i - 1)
End Function

Public Function WriteRegBinaryArray(hKey As Long, SubKey As String,
DataName As String, ba() As Byte) As Long
Dim sa As SECURITY_ATTRIBUTES
Dim hKeyResult As Long, lDisposition As Long, result As Long

sa.nLength = Len(sa)
sa.lpSecurityDescriptor = 0
sa.bInheritHandle = False

result = RegCreateKeyEx(hKey, SubKey, 0, "",
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
sa, hKeyResult, lDisposition)

If (result = ERROR_SUCCESS) Or (result = REG_CREATED_NEW_KEY) Or
(result = REG_OPENED_EXISTING_KEY) Then
result = RegSetValueEx(hKeyResult, DataName, 0&, REG_BINARY,
ba(0), UBound(ba) + 1)
RegCloseKey hKeyResult
End If
WriteRegBinaryArray = result
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Josh Miller 5/04 (e-mail address removed)
'Below, where you see "Enter tooltip here", you must put either all
'of or just the first few words of (enough to be unique) the
'desired programs' tray icon tooltip. It is CASE SENSITIVE. ie:
"Volume",
'"You have new unopened" (MS Outlook mail notification), etc etc.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Main()
Dim iLoc As Long, sData() As Byte
sData = ReadReg(HKCU,
"Software\Microsoft\Windows\CurrentVersion\Explorer\TrayNotify",
"IconStreams", "")
iLoc = InStrB(sData, Format("ENTER TOOLTIP HERE", vbUnicode))
sData(iLoc - 9) = 2 '0 is Hide when inactive, 1 is Always Hide, 2 is
Always Show
WriteRegBinaryArray HKCU,
"Software\Microsoft\Windows\CurrentVersion\Explorer\TrayNotify",
"IconStreams", sData()
End Sub
 
J

Josh Miller

I forgot to mention that this change will only take effect after a
reboot or after you kill the explorer process and restart it. If your
application starts on Windows startup, killing the explorer process
and restarting it won't be noticed as much. Otherwise, this is more
something that you want to set install or on the initial run of your
program and suggest a reboot.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top