The process happens to be Oleview.exe and the information happens to be toolbars but it could be a wide variety of alternatives.
What is even more remarkable is that by the same mechanism it is possible to write to a process and inject code! I raised this on SO as a loophole but question got downvoted, so I deleted it. To me this is astounding and is a good counter-criticism to those critics of Excel VBA who says VBA is a vehicle for macros and malicious code. It seems the C++ guys have been able to run riot for years and years.
BUGFIX TODO: This code works only once for each new instance of Oleview.exe. This was sufficient for what I needed which was the button ids. Will revisit some day.
Option Explicit
Private Declare PtrSafe Function FindWindowExA Lib "user32.dll" ( _
ByVal hwndParent As LongPtr, _
ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () 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 Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" _
(ByVal hProcess As Long, lpAddress As Any, dwSize As Any, _
ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
'https://msdn.microsoft.com/en-us/library/windows/desktop/aa366894(v=vs.85).aspx
'BOOL WINAPI VirtualFreeEx(
' _In_ HANDLE hProcess,
' _In_ LPVOID lpAddress,
' _In_ SIZE_T dwSize,
' _In_ DWORD dwFreeType
');
Private Declare Function VirtualFreeEx Lib "kernel32" _
(ByVal hProcess As Long, ByVal lpAddress As Any, dwSize As Any, _
ByVal dwFreeType As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" _
(ByVal hProcess As Long, lpBaseAddress As Long, lpBuffer As Any, _
ByVal nSize As Long, lpNumberOfBytesWritten As Any) As Long
Private Const WM_COMMAND As Long = &H111
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 Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H206
Private Const MEM_RESERVE = &H2000
Private Const MEM_COMMIT = &H1000
Private Const MEM_PHYSICAL = &H400000
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Type TBBUTTON
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 Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Const LANG_USER_DEFAULT = &H400&
Private Declare Function CloseHandle Lib "Kernel32.dll" _
(ByVal Handle As Long) As Long
Private mlLastDllError As Long
Private msLastErrorStr As String
Private mbError As Boolean
'**********************************************************************************
'* Entry Point
'**********************************************************************************
Public Sub ReadOleViewButtonIds()
Dim hWndToolbar As Long
Dim lOleViewProcId As Long
FindOleViewToolbarAndProcId hWndToolbar, lOleViewProcId
Const PROCESS_ALL_ACCESS = &H1F0FFF
Dim hWndProcessOleView As Long
hWndProcessOleView = OpenProcess(PROCESS_ALL_ACCESS, 0, lOleViewProcId)
If hWndProcessOleView = 0 Then
Debug.Print Err.LastDllError
Debug.Print GetLastErrorStr(Err.LastDllError)
Stop
End
End If
'https://social.msdn.microsoft.com/Forums/ie/en-US/cc1d7923-b1c7-478d-b ....
'https://tinyurl.com/m8je6ph
Dim lButtonCount As Long
lButtonCount = SendMessage(hWndToolbar, TB_BUTTONCOUNT, 0, 0)
Debug.Assert lButtonCount <> 0
Dim MyButton As TBBUTTON
'http://www.vbforums.com/showthread.php?80056-Trouble-using-VirtualAllocEx
Dim pOleViewLocalMem As Long
pOleViewLocalMem = VirtualAllocEx(hWndProcessOleView, Null, 4096, _
MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
If pOleViewLocalMem = 0 Then
CaptureError
Debug.Print ReportError("Error calling VirtualAllocEx ")
Stop
End
End If
Dim lButton As Long
For lButton = 1 To lButtonCount
Call SendMessage(hWndToolbar, TB_GETBUTTON, lButton, pOleViewLocalMem)
Dim lBytesWritten As Long, ret As Long
ret = ReadProcessMemory(hWndProcessOleView&, pOleViewLocalMem&, MyButton, _
20&, lBytesWritten)
Debug.Assert ret <> 0
Debug.Print lButton & " : " & MyButton.idCommand
Next lButton
VirtualFreeEx hWndProcessOleView, pOleViewLocalMem, 4096, MEM_RELEASE
CloseHandle hWndToolbar
CloseHandle hWndProcessOleView
Stop
End Sub
'**********************************************************************************
'* Returns string error message
'**********************************************************************************
Function GetLastErrorStr(dwErrCode As Long) As String
' Let VB alloc the buffer. If FORMAT_MESSAGE_ALLOCATE_BUFFER
' was used, the lpBuffer param (sMsgBuf) would have to be a
' long pointer
' to the buffer & would then have to be freed when we're done.
' 256 chars is the maximun length for a resource string (+ 1
' for the null char)
Static sMsgBuf As String * 257, dwLen As Long
dwLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM _
Or FORMAT_MESSAGE_IGNORE_INSERTS _
Or FORMAT_MESSAGE_MAX_WIDTH_MASK, _
ByVal 0&, _
dwErrCode, LANG_USER_DEFAULT, _
ByVal sMsgBuf, 256&, 0&)
If dwLen Then
GetLastErrorStr = Trim$(Left$(sMsgBuf, dwLen))
Else
GetLastErrorStr = "Unknown error."
End If
End Function
'**********************************************************************************
'* Function to get main window launched into explorer's desktop, i.e. the GUI
'**********************************************************************************
Private Function FindChildWindowOfDesktop(ByVal sWindowCaption As String) As Long
Dim hDesktop As Long
hDesktop = GetDesktopWindow
Debug.Assert hDesktop <> 0
Dim hWndMainWindow As Long
hWndMainWindow = FindWindowExA(hDesktop, 0, vbNullString, sWindowCaption$)
mbError = (hWndMainWindow = 0)
If mbError Then NoErrMessage
CloseHandle hDesktop '* no longer required
FindChildWindowOfDesktop = hWndMainWindow '* return to caller, caller releases
End Function
'**********************************************************************************
'* Function to get procId from windows handle
'**********************************************************************************
Public Function FindProcIdFromHWnd(ByVal hWnd As Long) As Long
Dim lOleViewThread As Long, lOleViewProcId As Long
lOleViewThread = GetWindowThreadProcessId(hWnd, lOleViewProcId)
mbError = (lOleViewThread = 0 Or lOleViewProcId = 0)
If mbError Then CaptureError
CloseHandle lOleViewThread '* not required
FindProcIdFromHWnd = lOleViewProcId '* return to caller, caller releases
End Function
'**********************************************************************************
'* Packaging up earlier steps so we can tidy handles
'**********************************************************************************
Public Sub FindOleViewToolbarAndProcId(ByRef hWndToolbar As Long, _
ByRef lOleViewProcId As Long)
Dim hWndMainWindow As Long
hWndMainWindow = FindChildWindowOfDesktop("OLE/COM Object Viewer")
If mbError Then
Debug.Print ReportError("Could not get main window, " _
& "you need to run OLEVIEW.exe!!:")
Stop
End
End If
lOleViewProcId = FindProcIdFromHWnd(hWndMainWindow)
If mbError Then
Debug.Print ReportError("Could not get proc id from main window handle " _
& hWndMainWindow & ":")
Stop
End
End If
hWndToolbar = FindWindowExA(hWndMainWindow, 0, "ToolbarWindow32", "")
If hWndToolbar = 0 Then
Debug.Print Err.LastDllError
Debug.Print GetLastErrorStr(Err.LastDllError)
Stop
End
End If
CloseHandle hWndMainWindow
End Sub
'**********************************************************************************
'* Some helpers for the error handling
'**********************************************************************************
Private Sub NoErrMessage()
mlLastDllError = 0
msLastErrorStr = vbNullString
End Sub
Private Sub CaptureError()
mlLastDllError = Err.LastDllError
msLastErrorStr = GetLastErrorStr(Err.LastDllError)
End Sub
Private Function ReportError(ByVal sPrefix As String)
ReportError = sPrefix & " " & mlLastDllError & " " & msLastErrorStr
End Function
No comments:
Post a Comment