Please help: convert SysTray_UDF to VB6

[THN]

Hi guys

I've been struggling to convert the _SysTrayIconTooltip function of SysTray_UDF to VB6 and was very much hoping to come across a VB6 programmer in this forum.

My code (see below) executes correctly under VB6's IDE, but fails when compiled. According to my debugging efforts so far, the problem lies near code line 495 (DLLCall to GetWindowThreadProcessId) and/or line 506 (DLLCall to OpenProcess). I am running in W10 x86.

I might be totally wrong but I'm suspecting an issue with SeDebugPrivilege which *might* be set in the VB6 IDE and also under AutoIt3, but possibly not when running the compiled VB6 pgm.

I would very much appreciate your help on this issue.

 

Tx a lot in advance

 

T.

 

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fest Einfach
   Caption         =   "SysTrayToolTips"
   ClientHeight    =   3015
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   4575
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3015
   ScaleWidth      =   4575
   StartUpPosition =   2  'Bildschirmmitte
   Begin MSComctlLib.ListView lvwToolTips 
      Height          =   2775
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4335
      _ExtentX        =   7646
      _ExtentY        =   4895
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      HideColumnHeaders=   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Object.Width           =   7408
      EndProperty
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 0

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String _
) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hWndParent As Long, _
    ByVal hWndChildAfter As Long, _
    ByVal lpszClassName As String, _
    ByVal lpszWindowName As String _
) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
    ByVal hWnd As Long, _
    ByRef lpdwProcessId As Long _
) As Long

Private Declare Function OpenProcess Lib "kernel32" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long _
) As Long

Private Declare Function ReadProcessMemory Lib "kernel32" ( _
    ByVal hProcess As Long, _
    lpBaseAddress As Any, _
    lpBuffer As Any, _
    ByVal nSize As Long, _
    lpNumberOfBytesWritten As Long _
) As Long

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long _
) As Long

Private Declare Function VirtualAllocEx Lib "kernel32.dll" ( _
    ByVal hProcess As Long, _
    ByVal lpAddress As Long, _
    ByVal wSize As Long, _
    ByVal flAllocationType As Long, _
    ByVal flProtect As Long _
) As Long

Private Declare Function VirtualFreeEx Lib "kernel32.dll" ( _
    ByVal hProcess As Long, _
    ByVal lpAddress As Long, _
    ByVal dwSize As Long, _
    ByVal dwFreeType As Long _
) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any _
) As Long

Private Type DllStructCreate1
    iBitmap      As Long
    idCommand    As Long
    fsState      As Byte
    fsStyle      As Byte
    bReserved1   As Byte
    bReserved2   As Byte
    dwData       As Long
    iString      As Long
End Type

Private Const WM_USER = &H400
Private Const TB_BUTTONCOUNT = (WM_USER + 24)
Private Const TB_GETBUTTON = (WM_USER + 23)
Private Const TB_PRESSBUTTON = (WM_USER + 3)

Private Sub Form_Load()

    Dim i As Integer
    
    For i = 1 To SysTrayIconCount()
        lvwToolTips.ListItems.Add Text:=SysTrayIconTooltip(i - 1)
    Next 'i

End Sub

Private Function FindTrayToolbarWindow() As Long

    'Local $hWnd = DLLCall("user32.dll","hwnd","FindWindow", "str", "Shell_TrayWnd", "int", 0)
    Dim hWnd As Long
    hWnd = FindWindow("Shell_TrayWnd", vbNullString)
    'if @error Then return -1
    '$hWnd = DLLCall("user32.dll","hwnd","FindWindowEx", "hwnd", $hWnd[0], "int", 0, "str", "TrayNotifyWnd", "int", 0);FindWindowEx(hWnd,NULL,_T("TrayNotifyWnd"), NULL);
    hWnd = FindWindowEx(hWnd, 0&, "TrayNotifyWnd", vbNullString)
    'if @error Then return -1
    'If @OSVersion <> "WIN_2000" Then
    '    $hWnd = DLLCall("user32.dll","hwnd","FindWindowEx", "hwnd", $hWnd[0], "int", 0, "str", "SysPager", "int", 0);FindWindowEx(hWnd,NULL,_T("TrayNotifyWnd"), NULL);
        hWnd = FindWindowEx(hWnd, 0&, "SysPager", vbNullString)
    '    if @error Then return -1
    'End If
    '$hWnd = DLLCall("user32.dll","hwnd","FindWindowEx", "hwnd", $hWnd[0], "int", 0, "str", "ToolbarWindow32", "int", 0);FindWindowEx(hWnd,NULL,_T("TrayNotifyWnd"), NULL);
    hWnd = FindWindowEx(hWnd, 0&, "ToolbarWindow32", vbNullString)
    'if @error Then return -1
    '
    'Return $hWnd[0]
    FindTrayToolbarWindow = hWnd

