Windows XP - Systray-Leiste automatisch aktualisieren

Option Explicit

'Messagekonstante  
Private Const WM_MOUSEMOVE = &H200

'Strucktur mit den Fensterabmaßen  
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Dim hSystray As Long

Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (lpVersionInformation As Any) As Long  
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128 ' Maintenance string for PSS usage  
End Type

Private Type OSVERSIONINFOEX
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128  ' Maintenance string for PSS usage  
    wServicePackMajor As Integer
    wServicePackMinor As Integer
    wSuiteMask As Integer
    bProductType As Byte
    bReserved As Byte
End Type

Private Const VER_NT_DOMAIN_CONTROLLER As Long = &H2
Private Const VER_NT_SERVER As Long = &H3
Private Const VER_NT_WORKSTATION As Long = &H1

Private Const VER_SUITE_BACKOFFICE As Long = &H4
Private Const VER_SUITE_BLADE As Long = &H4
Private Const VER_SUITE_COMMUNICATIONS As Long = &H8
Private Const VER_SUITE_DATACENTER As Long = &H80
Private Const VER_SUITE_EMBEDDEDNT As Long = &H40
Private Const VER_SUITE_ENTERPRISE As Long = &H2
Private Const VER_SUITE_SINGLEUSERTS As Long = &H100
Private Const VER_SUITE_SMALLBUSINESS As Long = &H1
Private Const VER_SUITE_SMALLBUSINESS_RESTRICTED As Long = &H20
Private Const VER_SUITE_TERMINAL As Long = &H10
Private Const VER_SUITE_PERSONAL As Long = &H200
Private Const VER_SUITE_SERVERAPPLIANCE As Long = &H400

Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32s As Long = 0

Private Declare Function GetVersion Lib "kernel32.dll" () As Long  
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long  
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long  
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long  


Private Function Refresh(ByVal hTray As Long) As Boolean
Dim x As Long, rRect As RECT, z As Long

If hTray = 0 Then Exit Function
'Größe des Fensters ermitteln  
x = GetClientRect(hTray, rRect)

'Zeilenweise durchgehen  
For z = 0 To (rRect.Bottom / 20) - 1
    'zu jerder x Position ein MouseMove senden  
    For x = 0 To rRect.Right
        SendMessage hTray, WM_MOUSEMOVE, 0, ByVal ((((z * 20) + 10) * &H10000) Or x)
    Next
Next
Refresh = True

End Function
Private Function FindSysTray() As Long
Dim h1 As Long, h2 As Long, h3 As Long
'Handle vom Tray suchen  
h1 = FindWindow("Shell_TrayWnd", vbNullString)  
If h1 <> 0 Then
    'Handle vom TrayNotify ermitteln  
    h2 = FindWindowEx(h1, 0, "TrayNotifyWnd", vbNullString)  
    If (GetBS > 14) Or (GetBS = 5) Then
        If GetBS > 15 Then h2 = FindWindowEx(h2, 0, "SysPager", vbNullString)  
        If h2 <> 0 Then
            'Handle von der Toolbar ermitteln  
            h3 = FindWindowEx(h2, 0, "ToolbarWindow32", vbNullString)  
            FindSysTray = h3
        End If
    Else
        FindSysTray = h2
    End If
End If

End Function
Private Function GetBS() As Long
Dim WinVer As String
Dim udtOS As OSVERSIONINFO

udtOS.dwOSVersionInfoSize = Len(udtOS)

Call GetVersionEx(udtOS)

Debug.Print udtOS.dwBuildNumber
Debug.Print udtOS.dwMajorVersion
Debug.Print udtOS.dwMinorVersion
Debug.Print udtOS.szCSDVersion

Select Case udtOS.dwPlatformId
    Case VER_PLATFORM_WIN32_NT
        If udtOS.dwMajorVersion = 3 Then
            GetBS = 13 'NT 3.51  
        ElseIf udtOS.dwMajorVersion = 4 Then
            GetBS = 14 'NT 4.0  
        ElseIf udtOS.dwMajorVersion = 5 Then
            If udtOS.dwMinorVersion = 0 Then
                GetBS = 15 'Win2000  
            ElseIf udtOS.dwMinorVersion = 1 Then
                GetBS = 16 'WinXP  
            ElseIf udtOS.dwMinorVersion = 2 Then
                GetBS = 17 'Win .NET/2003  
            End If
        End If
    Case VER_PLATFORM_WIN32_WINDOWS
        If udtOS.dwMinorVersion = 0 Then
            GetBS = 3 'Win 95  
        ElseIf udtOS.dwMinorVersion = 10 Then
            GetBS = 4 'Win 98  
        ElseIf udtOS.dwMinorVersion = 90 Then
            GetBS = 5 'Win ME  
        End If
    Case VER_PLATFORM_WIN32s
        GetBS = 1
End Select

End Function
Public Function SysTrayRefresh() As Boolean

'Fensterhandle vom Systray ermitteln  
hSystray = FindSysTray
'Systray refreshen  
If Refresh(hSystray) Then SysTrayRefresh = True
End Function
Property Get hwnd() As Long
hwnd = hSystray
End Property
Public Function BSInfo() As String
Dim WinVer As String, lngBS As Long
Dim udtOSEX As OSVERSIONINFOEX, udtOS As OSVERSIONINFO

lngBS = GetBS

udtOS.dwOSVersionInfoSize = Len(udtOS)
udtOSEX.dwOSVersionInfoSize = Len(udtOSEX)

If lngBS > 13 Then
    If GetVersionEx(udtOSEX) Then
        If (udtOSEX.bProductType And VER_NT_WORKSTATION) Then
            If lngBS > 14 Then
                WinVer = " Profesional" & vbCrLf  
            Else
                WinVer = " Workstation" & vbCrLf  
            End If
        Else
            WinVer = " Server" & vbCrLf  
        End If
        If (udtOSEX.wSuiteMask And VER_SUITE_PERSONAL) Then WinVer = "Home Edition"  
        WinVer = WinVer & udtOSEX.szCSDVersion
    Else
        Call GetVersionEx(udtOS)
        WinVer = WinVer & udtOS.szCSDVersion
    End If
End If

If lngBS = 1 Then BSInfo = "Win32s"  
If lngBS = 3 Then BSInfo = "Win 95"  
If lngBS = 4 Then BSInfo = "Win 98"  
If lngBS = 5 Then BSInfo = "Win ME"  
If lngBS = 13 Then BSInfo = "Win NT 3.51" & WinVer  
If lngBS = 14 Then BSInfo = "Win NT 4.0" & WinVer  
If lngBS = 15 Then BSInfo = "Win 2000" & WinVer  
If lngBS = 16 Then BSInfo = "Win XP" & WinVer  
If lngBS = 17 Then BSInfo = "Win 2003/.NET" & WinVer  

End Function