mercoledì 9 maggio 2012

splitter horizontal from hooking mouse (with hook-subclassing shellcode)

aaaaaaaaa
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreateBitmapIndirect Lib "gdi32" (lpBitmap As BITMAP) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Const PATINVERT = &H5A0049       ' (DWORD) dest = pattern XOR dest
Private Const DSTINVERT = &H550009       ' (DWORD) dest = (NOT dest)
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Private dist As Integer

Private m_lPattern(0 To 3) As Long
Private m_hBrush As Long

Private Type BITMAP '24 bytes
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type

Private Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type


Dim cHookMouse As cHookCallback

Private Sub Form_Unload(Cancel As Integer)
    Set cHookMouse = Nothing
End Sub

Private Sub Form_Load()
    Dim tbm As BITMAP
    Dim hBm As Long
    
    Set cHookMouse = New cHookCallback
    Call cHookMouse.shk_SetHook(WH_MOUSE, , eMsgWhen.MSG_AFTER, , 1, Me)
    
   For i = 0 To 3
      m_lPattern(i) = &HAAAA5555
   Next i
   
   DestroyBrush
      
   ' Create a monochrome bitmap containing the desired pattern:
   tbm.bmType = 0
   tbm.bmWidth = 16
   tbm.bmHeight = 8
   tbm.bmWidthBytes = 2
   tbm.bmPlanes = 1
   tbm.bmBitsPixel = 1
   tbm.bmBits = VarPtr(m_lPattern(0))
   hBm = CreateBitmapIndirect(tbm)

   ' Make a brush from the bitmap bits
   m_hBrush = CreatePatternBrush(hBm)

   '// Delete the useless bitmap
   DeleteObject hBm
   
   dist = (pic2.top - pic1.Height)

End Sub

Private Sub DestroyBrush()
   If Not (m_hBrush = 0) Then
      DeleteObject m_hBrush
      m_hBrush = 0
   End If
End Sub

Private Sub PicContainer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim rc As RECT
        Dim rc2 As RECT
        
        GetWindowRect PicContainer.hwnd, rc
        GetWindowRect pic1.hwnd, rc2
        
        lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        hOldBrush = SelectObject(lhDC, m_hBrush)
        
        PicContainer.Refresh
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
        SelectObject lhDC, hOldBrush
        DeleteDC lhDC
    End If
End Sub

Private Sub PicContainer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim rc As RECT
        Dim rc2 As RECT
        
        GetWindowRect PicContainer.hwnd, rc
        GetWindowRect pic1.hwnd, rc2
        
        lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        hOldBrush = SelectObject(lhDC, m_hBrush)
        
        PicContainer.Refresh
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
        SelectObject lhDC, hOldBrush
        DeleteDC lhDC
        
        mouse_y = y
        If y < 10 Then Exit Sub
        If y >= PicContainer.Height - 10 Then Exit Sub
        pic1.Height = y
        pic2.top = pic1.Height + dist
        pic2.Height = PicContainer.Height - pic1.Height - dist
        
    End If
End Sub

Private Sub PicContainer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim rc As RECT
        Dim rc2 As RECT
        
        GetWindowRect PicContainer.hwnd, rc
        GetWindowRect pic1.hwnd, rc2
        
        lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        hOldBrush = SelectObject(lhDC, m_hBrush)
        
        PicContainer.Refresh
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT 'doppio si riazzera
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
        SelectObject lhDC, hOldBrush
        DeleteDC lhDC
    End If
End Sub

' ordinal #1 from vtable function VB (subclassing shellcode)
Private Sub HookProcMouse(ByVal bBefore As Boolean, _
                        ByRef bHandled As Boolean, _
                        ByRef lReturn As Long, _
                        ByVal nCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long, _
                        ByVal lHookType As eHookType, _
                        ByRef lParamUser As Long)

        If nCode > 0 Then
            Dim hwnd As Long
            Dim pt As POINTAPI
            
            GetCursorPos pt
            hwnd = WindowFromPoint(pt.x, pt.y)
            If hwnd = frm.PicContainer.hwnd Then
                MousePointer = 99
                MouseIcon = imgCursorSplitterHorizontal.Picture
            Else
                MousePointer = 0
            End If
        End If
End Sub

Nessun commento:

Posta un commento