End Function

Private Function SysTrayIconCount() As Integer
    
    'Local $hWnd = _FindTrayToolbarWindow()
    Dim hWnd As Long
    hWnd = FindTrayToolbarWindow
    'Local $count = 0
    Dim count As Long
    '$count = DLLCall("user32.dll","int","SendMessage", "hwnd", $hWnd, "int", $TB_BUTTONCOUNT, "int", 0, "int", 0)
    count = SendMessage(hWnd, TB_BUTTONCOUNT, 0&, 0&)
    'If @error Then Return -1
    'return $count[0]
    SysTrayIconCount = count

End Function

'Func _SysTrayIconTooltip($iIndex=0)
Private Function SysTrayIconTooltip(ByVal iIndex As Integer) As String
';=========================================================
';   Create the struct _TBBUTTON
';   struct {
';  int         iBitmap;
';    int         idCommand;
';    BYTE     fsState;
';    BYTE     fsStyle;
';
';  #ifdef _WIN64
';    BYTE     bReserved[6]     // padding for alignment
';  #elif defined(_WIN32)
';    BYTE     bReserved[2]     // padding for alignment
';  #endif
';    DWORD_PTR   dwData;
';    INT_PTR          iString;
'
';   }
';=========================================================
    'Local $str        = "int;int;byte;byte;byte[2];dword;int"
    'Dim $TBBUTTON   = DllStructCreate($str)
    Dim TBBUTTON As DllStructCreate1
    'Dim $TBBUTTON2   = DllStructCreate($str)
    'Dim $ExtraData = DllStructCreate("dword[2]")
    'Dim $intTip = DllStructCreate("short[1024]")
    Dim intTip As String * 1024
    '
    '
    'Local $pId
    Dim pId As Long
    'Local $text
    'Local $procHandle
    Dim procHandle As Long
    'Local $index = $iIndex
    'Local $bytesRead
    Dim bytesRead As Long
    'Local $info
    Dim info As String
    'Local $lpData
    Dim lpData As Long
    'Local $trayHwnd
    '
    '
    '$trayHwnd = _FindTrayToolbarWindow()
    Dim trayHwnd As Long
    trayHwnd = FindTrayToolbarWindow()
    MsgBox "FindTrayToolbarWindow" & " : " & trayHwnd
    'If $trayHwnd = -1 Then
    '   $TBBUTTON = 0
    '   $TBBUTTON2 = 0
    '   $ExtraData = 0
    '   $intTip = 0
    '   ;SetError(1)
    '   Return -1
    'EndIf
    '
    'Local $ret = DLLCall("user32.dll","int","GetWindowThreadProcessId", "hwnd", $trayHwnd, "int*", -1)
    Dim ret As Long
    ret = GetWindowThreadProcessId(trayHwnd, pId)
    MsgBox "GetWindowThreadProcessId" & " : " & ret & " : " & pId
    'If Not @error Then
    '       $pId = $ret[2]
    'Else
    '   ConsoleWrite("Error: Could not find toolbar process id, " & @error & @LF)
    '   $TBBUTTON = 0
    '   $TBBUTTON2 = 0
    '   $ExtraData = 0
    '   $intTip = 0
    '   Return -1
    'EndIf
    '$procHandle = DllCall("kernel32.dll", 'int', 'OpenProcess', 'int', $PROCESS_ALL_ACCESS, 'int', False, 'int', $pId)
    Const PROCESS_ALL_ACCESS = 2035711
    Const PROCESS_QUERY_INFORMATION = 1024
    Const PROCESS_VM_OPERATION = &H8
    Const PROCESS_VM_READ = &H10
    Const PROCESS_VM_WRITE = &H20
    Const PROCESS_SET_INFORMATION = &H200
    Const PROCESS_SET_QUOTA = &H100
    Const PROCESS_SUSPEND_RESUME = &H800
    Const PROCESS_TERMINATE = &H1
    Const PROCESS_CREATE_PROCESS = &H80
    Const PROCESS_CREATE_THREAD = &H2
    Const PROCESS_DUP_HANDLE = &H40
    procHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ, False, pId)
    MsgBox "OpenProcess" & " : " & procHandle
    'If @error Then
    '   ConsoleWrite("Error: Could not read toolbar process memory, " & @error & @LF)
    '   $TBBUTTON = 0
    '   $TBBUTTON2 = 0
    '   $ExtraData = 0
    '   $intTip = 0
    '   return -1
    'EndIf
    '
    '$lpData = DLLCall("kernel32.dll","int","VirtualAllocEx", "int", $procHandle[0], "int", 0, "int", DllStructGetSize ( $TBBUTTON ), "int", 0x1000, "int", 0x04)
    lpData = VirtualAllocEx(procHandle, 0&, Len(TBBUTTON), &H1000, &H4)
    MsgBox "VirtualAllocEx" & " : " & lpData
    'If @error Then
    '   ConsoleWrite("VirtualAllocEx Error" & @LF)
    '   $TBBUTTON = 0
    '   $TBBUTTON2 = 0
    '   $ExtraData = 0
    '   $intTip = 0
    '   Return -1
    'Else
    '   DLLCall("user32.dll","int","SendMessage", "hwnd", $trayHwnd, "int", $TB_GETBUTTON, "int", $index, "ptr",$lpData[0]);e(hwnd, TB_GETBUTTON, index, (LPARAM)lpData);
        SendMessage trayHwnd, TB_GETBUTTON, iIndex, ByVal lpData
    '   DllCall('kernel32.dll', 'int', 'ReadProcessMemory', 'int', $procHandle[0], 'int', $lpData[0], 'ptr', DllStructGetPtr($TBBUTTON2), 'int', DllStructGetSize( $TBBUTTON), 'int', $bytesRead)
        ReadProcessMemory procHandle, ByVal lpData, ByVal TBBUTTON, Len(TBBUTTON), bytesRead
        MsgBox "ReadProcessMemory" & " : " & bytesRead
        If bytesRead < Len(TBBUTTON) Then GoTo error
    '   DllCall('kernel32.dll', 'int', 'ReadProcessMemory', 'int', $procHandle[0], 'int', DllStructGetData($TBBUTTON2,7), 'int', DllStructGetPtr($intTip), 'int', DllStructGetSize( $intTip), 'int', 0);_MemRead($procHandle, $lpData[0], DllStructGetSize( $TBBUTTON))
        ReadProcessMemory procHandle, ByVal TBBUTTON.iString, ByVal intTip, Len(intTip), bytesRead
        MsgBox "ReadProcessMemory" & " : " & bytesRead
        If bytesRead < Len(intTip) Then GoTo error
        info = StrConv(intTip, vbFromUnicode)
        info = Left(info, InStr(info, Chr(0)) - 1)
        MsgBox info, vbOKOnly, "SUCCESS"
    '
    '   ; go through every character
    '   $i = 1
    '   While $i < 1024
    '       $tipChar = ""
    '
    '#cs
    '  BOOL ReadProcessMemory(
    '  HANDLE hProcess,
    '  LPCVOID lpBaseAddress,
    '  LPVOID lpBuffer,
    '  SIZE_T nSize,
    '  SIZE_T* lpNumberOfBytesRead
    ');
    '#ce
    '
    '
    '       $tipChar = Chr(DllStructGetData($intTip,1,$i))
    '
    '       If $tipChar = "" Then
    '           ExitLoop
    '       EndIf
    '       ;ConsoleWrite(@CRLF & $i & " Char: " & $tipChar & @LF)
    '       $info =  $info & $tipChar
    '
    '       $i = $i + 1
    '   Wend
    '
    '   If $info = "" Then
        If info = vbNullString Then
    '       $info = "No tooltip text"
            info = "No tooltip text"
    '   EndIf
        End If
    '
    '   DLLCall("kernel32.dll","int","VirtualFreeEx", "int", $procHandle[0], "ptr", $lpData[0], "int", 0, "int", 0x8000) ;DllStructGetSize ( $TBBUTTON ), "int", 0x8000))
error:
        VirtualFreeEx procHandle, ByVal lpData, 0&, &H8000
    'EndIf
    '
    'DllCall('kernel32.dll', 'int', 'CloseHandle', 'int', $procHandle[0])
    CloseHandle procHandle
    '$TBBUTTON = 0
    '$TBBUTTON2 = 0
    '$ExtraData = 0
    '$intTip = 0
    '$lpData = 0
    'return $info
    SysTrayIconTooltip = info
'EndFunc
End Function