Кривоус Анатолий писал(а):Убирать сабклассинг перед закрытием проги, или через асм-вставку можно
Ну тык должно без ошибок быть. Запусти оконную процедуру перед сабклассингом напрямую и посмотри что за ошибка, либо если все нормально On error и смотри код ошибки через Debug.Print, брейкпоинт поставить тоже можно, не забывая DefWindowProc или CallWindowProc выполнять.jangle писал(а):Если проект валится с ошибкой в коде? Как я могу его не останавливать?
Option Explicit
Public Event KeyDown(ByVal KeyCode As Long)
Private Const WM_KEYDOWN As Long = &H100
Private Const cNull As Long = &H0
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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
Const AsmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086800000000B800000000FFD08B45FCC9C21000"
' 0 1 2 3 4 5 6 7 8 9 A B C D E F
' ---------------------------------------------------
'| 55 8B EC 83 C4 FC 8D 45 FC 50 FF 75 14 FF 75 10
'| FF 75 0C FF 75 08 68 00 00 00 00 B8 00 00 00 00
'| FF D0 8B 45 FC C9 C2 10 00
Private OldCtl As Long, OldCtl1 As Long
Private ASM_Ctl() As Byte
Private ASM() As Byte
Dim mHwnd As Long, mHwnd1 As Long
'адрес этой функции получается по номеру ProcNumber
Public Function winProc0(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_KEYDOWN
RaiseEvent KeyDown(wParam)
End Select
winProc0 = CallWindowProc(OldCtl, hWnd, uMsg, wParam, lParam)
End Function
'адрес этой функции получается по номеру ProcNumber
Public Function winProc1(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Select Case uMsg
' Case WM_KEYDOWN
' RaiseEvent KeyDown(wParam)
' End Select
winProc1 = CallWindowProc(OldCtl, hWnd, uMsg, wParam, lParam)
End Function
Public Function Hook(ByVal hWnd As Long)
mHwnd = hWnd
Call StartSubclass(hWnd, OldCtl, 0)
End Function
Private Sub StartSubclass(ByVal hWnd As Long, _
ByRef OldWndProc As Long, _
ByVal ProcNumber As Long)
Dim lng As Long
Dim tPtr As Long
ASM = ASM_Ctl
Call CopyMemory(tPtr, ByVal ObjPtr(Me), 4&)
Call CopyMemory(lng, ByVal tPtr + &H1C + (4& * ProcNumber), 4&)
Call CopyMemory(ASM(23), ObjPtr(Me), 4&)
Call CopyMemory(ASM(28), lng, 4&)
OldWndProc = SetWindowLong(hWnd, &HFFFC, VarPtr(ASM(0)))
' ProcNumber - номер функции в этом классе, начиная сверху по порядку вниз...
End Sub
Public Sub Unhook()
If OldCtl Then Call SetWindowLong(mHwnd, &HFFFC, OldCtl)
End Sub
Private Sub Class_Initialize()
Dim lng As Long
Dim tPtr As Long
lng = Len(AsmMain) \ 2&
ReDim ASM_Ctl(cNull To lng - vbNull)
For lng = cNull To lng - vbNull
ASM_Ctl(lng) = Val("&H" & Mid$(AsmMain, (lng) * 2& + vbNull, 2&))
Next
End Sub
Private Sub Class_Terminate()
Call Unhook
End Sub
Хакер писал(а):За такой код надо убивать. Не-DEP-compatible.
jangle писал(а):Чем это может грозить?
jangle писал(а):Проверил проект на 3 машинах с Win7, Win8, Win8.1 везде работает без сбоев
Кривоус Анатолий писал(а):Ты почитай тот пост весь до конца, целесообразней использовать вставку Хакера, с небольшой доработкой. Насчет DEP, можно создать кучу с разрешением на выполнение и в массиве поменять указатель на данные на адрес выделенной из этой кучи памяти. В таком случае можно работать через массив напрямую в разрешенной для области выполнения. Тут был пост про побитовый сдвиг, там можешь пример посмотреть. Только перед всеми манипуляциями надо сначала выделить размер, а после всего поменять все назад.
Кстати к чему это вообще? Для чего весь изврат для вызова внутри класса? Чем стандартный модуль не устраивает? Если есть ошибки внутри кода в модуле, также они будут и в модуле класса. Если у тебя все заработало через класс, значит скорее всего что-то ты с параметрами WindowProc намудрил. Мой пример с RichTextBox'ом работает? Вылетает?
jangle писал(а):Чем это может грозить?
Хакер писал(а):Без примеров. Нужно вызвать HeapCreate с флагом ALLOW_EXECUTE (написанание без префиса, префикс не помню), затем в ней HeapAlloc'ом выделить память и уже в эту память писать любой native-код.
По ненадобности кусочек кучи с кодом освобождается вызовом HeapFree, а сама куча уничтожается вызовом HeapDestroy.
jangle писал(а):Этим проектом я завершаю карьеру VB-программиста
Хакер писал(а):Так что пожелание «Happy debugging», к сожалению одних и радости других, предвещает не такую уж мучительную отладку.
iGrok писал(а):Это на XP. На Vista+ по DEP-исключению софт сразу падает с ошибкой и без каких-либо внятных комментариев.
Хакер писал(а):Если это так, то кто ещё мне скажет, что Vista+ это прогресс по сравнению с XP?..
Хакер писал(а):Кстати, перед тем, как выдать такое окошко, как я выше приаттачил, всё-таки выдаётся ещё вот такое:
Так что пожелание «Happy debugging», к сожалению одних и радости других, предвещает не такую уж мучительную отладку.
'API In General Declaration Section
Private Declare Function SetProcessDEPPolicy Lib "Kernel32.dll" (ByVal dwFlags As Long) As Long
'To Disable DEP
SetProcessDEPPolicy(0)
'To Enable DEP
SetProcessDEPPolicy(1)
jangle писал(а):Private Declare Function SetProcessDEPPolicy Lib "Kernel32.dll" (ByVal dwFlags As Long) As Long
Сейчас этот форум просматривают: SemrushBot и гости: 51