32位下正常，为毛64位的不行了呢
本帖最后由 zytse 于 2012-07-06 09:34:26 编辑 32位XP、32位win7这段代码都正常
64位win7下（64位XP没试过），第60行（For循环下面那个MSGBOX）那里获取到的tray.hwnd为什么是0啊
Option Explicit
Private lngTray As Long
Private lngFindClass As Long, lngFindParent As Long
Private m_TifoVec() As TRAYITEMINFO
Private Sub Command1_Click()
MsgBox lstTable.SelectedItem.Index
End Sub
Private Sub initLv()
Dim lngTemp As Long
Dim lngPID As Long, lngTbID As Long
Dim lngAddress As Long, lngButtons As Long, lngTextAdr As Long
Dim lngHwnd As Long, lngHwndAdr As Long, lngButtonID As Long
Dim hProcess As Long
Dim strBuff(1024) As Byte
Dim strText As String
Dim ret As Long, i As Integer
Dim tb As TBBUTTON, tray As TRAYDATA, tifo As TRAYITEMINFO
Dim iinfo As ICONINFO, iconindex As ListImage
Dim listitemx As ListItem
'用FindWindow函数获取ToolbarWindow32的句柄。
lngFindClass = FindWindow("Shell_TrayWnd", vbNullString)
lngFindParent = FindWindowEx(lngFindClass, 0, "TrayNotifyWnd", vbNullString)
lngTemp = FindWindowEx(lngFindParent, 0, "SysPager", vbNullString)
If lngTemp <> 0 Then
lngTray = FindWindowEx(lngTemp, 0, "ToolbarWindow32", vbNullString)
Else
lngTray = FindWindowEx(lngFindParent, 0, "ToolbarWindow32", vbNullString)
End If
Set Picture1.Picture = CaptureActiveWindow(lngTray)
Erase m_TifoVec
lstTable.ListItems.Clear
lstTable.Icons = Nothing
lstTable.SmallIcons = Nothing
ImageList1.ListImages.Clear
With ImageList1
.ImageWidth = 16
.ImageHeight = 16
End With
ImageList1.ListImages.Add , , Me.Icon
lstTable.Icons = ImageList1
lstTable.SmallIcons = ImageList1
'用GetWindowThreadProcessId获取ToolbarWindow32进程ID
Call GetWindowThreadProcessId(lngTray, lngPID) 'lngPID返回进程ID
'用OpenProcess打开一个已存在的进程对象
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lngPID)
'用VirtualAllocEx申请内存空间
lngAddress = VirtualAllocEx(ByVal hProcess, ByVal 0&, ByVal 1024&, MEM_COMMIT Or MEM_RESERVE, PAGE_READWRITE)
'用SendMessage发送TB_BUTTONCOUNT消息到ToolbarWindow32，返回图标数。
lngButtons = SendMessage(lngTray, TB_BUTTONCOUNT, 0, 0)
ReDim m_TifoVec(0 To lngButtons - 1)
'用ReadProcessMemory从进程内存空间读取数据：图标标题、图标句柄、图标进程ID（注意，要有足够的权限）
For i = 0 To lngButtons - 1
ret = SendMessage(lngTray, TB_GETBUTTON, ByVal i, ByVal lngAddress)
ret = ReadProcessMemory(hProcess, ByVal lngAddress, ByVal VarPtr(tb), Len(tb), ByVal 0&)
ret = ReadProcessMemory(hProcess, ByVal tb.dwData, ByVal VarPtr(tray), Len(tray), ByVal 0&)
msgbox tray.hwnd ' ------------------这个句柄为什么是0。在32位却正常获取到句柄。
If tb.fsState And TBSTATE_HIDDEN Then
strText = "[Hidden Icon]"
Else
ret = SendMessage(lngTray, TB_GETBUTTONTEXTW, tb.idCommand, ByVal lngAddress)
ret = ReadProcessMemory(hProcess, ByVal lngAddress, ByVal VarPtr(strBuff(0)), ByVal 1024, ByVal 0&)
strText = ConverNull(strBuff) 成功获取到tips文字
End If
With tifo
.idCommand = tb.idCommand
.sProcessPath = GetPath(tray.hwnd)
.sTip = strText
.hwnd = tray.hwnd
.uCallbackMessage = tray.uCallbackMessage
.uID = tray.uID
.bVisible = Not CBool(tb.fsState And TBSTATE_HIDDEN)
End With
m_TifoVec(i) = tifo
'ret = SendMessage(lngTray, TB_GETBITMAP, ByVal i, 0&)
'Set lstTable.SmallIcons = ImageList1
'Set lstTable.Icons = ImageList1
If GetIconInfo(tray.hIcon, iinfo) <> 0 Then
'Dim icn As StdPicture
'Set icn = CreateOlePicture(tray.hIcon, vbPicTypeIcon)
'ImageList1.ListImages.Add , , CreateOlePicture(tray.hIcon, vbPicTypeIcon) 'icn
Set iconindex = ImageList1.ListImages.Add(, , CreateOlePicture(tray.hIcon, vbPicTypeIcon))
Set listitemx = lstTable.ListItems.Add(, , i, , iconindex.Index)
Else
'不可识别的图标用程序图标代替
Set iconindex = ImageList1.ListImages.Add(, , Me.Icon)
Set listitemx = lstTable.ListItems.Add(, , i, , iconindex.Index)
'Set listitemx = lstTable.ListItems.Add(, , i)
End If
With listitemx
.SubItems(1) = strText ' tifo.sTip
.SubItems(2) = GetPath(tray.hwnd) 'tifo.sProcessPath
'.SubItems(3) = lngTbID
End With
strText = ""
Next i
VirtualFreeEx hProcess, ByVal lngAddress, ByVal 4096&, MEM_RELEASE
CloseHandle hProcess
End Sub
