-
Nov 8th, 2016, 12:19 PM
#1
[vba] Ways for improvement of MS Office window subclassing
Hi,
I know this is a bad idea to subclass Word / Excel windows (because many reasons, at least these), but anyway I want to have such one (e.g. for RegisterHotkey to have an opportunity to redefine some internal hotkeys to obtain a more convenient tools for editing text).
Enough words. I rewrote a little bit a code based on Jaafar Tribak source.
My edits related to simplify code. Also I added safe UnSubclass with help of 'The Trick'. But I don't very familiar with subclassing in general.
For people, who worked with subclassing (like fafalone project) and still intrested,
what do you think, how can we improve this code to be more safely?
For now, it's for MS Excel only:
Thisworkbook
Code:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'unsubclass the window.
'flag = False
Call UnSubClassExcel(Application.hWnd)
End Sub
Private Sub Workbook_Open()
'let's subclass the main
'excel application window.
Call Safe_Subclass(Application.hWnd)
End Sub
Module1.bas
Code:
'Forked by Alex Dragokas
'Thanks for safe UnSubclassing example goes to 'The Trick'.
'Copyrights:
'MS Excel Subclassing by Jaafar Tribak - http://www.mrexcel.com/forum/general-excel-discussion-other-questions/420673-challenging-problem-how-make-excel-subclassing-safe-stable.html#post2082195
Option Explicit
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function RegisterHotKey Lib "user32.dll" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32.dll" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Const GWL_WNDPROC As Long = -4&
Private Const WM_USER As Long = &H400&
'Classes
Private Const VBE_CLASS_NAME As String = "wndclass_desked_gsk"
'UnSubclassing
Private Const WM_SYSCOMMAND As Long = &H112&
Private Const SC_CLOSE As Long = &HF060&
Dim lOldWinProc As Long
Dim lVBEhwnd As Long
Sub Safe_Subclass(hWnd As Long)
Static IsSubclassed As Boolean
'don't subclass the window twice !
If IsSubclassed Then
Exit Sub
Else
IsSubclassed = True
End If
'retrieve the VBE hwnd.
lVBEhwnd = FindWindow(VBE_CLASS_NAME, vbNullString)
'stop and reset the VBE first to safely proceed with our subclassing
PostMessage lVBEhwnd, ByVal WM_USER + &HC44&, ByVal &H30&, ByVal 0&
PostMessage lVBEhwnd, ByVal WM_USER + &HC44&, ByVal &H33&, ByVal 0&
PostMessage lVBEhwnd, ByVal WM_USER + &HC44&, ByVal &H83&, ByVal 0&
'run a one time timer and subclass owr app
'from the timer callback function.
'if subclassing is not installed within
'the timer callback, app. will crash !
Application.OnTime Now + TimeValue("00:00:01"), "TimerProc"
End Sub
Sub UnSubClassExcel(hWnd As Long)
'remove the subclass and cleanup.
SetWindowLong hWnd, GWL_WNDPROC, lOldWinProc
lOldWinProc = 0
Release
End Sub
Public Sub TimerProc()
'hide the VBE.
ShowWindow lVBEhwnd, 0&
'and at last we can now safely subclass our target window.
lOldWinProc = SetWindowLong(Application.hWnd, GWL_WNDPROC, AddressOf WindowProc)
RegHotKey
End Sub
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_HOTKEY As Long = &H312&
Select Case uMsg
Case WM_SYSCOMMAND
If wParam = SC_CLOSE Then
Release
WindowProc = 0
Call UnSubClassExcel(Application.hWnd)
PostMessage hWnd, WM_SYSCOMMAND, SC_CLOSE, lParam
End If
Case WM_HOTKEY
If wParam = 1 Then
Debug.Print "Key is pressed: " & wParam
End If
End Select
WindowProc = CallWindowProc(lOldWinProc, hWnd, uMsg, wParam, lParam)
End Function
Sub RegHotKey()
Const MOD_CONTROL As Long = 2&
Const MOD_SHIFT As Long = 4&
Const MOD_ALT As Long = 1&
Const VK_RETURN As Long = &HD&
Const VK_NUMPAD0 As Long = &H60&
Dim lret&
lret = RegisterHotKey(Application.hWnd, 1, MOD_SHIFT, VK_RETURN)
Debug.Print "RegisterHotKey = " & lret
End Sub
Sub Release()
UnregisterHotKey Application.hWnd, 1
End Sub
To use, click Ctrl + Shift + Enter, and you'll get a msg in immediate window.
Thanks in advance,
Alex.
-
Nov 9th, 2016, 03:46 PM
#2
New Member
Re: [vba] Ways for improvement of MS Office window subclassing
I've been playing with subclassing in Excel for the past few months. With a bit of machine code you can achieve quite save subclassing that can handle project resets and stuff like that.
Unfortunately it works only in version 2007 and below. In 2010+ it doesn't work at all, and I'm still trying to figure out why.
Here is very, very simple ASM code that in my opinion should not crash excel immediately but it does (in version 2010 and above)
Code:
format binary
include 'macro/proc32.inc'
_patch1_ = 01BCCAABh ; previous WndProc
_patch2_ = 02BCCAABh ; CallWindowProc
call WndProc
use32
proc WndProc hWnd:DWORD, uMsg:DWORD, wParam:DWORD, lParam:DWORD
_init:
push [lParam]
push [wParam]
push [uMsg]
push [hWnd]
push dword _patch1_
call dword _patch2_
ret
endp
-
Nov 10th, 2016, 08:54 AM
#3
Re: [vba] Ways for improvement of MS Office window subclassing
What if create much complicated thing.
To subclass not VBE window, but create own hidden window and provide pointer to WindowProc function inside dynamically created shellcode, that will transmit data to main app. using pipes and calling user defined event, so, VBE will know when to receive next piece of data from the pipe.
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|