Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

javaSpy

Browsing clsWindowObject.vb (30.01 KB)

Option Explicit On

Imports System.Diagnostics

Public NotInheritable Class clsWindowObject

    Private Declare Function BringWindowToTop Lib "user32" Alias "BringWindowToTop" (ByVal hWnd As Integer) As Integer
    Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Integer, ByVal fEnable As Integer) As Integer
    Private Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent As Integer, ByVal lpEnumFunc As EnumWindowsProc, ByVal lParam As EnumCallbackProc) As Integer
    Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWindowsProc, ByVal lParam As EnumCallbackProc) As Integer
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
    Private Declare Function FlashWindow Lib "user32" (ByVal hWnd As Integer, ByVal bInvert As Integer) As Integer
    Private Declare Function GetActiveWindowApi Lib "user32" Alias "GetActiveWindow" () As Integer
    Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
    Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Integer, ByRef lpRect As RECT) As Integer
    Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Integer, ByVal lpFileName As String, ByVal nSize As Integer) As Integer
    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function GetTopWindowApi Lib "user32" Alias "GetTopWindow" (ByVal hWnd As Integer) As Integer
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Integer, ByRef lpRect As RECT) As Integer
    Private Declare Function GetWindowRgn Lib "user32" (ByVal hWnd As Integer, ByVal hRgn As Integer) As Integer
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Integer) As Integer
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Integer, ByRef lpdwProcessId As Integer) As Integer
    Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Integer, ByRef lpRect As RECT, ByVal bErase As Integer) As Integer
    Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function IsWindowApi Lib "user32" Alias "IsWindow" (ByVal hWnd As Integer) As Integer
    Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Integer, ByVal wMapType As Integer) As Integer
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Declare Function RealChildWindowFromPoint Lib "user32" (ByVal hWnd As Integer, ByVal ptParentClientCoords As POINTAPI) As Integer
    Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Integer, ByRef lpPoint As POINTAPI) As Integer
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
    Private Declare Function SendMessageByRef Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As IntPtr) As Integer
    Private Declare Function SendMessageByInteger Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Declare Function SendMessageByIntegerByRef Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Integer) As Integer
    Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
    Private Declare Function SendMessageByStringByRef Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As String) As Integer
    Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Integer, ByVal hWndNewParent As Integer) As Integer
    Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal CX As Integer, ByVal CY As Integer, ByVal wFlags As Integer) As Integer
    Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Integer, ByVal nCmdShow As Integer) As Integer
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Integer, ByVal yPoint As Integer) As Integer
    Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Integer) As Integer

    Private Const GWL_HINSTANCE = -6
    Private Const GWL_STYLE = -16

    Private Const WS_CHILD = &H40000000

    Private Const HWND_TOPMOST = -1
    Private Const HWND_NOTOPMOST = -2
    Private Const SWP_NOACTIVATE = &H10
    Private Const SWP_NOMOVE = &H2
    Private Const SWP_NOSIZE = &H1

    Private Const WM_SETTEXT = &HC
    Private Const WM_GETTEXT = &HD
    Private Const WM_CLOSE = &H10
    Private Const WM_GETTEXTLENGTH = &HE

    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_LBUTTONUP = &H202
    Private Const WM_LBUTTONDBLCLK = &H203
    Private Const WM_RBUTTONDOWN = &H204
    Private Const WM_RBUTTONUP = &H205
    Private Const WM_RBUTTONDBLCLK = &H206
    Private Const WM_KEYUP = &H101
    Private Const WM_KEYDOWN = &H100
    Private Const WM_CHAR = &H102
    Private Const VK_SPACE = &H20

    Private Structure RECT
        Dim Left As Integer
        Dim Top As Integer
        Dim Right As Integer
        Dim Bottom As Integer
    End Structure

    Private Structure POINTAPI
        Dim X As Integer
        Dim Y As Integer
    End Structure

    Public Enum WindowStates
        SW_HIDE = 0
        SW_NORMAL = 1
        SW_MAXIMIZE = 3
        SW_SHOW = 5
        SW_MINIMIZE = 6
        SW_RESTORE = 9
    End Enum

    Public Enum ClickButtonMethods
        BTN_DEFAULT = 0
        BTN_LBTN_DOWN = 1
        BTN_LBTN_UP = 2
        BTN_LBTN_DBLCLICK = 3
        BTN_RBTN_DOWN = 4
        BTN_RBTN_UP = 5
        BTN_RBTN_DBLCLICK = 6
    End Enum

    Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Integer) As Integer
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Integer) As Integer
    Private Declare Function GetClipRgn Lib "gdi32" (ByVal hDC As Integer, ByVal hRgn As Integer) As Integer
    Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Integer) As Integer
    Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Integer) As Integer
    Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
    Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hDC As Integer, ByVal hRgn As Integer) As Integer
    Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
    Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Integer, ByVal nDrawMode As Integer) As Integer

    Private Const DRAWSTYLE_SOLID = 0
    Private Const DRAWSTYLE_INVERT = 6
    Private Const NULL_BRUSH = 5

    Public Const INVERT_BORDER_SIZE = 4

    Public Delegate Function EnumWindowsProc(ByVal hWnd As Integer, ByVal lParam As EnumCallbackProc) As Integer
    Public Delegate Function EnumCallbackProc(ByVal thisWindow As clsWindowObject) As Integer

    Private _topMost As Boolean = False

    Public ReadOnly hWnd As Integer = 0
    Public ReadOnly hInstance As Integer = 0
    Public ReadOnly ClassName As String = ""
    Public ReadOnly ModuleFilename As String = ""
    Public ReadOnly ThreadId As Integer = 0
    Public ReadOnly ProcessId As Integer = 0

    Public Const SENDKEYS_INTERVAL = 10

    Public Sub New(ByVal WindowLocation As Point)

        Me.New(WindowFromPoint(WindowLocation.X, WindowLocation.Y))

    End Sub

    Public Sub New(ByVal ClassName As String, ByVal WindowText As String)

        Me.New(FindWindow(ClassName, WindowText))

    End Sub

    Public Sub New(ByVal hWnd As IntPtr)

        Me.New(hWnd.ToInt32)

    End Sub

    Public Sub New(ByVal hWnd As Integer)

        Me.hWnd = hWnd

        If Me.IsWindow Then

            Me.ClassName = Strings.Space(255)
            GetClassName(hWnd, Me.ClassName, Me.ClassName.Length)
            If Me.ClassName.Contains(vbNullChar) Then _
                Me.ClassName = Me.ClassName.Substring(0, Me.ClassName.IndexOf(vbNullChar))

            Me.hInstance = GetWindowLong(hWnd, GWL_HINSTANCE)
            If Me.hInstance Then
                Me.ModuleFilename = Strings.Space(255)
                GetModuleFileName(Me.hInstance, Me.ModuleFilename, Me.ModuleFilename.Length)
                Me.ModuleFilename = Me.ModuleFilename.Trim
            End If

            ThreadId = GetWindowThreadProcessId(hWnd, ProcessId)

        End If

    End Sub

    Public ReadOnly Property IsWindow() As Boolean
        Get
            Return CBool(IsWindowApi(hWnd))
        End Get
    End Property

    Public Property hWndParent() As Integer
        Get
            Return GetParent(hWnd)
        End Get
        Set(ByVal value As Integer)
            SetParent(hWnd, value)
        End Set
    End Property

    Public Property Parent() As clsWindowObject
        Get
            Return New clsWindowObject(GetParent(hWnd))
        End Get
        Set(ByVal value As clsWindowObject)
            SetParent(hWnd, value.hWnd)
        End Set
    End Property

    Public Property AlwaysOnTop() As Boolean
        Get
            Return _topMost
        End Get
        Set(ByVal value As Boolean)

            _topMost = value

            Dim wFlag As Integer = 0
            If value Then
                wFlag = HWND_TOPMOST
            Else
                wFlag = HWND_NOTOPMOST
            End If

            SetWindowPos(hWnd, wFlag, 0, 0, 0, 0, _
                SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE)

        End Set
    End Property

    Public Property Text() As String
        Get

            Dim textLength As Integer = GetWindowTextLength(hWnd)
            Dim textCaption As String = Strings.Space(textLength)

            GetWindowText(hWnd, textCaption, textLength + 1)

            If textCaption.Trim = "" Then
                textLength = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
                textCaption = Strings.Space(textLength)
                SendMessageByString(hWnd, WM_GETTEXT, textLength + 1, textCaption)
            End If

            Return textCaption.Trim

        End Get
        Set(ByVal value As String)
            SendMessageByString(hWnd, WM_SETTEXT, 0, value)
        End Set
    End Property

    Public Property Enabled() As Boolean
        Get
            Return IsWindowEnabled(hWnd)
        End Get
        Set(ByVal value As Boolean)
            EnableWindow(hWnd, Math.Abs(CInt(value)))
        End Set
    End Property

    Public Property Left() As Integer
        Get
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            Return wndRect.Left
        End Get
        Set(ByVal value As Integer)
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            SetWindowPos(hWnd, 0, value, wndRect.Top, _
                wndRect.Right, wndRect.Bottom, _
                SWP_NOACTIVATE Or SWP_NOSIZE)
        End Set
    End Property

    Public Property Top() As Integer
        Get
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            Return wndRect.Top
        End Get
        Set(ByVal value As Integer)
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            SetWindowPos(hWnd, 0, wndRect.Left, value, _
                wndRect.Right, wndRect.Bottom, _
                SWP_NOACTIVATE Or SWP_NOSIZE)
        End Set
    End Property

    Public Property Width() As Integer
        Get
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            Return wndRect.Right - wndRect.Left
        End Get
        Set(ByVal value As Integer)
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            SetWindowPos(hWnd, 0, wndRect.Left, wndRect.Top, _
                value, wndRect.Bottom - wndRect.Top, _
                SWP_NOACTIVATE Or SWP_NOMOVE)
        End Set
    End Property

    Public Property Height() As Integer
        Get
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            Return wndRect.Bottom - wndRect.Top
        End Get
        Set(ByVal value As Integer)
            Dim wndRect As RECT
            GetWindowRect(hWnd, wndRect)
            SetWindowPos(hWnd, 0, wndRect.Left, wndRect.Top, _
                wndRect.Right - wndRect.Left, value, _
                SWP_NOACTIVATE Or SWP_NOMOVE)
        End Set
    End Property

    Public Property WindowState() As WindowStates
        Get
            If IsIconic(hWnd) Then
                Return WindowStates.SW_MINIMIZE
            ElseIf IsZoomed(hWnd) Then
                Return WindowStates.SW_MAXIMIZE
            Else
                Return WindowStates.SW_NORMAL
            End If
        End Get
        Set(ByVal value As WindowStates)
            ShowWindow(hWnd, value)
        End Set
    End Property

    Public Property Visible() As Boolean
        Get
            Return CBool(IsWindowVisible(hWnd))
        End Get
        Set(ByVal value As Boolean)
            If value Then
                ShowWindow(hWnd, WindowStates.SW_SHOW)
            Else
                ShowWindow(hWnd, WindowStates.SW_HIDE)
            End If
        End Set
    End Property

    Public ReadOnly Property AssemblyName() As String
        Get

            Try

                If ThreadId Then
                    Return Process.GetProcessById(ProcessId).ProcessName
                Else
                    Return ""
                End If

            Catch
                Return ""
            End Try

        End Get
    End Property

    Public ReadOnly Property HasMenu() As Boolean
        Get
            Return CBool(GetMenu(hWnd))
        End Get
    End Property

    Public ReadOnly Property HasChildren() As Boolean
        Get
            Return Not (FindWindowEx(hWnd, 0, Nothing, Nothing) = 0)
        End Get
    End Property

    Public Sub InvertBorder(Optional ByVal intBorderSize As Integer = INVERT_BORDER_SIZE)

        Dim wndRect As RECT
        GetWindowRect(hWnd, wndRect)

        Dim hRegion As Integer = CreateRectRgn(0, 0, wndRect.Right - wndRect.Left, wndRect.Bottom - wndRect.Top)
        Dim hDC As Integer = GetWindowDC(hWnd)

        Dim hOldRegion As Integer = 0
        GetClipRgn(hDC, hOldRegion)
        SelectObject(hDC, hRegion)

        Dim hPen As Integer = CreatePen(DRAWSTYLE_SOLID, intBorderSize, 0)
        Dim hOldPen As Integer = SelectObject(hDC, hPen)
        Dim hBrush As Integer = GetStockObject(NULL_BRUSH)
        Dim hOldBrush As Integer = SelectObject(hDC, hBrush)
        Dim hOldROP As Integer = SetROP2(hDC, DRAWSTYLE_INVERT)

        Dim wndDraw As RECT
        With wndDraw
            .Left = 0
            .Top = 0
            .Bottom = wndRect.Bottom - wndRect.Top
            .Right = wndRect.Right - wndRect.Left
            Rectangle(hDC, .Left, .Top, .Right, .Bottom)
        End With

        SelectObject(hDC, hOldRegion)
        SetROP2(hDC, hOldROP)
        SelectObject(hDC, hOldBrush)
        SelectObject(hDC, hOldPen)
        DeleteObject(hBrush)
        DeleteObject(hPen)
        DeleteObject(hRegion)
        ReleaseDC(hWnd, hDC)

    End Sub

    Public Sub Flash()

        ' tell the window to flash
        FlashWindow(hWnd, 1)

    End Sub

    Public Sub Close()

        ' post the quit message to the window
        PostMessage(hWnd, WM_CLOSE, 0, 0)

    End Sub

    Public Sub Refresh()

        Dim wndRect As RECT
        GetClientRect(hWnd, wndRect)

        InvalidateRect(hWnd, wndRect, 1)

    End Sub

    Public Sub Focus()

        ' set focus to this window
        SetFocus(hWnd)

    End Sub

    Public Sub Update()

        ' tell the window to redraw itself
        UpdateWindow(hWnd)

    End Sub

    Public Sub BringWindowToTop()

        ' place the window on top of the z-order
        BringWindowToTop(hWnd)

    End Sub

    Public Sub ClickButton(ByVal ClickMethod As ClickButtonMethods)

        Select Case ClickMethod

            Case ClickButtonMethods.BTN_DEFAULT
                SendMessage(hWnd, WM_KEYDOWN, VK_SPACE, Nothing)
                SendMessage(hWnd, WM_KEYUP, VK_SPACE, Nothing)
            Case ClickButtonMethods.BTN_LBTN_UP
                SendMessage(hWnd, WM_LBUTTONDOWN, 0, 0)
            Case ClickButtonMethods.BTN_LBTN_DOWN
                SendMessage(hWnd, WM_LBUTTONUP, 0, 0)
            Case ClickButtonMethods.BTN_LBTN_DBLCLICK
                SendMessage(hWnd, WM_LBUTTONDBLCLK, 0, 0)
            Case ClickButtonMethods.BTN_RBTN_UP
                SendMessage(hWnd, WM_RBUTTONDOWN, 0, 0)
            Case ClickButtonMethods.BTN_RBTN_DOWN
                SendMessage(hWnd, WM_RBUTTONUP, 0, 0)
            Case ClickButtonMethods.BTN_RBTN_DBLCLICK
                SendMessage(hWnd, WM_RBUTTONDBLCLK, 0, 0)

        End Select

    End Sub

    Public Function GetNextSibling() As clsWindowObject

        ' return next sibling
        Return New clsWindowObject(FindWindowEx( _
            hWndParent, hWnd, Nothing, Nothing))

    End Function

    Public Function GetPreviousSibling() As clsWindowObject

        ' get first child of the parent
        Dim hWndSibling As Integer = FindWindowEx(hWndParent, 0, Nothing, Nothing)
        Dim hWndLastSibling As Integer = 0

        Do While hWndSibling

            ' check sibling
            If hWndSibling = hWnd Then

                hWndSibling = hWndLastSibling
                Exit Do

            End If

            ' get next sibling
            hWndSibling = FindWindowEx(hWndParent, hWndSibling, Nothing, Nothing)

        Loop

        Return New clsWindowObject(hWndSibling)

    End Function

    Public Function GetSibling(ByVal ClassName As String, ByVal WindowText As String) As clsWindowObject

        Return New clsWindowObject(FindWindowEx(hWndParent, 0, ClassName, WindowText))

    End Function

    Public Function GetTopLevelParent() As clsWindowObject

        Dim parentWnd As Integer = hWndParent
        Dim parentWnd2 As Integer = parentWnd

        Do While parentWnd

            parentWnd2 = parentWnd
            parentWnd = GetParent(parentWnd)

        Loop

        Return New clsWindowObject(parentWnd2)

    End Function

    Public Function GetTopWindow() As clsWindowObject

        Return New clsWindowObject(GetTopWindowApi(hWnd))

    End Function

    Public Function GetFirstChild() As clsWindowObject

        ' return first child
        Return New clsWindowObject(FindWindowEx( _
            hWnd, 0, Nothing, Nothing))

    End Function

    Public Function GetLastChild() As clsWindowObject

        ' get first child
        Dim hWndChild As Integer = FindWindowEx(hWnd, 0, Nothing, Nothing)
        Dim hWndLastChild As Integer = hWndChild

        Do While hWndChild

            hWndLastChild = hWndChild

            ' get next child
            hWndChild = FindWindowEx(hWnd, hWndChild, Nothing, Nothing)

        Loop

        Return New clsWindowObject(hWndLastChild)

    End Function

    Public Function GetChild(ByVal ClassName As String, ByVal WindowText As String) As clsWindowObject

        Return New clsWindowObject(FindWindowEx(hWnd, 0, ClassName, WindowText))

    End Function

    Public Overloads Function SendMsg(ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr, Optional ByVal forceByVal As Boolean = False) As Integer

        If forceByVal Then
            Return SendMessage(hWnd, wMsg, wParam, lParam)
        Else
            Return SendMessageByRef(hWnd, wMsg, wParam, lParam)
        End If

    End Function

    Public Overloads Function SendMsgByRef(ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As IntPtr, Optional ByVal forceByVal As Boolean = False) As Integer

        If forceByVal Then
            Return SendMessage(hWnd, wMsg, wParam, lParam)
        Else
            Return SendMessageByRef(hWnd, wMsg, wParam, lParam)
        End If

    End Function

    Public Overloads Function SendMsg(ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer, Optional ByVal forceByVal As Boolean = False) As Integer

        If forceByVal Then
            Return SendMessageByInteger(hWnd, wMsg, wParam, lParam)
        Else
            Return SendMessageByIntegerByRef(hWnd, wMsg, wParam, lParam)
        End If

    End Function

    Public Overloads Function SendMsgByRef(ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Integer, Optional ByVal forceByVal As Boolean = False) As Integer

        If forceByVal Then
            Return SendMessageByInteger(hWnd, wMsg, wParam, lParam)
        Else
            Return SendMessageByIntegerByRef(hWnd, wMsg, wParam, lParam)
        End If

    End Function

    Public Overloads Function SendMsg(ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String, Optional ByVal forceByVal As Boolean = False) As Integer

        If forceByVal Then
            Return SendMessageByString(hWnd, wMsg, wParam, lParam)
        Else
            Return SendMessageByStringByRef(hWnd, wMsg, wParam, lParam)
        End If

    End Function

    Public Overloads Function SendMsgByRef(ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As String, Optional ByVal forceByVal As Boolean = False) As Integer

        If forceByVal Then
            Return SendMessageByString(hWnd, wMsg, wParam, lParam)
        Else
            Return SendMessageByStringByRef(hWnd, wMsg, wParam, lParam)
        End If

    End Function

    Public Sub PostMsg(ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer)

        PostMessage(hWnd, wMsg, wParam, lParam)

    End Sub

    Public Sub SendText(ByVal TextToSend As String, _
        Optional ByVal sendInterval As Integer = SENDKEYS_INTERVAL)

        Dim KeyCode As Integer = 0

        For i As Integer = 0 To TextToSend.Length - 1

            Dim thisChar As Char = TextToSend.Chars(i)

            If thisChar = "{" And TextToSend.IndexOf("}", i) > i Then

                Select Case TextToSend.Substring(i, TextToSend.IndexOf("}", i) - i + 1).ToUpper

                    Case "{BACKSPACE}", "{BS}", "{BKSP}" : KeyCode = 8
                    Case "{BREAK}" : KeyCode = 19
                    Case "{DELETE}", "{DEL}" : KeyCode = 46
                    Case "{DOWN}" : KeyCode = 40
                    Case "{END}" : KeyCode = 35
                    Case "{ENTER}" : KeyCode = 13
                    Case "{ESC}" : KeyCode = 27
                    Case "{HOME}" : KeyCode = 36
                    Case "{INSERT}", "{INS}" : KeyCode = 45
                    Case "{LEFT}" : KeyCode = 37
                    Case "{NUMLOCK}" : KeyCode = 144
                    Case "{PGDN}" : KeyCode = 34
                    Case "{PGUP}" : KeyCode = 33
                    Case "{PRTSC}" : KeyCode = 44
                    Case "{RIGHT}" : KeyCode = 39
                    Case "{SCROLLLOCK}" : KeyCode = 145
                    Case "{TAB}" : KeyCode = 9
                    Case "{UP}" : KeyCode = 38
                    Case "{F1}" : KeyCode = 112
                    Case "{F2}" : KeyCode = 113
                    Case "{F3}" : KeyCode = 114
                    Case "{F4}" : KeyCode = 115
                    Case "{F5}" : KeyCode = 116
                    Case "{F6}" : KeyCode = 117
                    Case "{F7}" : KeyCode = 118
                    Case "{F8}" : KeyCode = 119
                    Case "{F9}" : KeyCode = 120
                    Case "{F10}" : KeyCode = 121
                    Case "{F11}" : KeyCode = 122
                    Case "{F12}" : KeyCode = 123
                    Case "{+}" : KeyCode = 107
                    Case "{^}" : KeyCode = 94
                    Case "{%}" : KeyCode = 37

                End Select

                If KeyCode > 0 Then i = TextToSend.IndexOf("}", i)

            Else
                KeyCode = _translateKey(Asc(thisChar))
            End If

            _sendKeyApi(KeyCode, hWnd, sendInterval)

        Next

    End Sub

    Private Sub _sendKeyApi(ByVal KeyCode As Integer, ByVal hWnd As Integer, _
        Optional ByVal sendInterval As Integer = 0)

        ' get scancode for key
        Dim ScanCode As String = Hex(MapVirtualKey(KeyCode, 0))
        ScanCode = Strings.Space(2 - ScanCode.Length).Replace(" ", "0") + ScanCode

        PostMessage(hWnd, WM_KEYDOWN, KeyCode, _
            Int32.Parse("00" + ScanCode + "0001", _
            Globalization.NumberStyles.HexNumber))

        System.Threading.Thread.Sleep(sendInterval)

        If Not ((KeyCode >= 42 And KeyCode <= 57) Or _
            (KeyCode >= 64 And KeyCode <= 93) Or _
            (KeyCode >= 97 And KeyCode <= 122) Or KeyCode = 32) Then _
            PostMessage(hWnd, WM_CHAR, KeyCode, _
            Int32.Parse("00" + ScanCode + "0001", _
            Globalization.NumberStyles.HexNumber))

        PostMessage(hWnd, WM_KEYUP, KeyCode, _
            Int32.Parse("C0" + ScanCode + "0001", _
            Globalization.NumberStyles.HexNumber))

    End Sub

    Private Function _translateKey(ByVal KeyAscii As Integer) As Integer

        Select Case True

            ' numbers 0 - 9
            Case (KeyAscii >= 48 And KeyAscii <= 57) : Return 48 + (KeyAscii - 48)

                ' letters A-Z, a-z
            Case (KeyAscii >= 65 And KeyAscii <= 90) Or _
                (KeyAscii >= 97 And KeyAscii <= 122) : Return 65 + (Asc(LCase(Chr(KeyAscii))) - 97)

                ' multiply (*)
            Case KeyAscii = 42 : Return 106

                ' subtract (-)
            Case KeyAscii = 45 : Return 109

                ' addition (+)
            Case KeyAscii = 43 : Return 107

                ' decimal (.)
            Case KeyAscii = 46 : Return 110

                ' divide (/)
            Case KeyAscii = 47 : Return 111

                ' separator (_)
            Case KeyAscii = 95 : Return 108

                ' separator (_)
            Case KeyAscii = 95 : Return 108

                ' everything else
            Case Else : Return KeyAscii

        End Select

    End Function

    Public Shared Sub BeginWindowEnum(ByVal funcCallback As EnumCallbackProc)

        ' begin enumeration
        EnumWindows(AddressOf EnumWindowsFunc, funcCallback)

    End Sub

    Public Overloads Shared Sub BeginChildWindowEnum(ByVal objWindow As clsWindowObject, _
        ByVal funcCallback As EnumCallbackProc)

        BeginChildWindowEnum(objWindow.hWnd, funcCallback)

    End Sub

    Public Overloads Shared Sub BeginChildWindowEnum(ByVal hWnd As Integer, _
        ByVal funcCallback As EnumCallbackProc)

        ' begin enumeration
        EnumChildWindows(hWnd, AddressOf EnumWindowsFunc, funcCallback)

    End Sub

    Private Shared Function EnumWindowsFunc(ByVal hWnd As Integer, ByVal lParam As EnumCallbackProc) As Integer

        ' invoke the callback function
        Return lParam.Invoke(New clsWindowObject(hWnd))

    End Function

    Public Shared Function GetActiveWindow() As clsWindowObject

        ' return the active window
        Return New clsWindowObject(GetActiveWindowApi())

    End Function

    Public Shared Function GetRealWindowFromPoint(ByVal WindowLocation As Point) As clsWindowObject

        Dim hWnd As Integer = WindowFromPoint(WindowLocation.X, WindowLocation.Y)
        If hWnd Then

            If (GetWindowLong(hWnd, GWL_STYLE) Or WS_CHILD) Then

                Dim pt As POINTAPI
                pt.X = WindowLocation.X
                pt.Y = WindowLocation.Y

                ScreenToClient(hWnd, pt)

                hWnd = RealChildWindowFromPoint(hWnd, pt)
                If hWnd Then Return New clsWindowObject(hWnd)

            Else
                Return New clsWindowObject(hWnd)
            End If

        End If

        Return Nothing

    End Function

End Class

Download clsWindowObject.vb

Back to file list


Back to project page