[VB6] API를 이용한 로우 레벨 마우스 후킹 프로그램 소스

마우스에 이벤트가 발생하면 그것을 잡아서 폼의 listbox에 뿌려주는...    프로그램입니다.

필요한 것은 폼하나 만들고  listbox 이름을 lstActions 으로 만들어 주면 프로그램 구성은 끝이고.. 실행을 해보면 마우스가 어디에 위치하는지. 어떤 이벤트가 발생하는 지를 알수 있습니다.

이러한 프로그램을 응용하면  automouse 프로그램도 제작이 가능할것입니다

저 이프로그램이 제공하는 마우스 좌표를 이용해여 매일 아침마다 하는 귀찮은 업무들을 클릭한번으로 해결해버리는 프로그램을 만들어 사용중입니다.    참고하시기 바랍니다.

< 모듈부분 >

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long

Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long

Private Const WH_MOUSE_LL As Long = 14

Private Const HC_ACTION As Long = 0

Private Const WM_LBUTTONDOWN = &H201

Private Const WM_LBUTTONUP = &H202

Private Const WM_RBUTTONDOWN = &H204

Private Const WM_RBUTTONUP = &H205

Private Const WM_MOUSEMOVE = &H200

Private Const WM_MOUSEWHEEL As Long = &H20A

Private hHook As Long

Type pointapi

    x As Long

    y As Long

    

    End Type

    

Public Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim pt As pointapi

    

    If nCode = HC_ACTION Then

        Select Case wParam

            Case WM_LBUTTONDOWN

                frmSpy.AddNewActionLog "왼쪽 마우스 버튼 누름"

            Case WM_LBUTTONUP

                frmSpy.AddNewActionLog "왼쪽 마우스 버튼 뗌"

            Case WM_RBUTTONDOWN

                frmSpy.AddNewActionLog "오른쪽 마우스 버튼 누름"

            Case WM_RBUTTONUP

                frmSpy.AddNewActionLog "오른쪽 마우스 버튼 뗌"

            Case WM_MOUSEMOVE

                frmSpy.AddNewActionLog "마우스 움직임"

                Call GetCursorPos(pt)

                

                frmSpy.Label5.Caption = pt.x

                frmSpy.Label6.Caption = pt.y

                

            Case WM_MOUSEWHEEL

                frmSpy.AddNewActionLog "마우스 휠 움직임"

            Case Else

                frmSpy.AddNewActionLog "알 수 없는 동작"

        End Select

    End If

    LowLevelMouseProc = CallNextHookEx(hHook, nCode, wParam, ByVal lParam)

End Function

Public Sub InstallHook()

    If hHook Then DeleteHook ' 만일 기존에 후킹을 하고 있었다면, 제거하여 충돌이 일어나지 않도록 합니다.

    hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.hInstance, ByVal 0&) ' 후킹을 설치합니다.

    If hHook = 0 Then Err.Raise 444, "InstallHook()", "InstallHook() 메서드 오류: 후킹 설치에 실패"

End Sub

Public Sub DeleteHook()

    If hHook Then

        UnhookWindowsHookEx hHook& ' 후킹을 제거합니다.

        hHook = 0 ' 후킹 핸들 변수를 초기화합니다.

    End If

End Sub

<form 코딩>

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO

    dwOSVersionInfoSize As Long

    dwMajorVersion As Long

    dwMinorVersion As Long

    dwBuildNumber As Long

    dwPlatformId As Long

    szCSDVersion As String * 128

End Type

Public Sub AddNewActionLog(ByVal sAction As String) ' 액션을 사용자에게 알리는 Sub-Procedure

    Static iAction As Long: iAction = iAction + 1

    With lstActions

        .AddItem iAction & "] " & sAction

        .ListIndex = .ListCount - 1

    End With

End Sub

Private Sub Form_Load()

    Dim OSV As OSVERSIONINFO

    If App.LogMode = 0 Then

        MsgBox "이 예제는 IDE 모드에서 실행시킬 수 없습니다. 실행화일로 실행하세요.", vbCritical, "오류"

        End

        Exit Sub

    End If

    OSV.dwOSVersionInfoSize = Len(OSV)

    If GetVersionEx(OSV) Then

        If OSV.dwMajorVersion < 4 Then   ' 로우 레벨 마우스 후킹은 Windows NT 이상에서만 지원합니다.

            MsgBox "이 예제는 Windows NT 하위 버젼에서 실행할 수 없습니다.", vbCritical, "오류"

            End

            Exit Sub

        End If

    Else

        MsgBox "운영체제의 버젼을 불러오는 데에 실패했습니다. 예제가 정상 작동하지 않을 수 있습니다.", vbExclamation, "경고"

    End If

    InstallHook   ' 로우 레벨 마우스 훅을 설치합니다.

    DoEvents

End Sub

Private Sub Form_Unload(Cancel As Integer)

    DeleteHook    ' 훅을 제거합니다.

End Sub