hola te paso una clase de ActiveVB que es muy cortita usa ASM , en planet source code hay otras busca por Paul Caton
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length 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
Private Const GWL_WNDPROC As Long = -4
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const MEM_RELEASE As Long = &H8000&
Private Const WM_DESTROY As Long = &H2
Private pASMWrapper As Long
Private PrevWndProc As Long
Private hSubclassedWnd As Long
Public Event WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef Remove As Boolean, ByVal RetVal)
'Callback-Funktion,
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal As Long
Dim Remove As Boolean
RaiseEvent WndProc(hwnd, Msg, wParam, lParam, Remove, RetVal)
If Remove = True Then
'Nachricht soll nicht an die vorherige WindowProc leiten
WindowProc = RetVal
Else
'Nachricht soll durchgereicht werden
WindowProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End If
If Msg = WM_DESTROY Then
Call StopSubclassing
End If
End Function
Public Function SetSubclassing(ByVal hwnd As Long) As Boolean
'Setzt Subclassing, sofern nicht schon gesetzt
If PrevWndProc = 0 Then
If pASMWrapper <> 0 Then
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, pASMWrapper)
If PrevWndProc <> 0 Then
hSubclassedWnd = hwnd
SetSubclassing = True
End If
End If
End If
End Function
Public Function StopSubclassing() As Boolean
'Stopt Subclassing, sofern gesetzt
If hSubclassedWnd <> 0 Then
If PrevWndProc <> 0 Then
Call SetWindowLong(hSubclassedWnd, GWL_WNDPROC, PrevWndProc)
hSubclassedWnd = 0
PrevWndProc = 0
StopSubclassing = True
End If
End If
End Function
Private Sub Class_Initialize()
Dim ASM(0 To 103) As Byte
Dim pVar As Long
Dim ThisClass As Long
Dim CallbackFunction As Long
Dim pVirtualFree
'Virtuellen Speicher anfordern
pASMWrapper = VirtualAlloc(ByVal 0&, 104, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
If pASMWrapper <> 0 Then
'Instanzzeiger der Klasse auslesen
ThisClass = ObjPtr(Me)
'Zeiger auf die Callback-Funktion auslesen
Call CopyMemory(pVar, ByVal ThisClass, 4)
Call CopyMemory(CallbackFunction, ByVal (pVar + 28), 4)
'Zeiger auf die VirtualFree-Funktion ermitteln
pVirtualFree = GetProcAddress(GetModuleHandle("kernel32.dll"), "VirtualFree")
'ASM-Wrapper mit Maschinencode befüllen
ASM(0) = &H90 '&Hcc int 3 (Software Interrupt zum debuggen), &H90=nop (No Operation Point)
ASM(1) = &HFF 'inc (Zähler)
ASM(2) = &H5
ASM(7) = &H6A 'push 0
ASM(8) = &H0
ASM(9) = &H54 'push esp
ASM(10) = &HFF 'push (esp+18h) (laram)
ASM(11) = &H74
ASM(12) = &H24
ASM(13) = &H18
ASM(14) = &HFF 'push (esp+18h) (wParam)
ASM(15) = &H74
ASM(16) = &H24
ASM(17) = &H18
ASM(18) = &HFF 'push (esp+18h) (msg)
ASM(19) = &H74
ASM(20) = &H24
ASM(21) = &H18
ASM(22) = &HFF 'push (esp+18h) (hwnd)
ASM(23) = &H74
ASM(24) = &H24
ASM(25) = &H18
ASM(26) = &H68 'push Instanzzeiger
ASM(31) = &HB8 'mov eax, Adresse WindowProc
ASM(36) = &HFF 'call eax
ASM(37) = &HD0
ASM(38) = &HFF 'dec (Zähler)
ASM(39) = &HD
ASM(44) = &HA1 'mov eax, (Signal)
ASM(49) = &H85 'test eax, eax
ASM(50) = &HC0
ASM(51) = &H75 'jne
ASM(52) = &H4
ASM(53) = &H58 'pop eax (Rückgabewert)
ASM(54) = &HC2 'ret &H10
ASM(55) = &H10
ASM(56) = &H0
ASM(57) = &HA1 'mov eax, (Zähler)
ASM(62) = &H85 'test eax, eax
ASM(63) = &HC0
ASM(64) = &H74 'je
ASM(65) = &H4
ASM(66) = &H58 'pop eax (Rückgabewert)
ASM(67) = &HC2 'ret &H10
ASM(68) = &H10
ASM(69) = &H0
ASM(70) = &H58 'pop eax retval
ASM(71) = &H59 'pop ecx (Rücksprungzeiger)
ASM(72) = &H58 'pop eax hwnd
ASM(73) = &H58 'pop eax msg
ASM(74) = &H58 'pop eax wparam
ASM(75) = &H58 'pop eax lparam
ASM(76) = &H68 'push MEM_RELEASE
ASM(77) = &H0
ASM(78) = &H80
ASM(79) = &H0
ASM(80) = &H0
ASM(81) = &H6A 'push 0
ASM(82) = &H0
ASM(83) = &H68 'push Zeiger auf den Wrapper
ASM(88) = &H51 'push ecx (Rücksprungzeiger)
ASM(89) = &HB8 'mov eax, VirtualFree Adresse
ASM(94) = &HFF 'jmp eax
ASM(95) = &HE0
ASM(96) = &H0 'Speicher für Zähler
ASM(97) = &H0
ASM(98) = &H0
ASM(99) = &H0
ASM(100) = &H0 'Speicher für Signal
ASM(101) = &H0
ASM(102) = &H0
ASM(103) = &H0
'cobein
'scode = "8B4C2408B830000000648B008B400C8B401C8B008B4008890131C0C3"
'For i = 0 To Len(scode) - 1 Step 2
' bvASM(i / 2) = CByte("&h" & Mid$(scode, i + 1, 2))
'Next
'Zähler Variable setzen
pVar = pASMWrapper + 96
Call CopyMemory(ASM(3), pVar, 4)
Call CopyMemory(ASM(40), pVar, 4)
Call CopyMemory(ASM(58), pVar, 4)
'Flag Variable setzen
pVar = pASMWrapper + 100
Call CopyMemory(ASM(45), pVar, 4)
'Wrapper Adresse setzen
pVar = pASMWrapper
Call CopyMemory(ASM(84), pVar, 4)
'Instanzzeiger setzen
pVar = ThisClass
Call CopyMemory(ASM(27), pVar, 4)
'Funktionszeiger setzen
pVar = CallbackFunction
Call CopyMemory(ASM(32), pVar, 4)
'VirtualFree Adresse setzen
pVar = pVirtualFree
Call CopyMemory(ASM(90), pVar, 4)
'fertigen Wrapper in DEP-kompatiblen Speicher kopieren
Call CopyMemory(ByVal pASMWrapper, ASM(0), 104)
End If
End Sub
Private Sub Class_Terminate()
'Veranlasst das Freigeben des virtuellen Speichers
Dim Counter As Long
Dim Flag As Long
If pASMWrapper <> 0 Then
Call StopSubclassing
'Zähler auslesen
Call CopyMemory(Counter, ByVal (pASMWrapper + 104), 4)
If Counter = 0 Then
'Wrapper kann von VB aus gelöscht werden
Call VirtualFree(ByVal pASMWrapper, 0, MEM_RELEASE)
Else
'Wrapper befindet sich noch innerhalb einer Rekursion und muss sich selbst löschen Flag setzen
Flag = 1
Call CopyMemory(ByVal (pASMWrapper + 108), Flag, 4)
End If
End If
End Sub
