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
Linguaggio macchina,Kernel,Driver,Debugger user-mode/kernel-mode,Sistemi Operativi,Debugger,Visual Basic 6,C,C++,Nasm,Masm,Winsock,Socket,Sniffer; Cinema,Sceneggiature,Script,Movie,Films,Strutture narrative,Melanie Anne Phillips,Syd Field,Robert McKee...
mercoledì 9 maggio 2012
splitter horizontal from hooking mouse (with hook-subclassing shellcode)
Iscriviti a:
Commenti sul post (Atom)
Nessun commento:
Posta un commento