Hola, estoy tratando de obtener el puntero de una funcion que esta dentro de un form o class.
La cual no puedo mover a un modulo y usar AddressOf porque es usada por varios hilos, necesito cada funcion independiente. Pero para hacer ello tiene que estar dentro de un class o form, y no puedo obtener su puntero :-\
Intente esto:
http://www.programmersheaven.com/mb/VBasic/237946/237949/re-hot-to-find-the-address-of-a-function/
Call CallWindowProc(ByVal GetDWORD(ObjPtr(Me) + ((FunctionIndex - 1) * 4) + 12), 0, 0, 0, 0)
Agradeceria de su ayuda :P
Aqui parece que se obtiene algo parecido: http://cobein.com/wp/?p=236#more-236
Pero no logro obtener el puntero :-\ Gracias
Lo estas haciendo bien, para obtener el puntero has de leer la vTable.... Pero estas leyendo mal el puntero... el puntero a la funcion no se encuentra en el Offset 0xC, sino en el 0x1C... es decir, el puntero estaría aquí:
ObjPtr(oObjeto) + (Indice * 4) + &H1C
Creo que así podrás obtener el puntero :D
Cita de: Karcrack en 30 Abril 2011, 17:15 PM
Lo estas haciendo bien, para obtener el puntero has de leer la vTable.... Pero estas leyendo mal el puntero... el puntero a la funcion no se encuentra en el Offset 0xC, sino en el 0x1C... es decir, el puntero estaría aquí:
ObjPtr(oObjeto) + (Indice * 4) + &H1C
Creo que así podrás obtener el puntero :D
Gracias por tu respuesta karcrack, no lo logré, probé de estas dos formas y mas variantes tambien, pero parece que el puntero no es el correcto.
cls
Option Explicit
Public Function llamame(ByVal jj, ByVal dd, ByVal tt, ByVal jaja) As Long
MsgBox "hola"
End Function
Public Sub oo()
Dim dd As Long
Dim jj As Long
dd = GetDWORD(ObjPtr(Me))
jj = GetDWORD(dd + (1 * 4) + &H1C)
MsgBox jj
Call CallWindowProc(ByVal jj, 0, 0, 0, 0)
End Sub
Private Function GetDWORD(ByVal lAddr As Long) As Long
Call NtWriteVirtualMemory(-1, GetDWORD, ByVal lAddr, 4, ByVal 0&)
End FunctionOption Explicit
Public Function llamame(ByVal jj, ByVal dd, ByVal tt, ByVal jaja) As Long
MsgBox "hola"
End Function
Public Sub oo()
Dim dd As Long
dd = GetDWORD(ObjPtr(Me) + (1 * 4) + &H1C)
MsgBox dd
Call CallWindowProc(ByVal dd, 0, 0, 0, 0)
End Sub
Private Function GetDWORD(ByVal lAddr As Long) As Long
Call NtWriteVirtualMemory(-1, GetDWORD, ByVal lAddr, 4, ByVal 0&)
End FunctionEl intento dos devuelve 3 :-X. Las apis usadas las puse en otro modulo, y a ese class lo llame desde un form. Voy a informarme de la vTable, pero no hay nada mejor que una ayuda de un experto :P
Saludos
El indice de la primera funcion es 0... de todas formas ahora abro el OllyDbg y le doy un vistazo ;)
Cita de: Karcrack en 30 Abril 2011, 18:09 PM
El indice de la primera funcion es 0... de todas formas ahora abro el OllyDbg y le doy un vistazo ;)
Ya habia probado con 0 tambien, pero no va :P
Option Explicit
Private Declare Function NtWriteVirtualMemory Lib "NTDLL" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function llamame()
MsgBox "hola"
End Function
Public Sub oo()
Dim lVTE As Long
Dim lPtr As Long
lVTE = GetDWORD(ObjPtr(Me))
lPtr = GetDWORD(lVTE + &H1C)
Call CallWindowProc(ByVal lPtr, 0, 0, 0, 0)
End Sub
Private Function GetDWORD(ByVal lAddr As Long) As Long
Call NtWriteVirtualMemory(-1, GetDWORD, ByVal lAddr, 4, ByVal 0&)
End FunctionlPtr parece ser el puntero correcto. Pero da error 'No se establecio la variable object', pareciera que ObjPtr devuelve el puntero de la clase no inicializada, en vez de la clase establecida en el objecto y a eso se debe ese error!!?
El ejemplo de cobein, sobreescribe por el puntero a un ShellCode y por eso no hay error!?
Será posible esto? :-(
Has de tener en cuenta que la forma en la que se llaman las funciones de las clases no es push,push,call... (Que es como el CallWindowProc hace) si no que son cosas raras de COM y yo-que-se :xD
Es decir, aunque consigas el puntero correcto no lo podras llamar asi... Al menos hasta donde yo se
.
Quisas ayuden estos....
Cls (http://infrangelux.sytes.net/filex/index.php?file=Cls_SubClassing%20in%20CLS.cls&dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase)
Ctl (http://infrangelux.sytes.net/filex/index.php?file=UserControl_SubClasificado.ctl&dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase)
En ambos se hace una sub-clasificacion pero hara eso se debe obtener el puntero a la función... pero bueno hay esta el código, igual ayuda en algo.
por otro lado un tienes la funcion CallByname de vb6 y tambien tienes la libreria TLI (http://foro.elhacker.net/programacion_visual_basic/source_callbynameex_y_argumentos_aleatorios-t288883.0.html;wap2=).
Dulces Lunas!¡.
Nadie destripo el clsSubClass de Paul Caton (la version modificada por LaVolpe muy usado por Leandro y por mi)?? :huh: . En la cual hay una funcion scb_GetCallBackAddr (o similar, estoy en el movil) y scb_ReleaseCallback que justamente devuelven un "AddressOf" del ordinal (nro de funcion en orden descendente, la ultima es 1, la anteultima es 2 y asi) de un objeto (por defecto es el que lo llama) y ademas solo hay que especificar el nro de parametros (se hace magia interna con Asm). Lo unico es que todos los parametros deben ser tipo long y la funcion debe devolver long tambien (los parametros en su mayoria son punteros si es que no son numericos).
Cuando tenga internet en casa (por eso estoy muy desaparecido :xD) subire un ejemplo y varios proyectos que tengo listos
Cita de: raul338 en 3 Mayo 2011, 21:56 PM
Nadie destripo el clsSubClass de Paul Caton (la version modificada por LaVolpe muy usado por Leandro y por mi)?? :huh: . En la cual hay una funcion scb_GetCallBackAddr (o similar, estoy en el movil) y scb_ReleaseCallback que justamente devuelven un "AddressOf" del ordinal (nro de funcion en orden descendente, la ultima es 1, la anteultima es 2 y asi) de un objeto (por defecto es el que lo llama) y ademas solo hay que especificar el nro de parametros (se hace magia interna con Asm). Lo unico es que todos los parametros deben ser tipo long y la funcion debe devolver long tambien (los parametros en su mayoria son punteros si es que no son numericos).
Cuando tenga internet en casa (por eso estoy muy desaparecido :xD) subire un ejemplo y varios proyectos que tengo listos
Creo que hablás de esto: http://siccs.googlecode.com/svn-history/r2/trunk/classes/ClsRueda.cls. Ya habia logrado solucionarlo, pero muy buen codigo. Quizas le sirva a alguien.
Saludos y muchas gracias :D
Not Found
The requested URL /svn/!svn/bc/2/trunk/classes/ClsRueda.cls. was not found on this server.
Dulces Lunas!¡.
@BlackZerox: Quitale el punto al final
creo que lo mejor que veas estos links
http://www.activevb.de/tutorials/tut_subclass_asm/tut_subclass_asm.html
y descargate este .zip que esta muy bueno.
http://www.activevb.de/rubriken/klassen/windows/csubclasser/subclasser.zip
pd: yo estoy utilzando estas clases y uc pero me me suelen crashear cuando llama a VirtualFree, creo que esto ocurre cuando llega un msg a WindowProc y llame a VirtualFree, no quiero dar un ejemplo exacto para no irme por las ramas pero si alguien le encuentra una solución o quiere que entre en detalles que chifle.
Saluods.
Cita de: LeandroA en 4 Mayo 2011, 04:50 AM
@BlackZerox: Quitale el punto al final
creo que lo mejor que veas estos links
http://www.activevb.de/tutorials/tut_subclass_asm/tut_subclass_asm.html
No se aleman pero por lo que vi. Es similar a un codigo que vi de "AND ray" implementando las novedades de win7 en vb (busquen "iTaskBarList3" en planet source code) que llamaba a una interfaz (no probe con objetos) a partir de su ordinal y un maximo de 15 parametros (segun recuerdo) pero no se podia obtener el valor devuelto. Usaba un ASM similar
Option Explicit
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLongA Lib "USER32" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "USER32" (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 Const WM_DESTROY As Long = &H2
Private Const WM_MOUSEMOVE As Long = &H200
Private PrevWndProc As Long
Private bvASM(103) As Byte
Public Function WindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProcA(PrevWndProc, Hwnd, Msg, wParam, lParam)
If Msg = WM_DESTROY Then
Call StopSubclassing(Me.Hwnd)
ElseIf Msg = WM_MOUSEMOVE Then
Me.Caption = Timer
End If
End Function
Private Sub SetSubclassing(Obj As Object, Hwnd As Long)
Dim pASMWrapper As Long
Dim pVar As Long
Dim pObj As Long
Dim CallbackFunction As Long
Dim i As Long
pASMWrapper = VarPtr(bvASM(0))
pObj = ObjPtr(Obj)
Call CopyMemory(pVar, ByVal pObj, 4)
pVar = (pVar + 1784) 'Form
Call CopyMemory(CallbackFunction, ByVal pVar, 4)
For i = 0 To 55
bvASM(i) = Choose(i + 1, &H90, &HFF, &H5, &H0, &H0, &H0, &H0, &H6A, &H0, &H54, &HFF, &H74, &H24, &H18, &HFF, &H74, &H24, _
&H18, &HFF, &H74, &H24, &H18, &HFF, &H74, &H24, &H18, &H68, &H0, &H0, &H0, &H0, &HB8, &H0, &H0, _
&H0, &H0, &HFF, &HD0, &HFF, &HD, &H0, &H0, &H0, &H0, &HA1, &H0, &H0, &H0, &H0, &H85, &HC0, &H75, _
&H4, &H58, &HC2, &H10, &H0, &HA1, &H0, &H0, &H0, &H0, &H85, &HC0, &H74, &H4, &H58, &HC2, &H10, _
&H0, &H58, &H59, &H58, &H58, &H58, &H58, &H68, &H0, &H80, &H0, &H0, &H6A, &H0, &H68, &H0, &H0, _
&H0, &H0, &H51, &HB8, &H0, &H0, &H0, &H0, &HFF, &HE0, &H0, &H0, &H0, &H0, &H0, &H0, &H0, &H0)
Next i
'Zahler Variable setzen
pVar = pASMWrapper + 96
Call LongToByte(pVar, bvASM, 3)
Call LongToByte(pVar, bvASM, 40)
Call LongToByte(pVar, bvASM, 58)
'Flag Variable setzen
pVar = pASMWrapper + 100
Call LongToByte(pVar, bvASM, 45)
'Wrapper Adresse setzen
pVar = pASMWrapper
Call LongToByte(pVar, bvASM, 84)
'Instanzzeiger setzen
pVar = pObj
Call LongToByte(pVar, bvASM, 27)
'Funktionszeiger setze
pVar = CallbackFunction
Call LongToByte(pVar, bvASM, 32)
'VirtualFree Adresse setzen
'pVar = GetProcAddress(GetModuleHandle("KERNEL32"), "VirtualFree")
'Call LongToByte(pVar, bvASM, 90)
PrevWndProc = SetWindowLongA(Hwnd, GWL_WNDPROC, pASMWrapper)
End Sub
Private Sub StopSubclassing(Hwnd)
Call SetWindowLongA(Hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
bReturn(i) = lLong And &HFF
bReturn(i + 1) = (lLong And 65280) / &H100
bReturn(i + 2) = (lLong And &HFF0000) / &H10000
bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub
Private Sub Form_Load()
Call SetSubclassing(Me, 0, Me.Hwnd)
End Sub
Gracias por la data Leandro, ahi deje el codigo un poco mas limpio para quien lo necesite, igualmente simplificar mucho el asm.
Saludos
muy bueno F3B14N, veo que eliminaste VirtualAlloc y VirtualFree con lo que se termino el problema que mencionaba anteriormente al parecer todo funciona de lujo :), además se simplifico mucho mas.
Gracias por compartirlo.
PD: fijate quizas te guste mas para crear el ASM(), creo que asi lo hacia Cobein.
Dim sCode As String
sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
"0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
For i = 0 To Len(sCode) - 1 Step 2
bvASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
Next
Saludos.
Cita de: LeandroA en 5 Mayo 2011, 19:27 PM
muy bueno F3B14N, veo que eliminaste VirtualAlloc y VirtualFree con lo que se termino el problema que mencionaba anteriormente al parecer todo funciona de lujo :), además se simplifico mucho mas.
Gracias por compartirlo.
PD: fijate quizas te guste mas para crear el ASM(), creo que asi lo hacia Cobein.
Dim sCode As String
sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
"0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
For i = 0 To Len(sCode) - 1 Step 2
bvASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
Next
Saludos.
Por nada Leandro, aqui esta aun mas simple :-X :
Option Explicit
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLongA Lib "USER32" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "USER32" (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 Const WM_DESTROY As Long = &H2
Private Const WM_MOUSEMOVE As Long = &H200
Private PrevWndProc As Long
Private bvASM(40) As Byte
Public Function WindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProcA(PrevWndProc, Hwnd, Msg, wParam, lParam)
If Msg = WM_DESTROY Then
Call StopSubclassing(Me.Hwnd)
ElseIf Msg = WM_MOUSEMOVE Then
Me.Caption = Timer
End If
End Function
Private Sub SetSubclassing(Obj As Object, Hwnd As Long)
Dim WindowProcAddress As Long
Dim pObj As Long
Dim pVar As Long
Dim i As Long
For i = 0 To 40
bvASM(i) = Choose(i + 1, &H55, &H8B, &HEC, &H83, &HC4, &HFC, &H8D, &H45, &HFC, &H50, &HFF, &H75, &H14, _
&HFF, &H75, &H10, &HFF, &H75, &HC, &HFF, &H75, &H8, &H68, &H0, &H0, &H0, &H0, _
&HB8, &H0, &H0, &H0, &H0, &HFF, &HD0, &H8B, &H45, &HFC, &HC9, &HC2, &H10, &H0)
Next i
pObj = ObjPtr(Obj)
Call CopyMemory(pVar, ByVal pObj, 4)
Call CopyMemory(WindowProcAddress, ByVal (pVar + 1784), 4)
Call LongToByte(pObj, bvASM, 23)
Call LongToByte(WindowProcAddress, bvASM, 28)
PrevWndProc = SetWindowLongA(Hwnd, GWL_WNDPROC, VarPtr(bvASM(0)))
End Sub
Private Sub StopSubclassing(Hwnd)
Call SetWindowLongA(Hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
bReturn(i) = lLong And &HFF
bReturn(i + 1) = (lLong And 65280) / &H100
bReturn(i + 2) = (lLong And &HFF0000) / &H10000
bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub
Private Sub Form_Load()
Call SetSubclassing(Me, 0, Me.Hwnd)
End Sub
Simplemente asombroso la verdad acostumbrado a utilizar la clase de Paul Caton que son muchisimas lineas, con esto esta barbaro.
para informacion a todos, si quieren utilizarlo desde un modulo clase cambiar este valor en esta linea
Call CopyMemory(WindowProcAddress, ByVal (pVar + 1784), 4)
para un modulo clase cambiar 1784 por 28
y para un User Control por 1956
Seguramente me surjan algunas dudas mas adelante sobre como implementar un subclass y un Api Timer en un mismo modulo o bien dos Sub para distintos hilos.
si tenes idea postealo para agendarlo.
Saludos.
.
ja ja ja por lo menos no me funciona este codigo creando una ventana con CreateWindowEx y despues sud-clásificandola TODO desde el modulo de clase xP.
cambiando como ya menciono LeandroA: 1784 por 28 en la linea ya indicada anteriormente.
Dulces Lunas!¡.
Cita de: BlackZeroX▓▓▒▒░░ en 8 Mayo 2011, 02:22 AM
.
ja ja ja por lo menos no me funciona este codigo creando una ventana con CreateWindowEx y despues sud-clásificandola TODO desde el modulo de clase xP.
cambiando como ya menciono LeandroA: 1784 por 28 en la linea ya indicada anteriormente.
Dulces Lunas!¡.
jejerejerejoju
:¬¬ :¬¬ :¬¬
Hola BlackZeroX si funciona quizas lo probaste con un STATIC y no recibe el WM_MouseMove proba con BUTTON
Class1
Option Explicit
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" (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 Const WM_DESTROY As Long = &H2
Private PrevWndProc As Long
Private bvASM(40) As Byte
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Const WS_VISIBLE As Long = &H10000000
Private mWnd As Long
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProcA(PrevWndProc, hwnd, Msg, wParam, lParam)
If Msg = WM_DESTROY Then
Call StopSubclassing(hwnd)
End If
Debug.Print Msg, wParam, lParam
End Function
Private Sub SetSubclassing(Obj As Object, hwnd As Long)
Dim WindowProcAddress As Long
Dim pObj As Long
Dim pVar As Long
Dim i As Long
For i = 0 To 40
bvASM(i) = Choose(i + 1, &H55, &H8B, &HEC, &H83, &HC4, &HFC, &H8D, &H45, &HFC, &H50, &HFF, &H75, &H14, _
&HFF, &H75, &H10, &HFF, &H75, &HC, &HFF, &H75, &H8, &H68, &H0, &H0, &H0, &H0, _
&HB8, &H0, &H0, &H0, &H0, &HFF, &HD0, &H8B, &H45, &HFC, &HC9, &HC2, &H10, &H0)
Next i
pObj = ObjPtr(Obj)
Call CopyMemory(pVar, ByVal pObj, 4)
Call CopyMemory(WindowProcAddress, ByVal (pVar + 28), 4)
Call LongToByte(pObj, bvASM, 23)
Call LongToByte(WindowProcAddress, bvASM, 28)
PrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, VarPtr(bvASM(0)))
End Sub
Private Sub StopSubclassing(hwnd)
Call SetWindowLongA(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
bReturn(i) = lLong And &HFF
bReturn(i + 1) = (lLong And 65280) / &H100
bReturn(i + 2) = (lLong And &HFF0000) / &H10000
bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub
Private Sub Class_Initialize()
mWnd = CreateWindowEx(0&, "Button", "Hola Mundo", WS_VISIBLE, 0&, 0&, 300, 300, 0&, 0&, App.hInstance, ByVal 0&)
If mWnd <> 0 Then Call SetSubclassing(Me, mWnd)
End Sub
Private Sub Class_Terminate()
If mWnd <> 0 Then
Call StopSubclassing(mWnd)
DestroyWindow mWnd
End If
End Sub
Saludos.
...
Edito:
Cuando declaro algunas cosas mas crashea >:D... ya encontre el horror, es que el ASM modifica la 1ra cosa publica y como tenia una variable publica pues crasheaba ya que no era mi WinProc...
Dim c As Class1
Private Sub Form_Load()
Set c = New Class1
End Sub
Option Explicit
Private Const GWL_WNDPROC As Long = -4
Private Const WM_DESTROY As Long = &H2
Private Const WS_VISIBLE As Long = &H10000000
Private Const MAX_PATH As Integer = 260
Private Const MAXDWORD As Long = &HFFFF
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA '// Bytes...
dwFileAttributes As Long '// 4
ftCreationTime As FILETIME '// 8
ftLastAccessTime As FILETIME '// 8
ftLastWriteTime As FILETIME '// 8
nFileSizeHigh As Long '// 4
nFileSizeLow As Long '// 4
dwReserved0 As Long '// 4
dwReserved1 As Long '// 4
cFileName As String * MAX_PATH '// MAX_PATH*2 = 260*2 = 520
cAlternate As String * 14 '// 14*2 = 28
End Type '// total bytes: 592 bytes... = &H250
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function lstrcmp Lib "KERNEL32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function FindFirstFile& Lib "KERNEL32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function FindNextFile& Lib "KERNEL32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function GetFileAttributes Lib "KERNEL32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "KERNEL32" (ByVal hFindFile As Long) As Long
' // SubClassing
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" (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 DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private bIni As Boolean
Private sDir As String
Private sCriterios() As String
Private bIncludeFolders As Boolean
Private bCancel As Boolean
Private tVBFAFoundInDir As VbFileAttribute
Private tVBFAFoundInFile As VbFileAttribute
Private lhSearchF() As Long
Private lsIndex(0 To 1) As Long
Private dblBytesNow_ As Double
Private tWFDFound As WIN32_FIND_DATA
Private bRun As Boolean
Private bFound As Boolean
Private bPause As Boolean
'public AllowEvents As Boolean ' // No pongan nada en modo publico xS.
private bAllowEvents As Boolean ' // No pongan nada en modo publico xS.
Private PrevWndProc As Long
Private bvASM(40) As Byte
Private mWnd As Long
Event Folder(ByRef PathFolder As String)
Event File(ByVal TypeOfFile As Long)
Event Begin()
Event Finish()
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProcA(PrevWndProc, hwnd, Msg, wParam, lParam)
If Msg = WM_DESTROY Then
Call StopSubclassing(hwnd)
End If
Debug.Print Msg, wParam, lParam
End Function
Private Sub SetSubclassing(Obj As Object, hwnd As Long)
Dim WindowProcAddress As Long
Dim pObj As Long
Dim pVar As Long
Dim i As Long
For i = 0 To 40
bvASM(i) = Choose(i + 1, &H55, &H8B, &HEC, &H83, &HC4, &HFC, &H8D, &H45, &HFC, &H50, &HFF, &H75, &H14, _
&HFF, &H75, &H10, &HFF, &H75, &HC, &HFF, &H75, &H8, &H68, &H0, &H0, &H0, &H0, _
&HB8, &H0, &H0, &H0, &H0, &HFF, &HD0, &H8B, &H45, &HFC, &HC9, &HC2, &H10, &H0)
Next i
pObj = ObjPtr(Obj)
Call CopyMemory(pVar, ByVal pObj, 4)
Call CopyMemory(WindowProcAddress, ByVal (pVar + 28), 4)
Call LongToByte(pObj, bvASM, 23)
Call LongToByte(WindowProcAddress, bvASM, 28)
PrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, VarPtr(bvASM(0)))
End Sub
Private Sub StopSubclassing(hwnd)
Call SetWindowLongA(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
bReturn(i) = lLong And &HFF
bReturn(i + 1) = (lLong And 65280) / &H100
bReturn(i + 2) = (lLong And &HFF0000) / &H10000
bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub
Private Sub Class_Initialize()
mWnd = CreateWindowEx(0&, "Button", "Hola Mundo", WS_VISIBLE, 0&, 0&, 300, 300, 0&, 0&, App.hInstance, ByVal 0&)
If mWnd <> 0 Then Call SetSubclassing(Me, mWnd)
End Sub
Private Sub Class_Terminate()
If mWnd <> 0 Then
Call StopSubclassing(mWnd)
DestroyWindow mWnd
End If
End Sub
Temibles Lunas!¡.
En modulos clase:
Call CopyMemory(WindowProcAddress, ByVal (pVar + &H1C + (ProcIndex * 4&)), 4)
Cita de: F3B14N en 8 Mayo 2011, 18:53 PM
En modulos clase:
Call CopyMemory(WindowProcAddress, ByVal (pVar + &H1C + (ProcIndex * 4&)), 4)
excelente con el ProcIndex podremos hacer varias subclasificaciones con el codigo xD
Dulces Lunas!¡.
alguien tiene el ASM?, quiero ver que es lo que modifica/hace.
Dulces Lunas!¡.