Mensajes

Muy buen tip Karcrack

Saludos.

GetCursor es solo valido para la instancia para el cursor en general usa GetCursorInfo, en este caso no te serviria de nada subclasificar quizas hooks sea lo mas apropiado.

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function GetCursorInfo Lib "user32.dll" (ByRef pci As PCURSORINFO) As Long

Private Type POINTAPI
    x               As Long
    y               As Long
End Type

Private Type PCURSORINFO
    cbSize          As Long
    flags           As Long
    hCursor         As Long
    ptScreenPos     As POINTAPI
End Type


Dim CI As PCURSORINFO
Dim hMemCursor As Long


Private Sub Form_Load()
    CI.cbSize = Len(CI)
    GetCursorInfo CI
    hMemCursor = CI.hCursor
   
    Timer1.Interval = 10
End Sub

Private Sub Timer1_Timer()
    CI.cbSize = Len(CI)
    GetCursorInfo CI
       
    If hMemCursor <> CI.hCursor Then
          hMemCursor = CI.hCursor
          Me.Print hMemCursor
    End If
End Sub


Hola, Cobein hizo un modulo clase para leer un .rtf y mostrarlo en un richtextbox creado con apis. pero bueno si vos necesitas las propiedades para modificar el texto y decorarlo ya vas a tener que investigar un poco sobre el tema. hay algo de información en la web.

este es el link de la clase
http://www.advancevb.com.ar/code/RTBOF.rar

Saludos.

[clase]

hola Agrega un modulo clase con el nombre "ClsMouseWheel"

dentro de este modulo

Código (vb) [Seleccionar] Expandir

]
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 Const WM_MOUSEWHEEL As Long = &H20A


Private pASMWrapper As Long
Private PrevWndProc As Long
Private hSubclassedWnd As Long

Public Event MOUSEWHEEL(ByVal wParam As Long)

Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    WindowProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
   
    If Msg = WM_MOUSEWHEEL Then
        RaiseEvent MOUSEWHEEL(wParam)
    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
    Dim i As Long
    Dim sCode As String
   
    pASMWrapper = VirtualAlloc(ByVal 0&, 104, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If pASMWrapper <> 0 Then

        ThisClass = ObjPtr(Me)
        Call CopyMemory(pVar, ByVal ThisClass, 4)
        Call CopyMemory(CallbackFunction, ByVal (pVar + 28), 4)
        pVirtualFree = GetProcAddress(GetModuleHandle("kernel32.dll"), "VirtualFree")

        sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
                "0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
               
        For i = 0 To Len(sCode) - 1 Step 2
            ASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
        Next

        Call CopyMemory(ASM(3), pASMWrapper + 96, 4)
        Call CopyMemory(ASM(40), pASMWrapper + 96, 4)
        Call CopyMemory(ASM(58), pASMWrapper + 96, 4)
        Call CopyMemory(ASM(45), pASMWrapper + 100, 4)
        Call CopyMemory(ASM(84), pASMWrapper, 4)
        Call CopyMemory(ASM(27), ThisClass, 4)
        Call CopyMemory(ASM(32), CallbackFunction, 4)
        Call CopyMemory(ASM(90), pVirtualFree, 4)
        Call CopyMemory(ByVal pASMWrapper, ASM(0), 104)

    End If

End Sub

Private Sub Class_Terminate()

    If pASMWrapper <> 0 Then
        Call StopSubclassing
        Call CopyMemory(ByVal (pASMWrapper + 108), 1, 4)
    End If

End Sub


y en el formulario

Código (vb) [Seleccionar] Expandir


Option Explicit
Private WithEvents cRuedaRaton As ClsMouseWheel

Private Sub cRuedaRaton_MOUSEWHEEL(ByVal wParam As Long)
    If wParam > 0 Then
        MsgBox "Rueda Girada hacia Arriba"
    Else
        MsgBox "Rueda Girada hacia Abajo"
    End If
End Sub

Private Sub Form_Load()
    Set cRuedaRaton = New ClsMouseWheel
    cRuedaRaton.SetSubclassing Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    cRuedaRaton.StopSubclassing
    Set cRuedaRaton = Nothing
End Sub


Saludos.

ya que se sale el tema, pregunto con respecto a valores numericos con los singnos.

he visto que cuando se utiliza una API muchas veces en los valores nulos (cero u otros tambien)  se los pasa con los singos

por ejemplo

Código [Seleccionar] Expandir

SendMessage THWnd, WM_KEYDOWN, VK_R, 0&

al cero se lo marca como un long

ahora si yo ago esto, es nesesario, esta bien o esta mal?

Código [Seleccionar] Expandir


dim Valor as  long

Valor = 5&

o esto

Código [Seleccionar] Expandir

dim B() as byte

redim B(0&)

Saludos.

Sonic88 , el error seguramente es porque haces referencia al parent, o el extender en algun lugar seguramente lo puede solucionar con

If Ambient.UserMode Then

si no funciona pone la linea del error

Saludos.

esa funcion lo que hace es evitar mostrar los errores de javascript, no te va a quitar el sonido del click si es lo que piensas.

Saludos.

hola, no entendí bien su pregunta, pero no creo que pueda funcionar con multiThread este modulo es para cosas pequeñas, el envio de datos masivos podría provocar la mezcla de datos. y además el envío de datos es sincronizado. usted no puede enviar mas de un dato a al mismo tiempo.

quizás adaptando el modulo a sus necesidades podría lograr lo que buzca.

Saludos.

Es posible que no funcionase por que intentaba ejecutar el server en un windows 7, si alguien puede probarlo en ese SO y decir si funciona.

No no tiene nada que ver, deberia funcionar bien. lo podes ver en las capturas que puse

Saludos.

La capcha no va a funcionar porque el servidor esta con unos problemas con la libreria GD o la que utilizar para los textos,  asi por unos dias esta out.

Saludos.