|
Option Explicit |
|
|
|
'References: |
|
'http://msdn.microsoft.com/en-us/library/bb759988(VS.85).aspx |
|
'http://www.xtremevbtalk.com/showthread.php?t=45515 |
|
'http://www.tek-tips.com/viewthread.cfm?qid=344761&page=8 |
|
'Get items across process boundaries |
|
'http://www.codeproject.com/KB/threads/int64_memsteal.aspx?fid=29535&df=90&mpp=25&noise=3&sort=Position&view=Quick&select=2558283&fr=26 |
|
'http://www.autoitscript.com/forum/lofiversion/index.php?t9988.html |
|
'Getting text from GetLastError |
|
'http://support.microsoft.com/kb/186063 |
|
'How To List Running Processes |
|
'http://support.microsoft.com/kb/187913 |
|
'problem using LVM_SETTEXTBKCOLOR to change color listview text |
|
'http://www.programmersheaven.com/mb/VBasic/340733/340733/ReadMessage.aspx |
|
'GetCommandLine win32 function for VB/VBA |
|
'http://www.motobit.com/tips/detpg_vba-getcommandline/ |
|
|
|
|
|
Private Const TVGN_ROOT As Long = &H0 |
|
Private Const TVGN_CARET As Long = &H9 |
|
|
|
'// TreeView messages |
|
Private Const TV_FIRST As Long = &H1100 |
|
Private Const TVM_GETCOUNT As Long = (TV_FIRST + 5) |
|
Private Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10) |
|
Private Const TVM_SELECTITEM As Long = (TV_FIRST + 11) |
|
Private Const TVM_GETITEM As Long = (TV_FIRST + 12) 'this is assuming non-UNICODE |
|
Private Const TVM_ENSUREVISIBLE As Long = (TV_FIRST + 20) |
|
Private Const TVM_GETITEMSTATE As Long = (TV_FIRST + 39) |
|
'TreeView item mask |
|
Private Const TVIF_TEXT = &H1 |
|
Private Const TVIF_STATE = &H8 |
|
Private Const TVIF_HANDLE = &H10 |
|
Private Const TVIF_CHILDREN = &H40 |
|
|
|
'Treeview statemask |
|
Private Const TVIS_EXPANDED = &H20 |
|
|
|
|
|
Private Const MAXTEXTLEN = 50 'max length per item in tree view |
|
|
|
Private m_hwnd As Long |
|
|
|
'//process related |
|
Private Const PROCESS_VM_OPERATION As Integer = &H8 |
|
Private Const PROCESS_VM_READ As Integer = &H10 |
|
Private Const PROCESS_VM_WRITE As Integer = &H20 |
|
Private Const PROCESS_QUERY_INFORMATION As Integer = &H400 |
|
|
|
Private Const MEM_COMMIT = &H1000& |
|
Private Const MEM_RESERVE = &H2000& |
|
Private Const MEM_RELEASE = &H8000& |
|
|
|
Private Const PAGE_READWRITE = &H4& |
|
|
|
Private Type TVITEM 'was TV_ITEM |
|
mask As Long |
|
hItem As Long |
|
state As Long |
|
stateMask As Long |
|
pszText As Long 'pointer to string |
|
cchTextMax As Long |
|
iImage As Long |
|
iSelectedImage As Long |
|
cChildren As Long |
|
lParam As Long |
|
End Type |
|
|
|
Private Type TVITEMEX |
|
mask As Long |
|
hItem As Long |
|
state As Long |
|
stateMask As Long |
|
pszText As Long 'pointer to string |
|
cchTextMax As Long |
|
iImage As Long |
|
iSelectedImage As Long |
|
cChildren As Long |
|
lParam As Long |
|
iIntegral As Long |
|
#If (WIN32_IE >= &H600) Then |
|
uStateEx As Long |
|
hwnd As Long |
|
iExpandedImage As Long |
|
#End If |
|
End Type |
|
|
|
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 |
|
|
|
Private Declare Function FormatMessage Lib "kernel32" Alias _ |
|
"FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _ |
|
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _ |
|
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _ |
|
As Long |
|
Private Declare Function SendMessageAny Lib "user32" _ |
|
Alias "SendMessageA" _ |
|
(ByVal hwnd As Long, _ |
|
ByVal wMsg As Long, _ |
|
ByVal wParam As Any, _ |
|
lParam As Any) As Long |
|
|
|
Private Declare Function GetWindowThreadProcessId Lib "user32" _ |
|
(ByVal hwnd As Long, lpdwprocessid As Long) As Long |
|
Private Declare Function OpenProcess Lib "kernel32.dll" _ |
|
(ByVal dwAccess As Long, _ |
|
ByVal fInherit As Integer, _ |
|
ByVal hObject As Long) As Long |
|
Private Declare Function CloseHandle Lib "kernel32" _ |
|
(ByVal hObject As Long) As Long |
|
Private Declare Function VirtualAllocEx Lib "kernel32" _ |
|
(ByVal hProcess As Long, lpAddress As Any, _ |
|
ByVal dwSize As Long, _ |
|
ByVal flAllocationType As Long, _ |
|
ByVal flProtect As Long) As Long |
|
Private Declare Function VirtualFreeEx Lib "kernel32" _ |
|
(ByVal hProcess As Long, _ |
|
lpAddress As Any, _ |
|
ByVal dwSize As Long, _ |
|
ByVal dwFreeType As Long) As Long |
|
Private Declare Function WriteProcessMemory Lib "kernel32" _ |
|
(ByVal hProcess As Long, _ |
|
lpBaseAddress As Any, _ |
|
lpBuffer As Any, _ |
|
ByVal nSize As Long, _ |
|
lpNumberOfBytesWritten 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 lstrcpyn_long_string Lib "kernel32" _ |
|
Alias "lstrcpynA" (ByVal DestString As String, _ |
|
ByVal SourcePointer As Long, _ |
|
ByVal MaxLen As Long) As Long |
|
Private Declare Function lstrlen_long Lib "kernel32" _ |
|
Alias "lstrlenA" (ByVal SourcePointer As Long) As Long |
|
|
|
'this black magic functions are not yet being used |
|
Private Declare Function GetProcessHeap Lib "kernel32" () As Long |
|
Private Declare Function HeapAlloc Lib "kernel32" _ |
|
(ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long |
|
Private Declare Function HeapFree Lib "kernel32" _ |
|
(ByVal hHeap As Long, _ |
|
ByVal dwFlags As Long, _ |
|
lpMem As Any) As Long |
|
Private Declare Sub CopyMemoryWrite Lib "kernel32" _ |
|
Alias "RtlMoveMemory" _ |
|
(ByVal Destination As Long, _ |
|
Source As Any, ByVal Length As Long) |
|
|
|
Private Function MessageText(lCode As Long) As String |
|
Dim sRtrnCode As String |
|
Dim lret As Long |
|
|
|
sRtrnCode = Space$(256) |
|
lret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, lCode, 0&, _ |
|
sRtrnCode, 256&, 0&) |
|
If lret > 0 Then |
|
MessageText = Left(sRtrnCode, lret) |
|
Else |
|
MessageText = "Error not found." |
|
End If |
|
End Function |
|
|
|
Public Property Let Handle(l_hwnd As Long) |
|
m_hwnd = l_hwnd |
|
OutputDebugString "YH:- Handle: " & CStr(m_hwnd) |
|
End Property |
|
|
|
|
|
Public Property Get Count() As Long |
|
Dim lResult As Long |
|
lResult = SendMessage(m_hwnd, TVM_GETCOUNT, 0, 0) |
|
Count = lResult |
|
End Property |
|
|
|
Public Function MoveToRoot() |
|
Dim lResult As Long |
|
lResult = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0&) |
|
'Note: Very important |
|
'Since lResult is already a pointer to a memory |
|
'we need to pass the value into the stack as is, not the address hence using ByVal instead of ByRef |
|
Call SendMessageAny(m_hwnd, TVM_SELECTITEM, TVGN_CARET, ByVal lResult) |
|
End Function |
|
|
|
Public Function GetRootItemText() As String 'TVITEM |
|
Dim pid As Long |
|
Dim process As Long |
|
Dim tv_item As TVITEM |
|
Dim ptv_item As Long 'pointer to tv_item |
|
Dim pitemsz As Long 'Pointer to pz |
|
Dim pitem_root As Long 'pointer to tv_item for the root node |
|
Dim sRet As String |
|
|
|
Call GetWindowThreadProcessId(m_hwnd, pid) |
|
process = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE Or PROCESS_QUERY_INFORMATION, 0, pid) |
|
|
|
If process > 0 Then |
|
ptv_item = VirtualAllocEx(process, 0, LenB(tv_item), MEM_COMMIT, PAGE_READWRITE) |
|
pitemsz = VirtualAllocEx(process, 0, MAXTEXTLEN, MEM_COMMIT, PAGE_READWRITE) |
|
pitem_root = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0&) |
|
|
|
If pitem_root <> 0 Then |
|
tv_item.cchTextMax = MAXTEXTLEN |
|
tv_item.hItem = pitem_root |
|
'tv_item.mask = TVIF_TEXT Or TVIF_CHILDREN |
|
tv_item.mask = TVIF_TEXT Or TVIF_HANDLE |
|
tv_item.pszText = pitemsz |
|
|
|
Dim lpWritten As Long |
|
Dim lret As Long |
|
|
|
lret = WriteProcessMemory(process, ByVal ptv_item, tv_item, LenB(tv_item), lpWritten) |
|
If lret = 0 Then |
|
OutputDebugString "YH: -o- WriteProcessMemory returned 0 " |
|
End If |
|
|
|
Call SendMessageAny(m_hwnd, TVM_GETITEM, 0&, ByVal ptv_item) |
|
|
|
Dim buf() As Byte |
|
ReDim buf(MAXTEXTLEN) |
|
lret = ReadProcessMemory(process, ByVal pitemsz, buf(0), MAXTEXTLEN, lpWritten) |
|
OutputDebugString "YH: -o- lpwritten > " & CStr(lpWritten) |
|
|
|
Dim index As Long |
|
Dim tmpstring As String |
|
For index = LBound(buf) To UBound(buf) |
|
If Chr(buf(index)) = vbNullChar Then Exit For |
|
tmpstring = tmpstring & Chr(buf(index)) |
|
Next index |
|
sRet = tmpstring |
|
|
|
OutputDebugString "YH: -o- " & tmpstring |
|
End If |
|
End If |
|
|
|
VirtualFreeEx process, ByVal pitemsz, MAXTEXTLEN, MEM_RELEASE |
|
VirtualFreeEx process, ByVal tv_item, LenB(tv_item), MEM_RELEASE |
|
CloseHandle process |
|
GetRootItemText = sRet |
|
End Function |
|
'Note: Use TVGN_CARET flag of TVM_GETNEXTITEM to get the currently selected item |
|
Public Function GetSelectedItemText() As String |
|
Dim pid As Long |
|
Dim process As Long |
|
Dim tv_item As TVITEM |
|
Dim ptv_item As Long 'pointer to tv_item |
|
Dim pitemsz As Long 'Pointer to pz |
|
Dim pitem_selected As Long 'pointer to tv_item for the selected item |
|
Dim sRet As String 'return string |
|
|
|
Call GetWindowThreadProcessId(m_hwnd, pid) |
|
process = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE Or PROCESS_QUERY_INFORMATION, 0, pid) |
|
|
|
If process > 0 Then |
|
ptv_item = VirtualAllocEx(process, 0, LenB(tv_item), MEM_COMMIT, PAGE_READWRITE) |
|
pitemsz = VirtualAllocEx(process, 0, MAXTEXTLEN, MEM_COMMIT, PAGE_READWRITE) |
|
'get pointer to item object |
|
pitem_selected = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_CARET, 0&) |
|
If pitem_selected <> 0 Then |
|
tv_item.cchTextMax = MAXTEXTLEN |
|
tv_item.hItem = pitem_selected |
|
tv_item.mask = TVIF_TEXT Or TVIF_HANDLE |
|
tv_item.pszText = pitemsz |
|
|
|
Dim lpWritten As Long |
|
Dim lret As Long |
|
|
|
lret = WriteProcessMemory(process, ByVal ptv_item, tv_item, LenB(tv_item), lpWritten) |
|
If lret = 0 Then |
|
OutputDebugString "YH: -o- WriteProcessMemory returned 0 " |
|
End If |
|
'Now get ptv_item populated with data |
|
Call SendMessageAny(m_hwnd, TVM_GETITEM, 0&, ByVal ptv_item) |
|
|
|
Dim buf() As Byte |
|
ReDim buf(MAXTEXTLEN) |
|
lret = ReadProcessMemory(process, ByVal pitemsz, buf(0), MAXTEXTLEN, lpWritten) |
|
OutputDebugString "YH: -o- lpwritten > " & CStr(lpWritten) |
|
|
|
Dim index As Long |
|
Dim tmpstring As String |
|
For index = LBound(buf) To UBound(buf) |
|
If Chr(buf(index)) = vbNullChar Then Exit For |
|
tmpstring = tmpstring & Chr(buf(index)) |
|
Next index |
|
sRet = tmpstring |
|
|
|
OutputDebugString "YH: -o- " & tmpstring |
|
End If |
|
End If |
|
|
|
VirtualFreeEx process, ByVal pitemsz, MAXTEXTLEN, MEM_RELEASE |
|
VirtualFreeEx process, ByVal tv_item, LenB(tv_item), MEM_RELEASE |
|
CloseHandle process |
|
GetSelectedItemText = sRet |
|
End Function |
|
'Note: Use TVM_GETITEMSTATE message with stateMask set to TVIS_EXPANDED |
|
Public Function IsSelectedItemExpanded() As Boolean |
|
Dim pitem_selected As Long 'pointer to tv_item for the selected item |
|
Dim bRet As Boolean |
|
|
|
pitem_selected = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_CARET, 0&) |
|
Dim lItemState As Long |
|
lItemState = SendMessageAny(m_hwnd, TVM_GETITEMSTATE, ByVal pitem_selected, TVIS_EXPANDED) |
|
If (lItemState And TVIS_EXPANDED) = TVIS_EXPANDED Then |
|
bRet = True |
|
Else |
|
bRet = False |
|
End If |
|
IsSelectedItemExpanded = bRet |
|
End Function |