Option Explicit
' By音符，QQ：337855632 Time:2020-03-17
Class Window_Class
    Private PostMessage, SendMessage
    Public Function GetText(ByVal hWnd)
        Dim pszText
        pszText = Space(255)
        GetText = Left(pszText, Api.ECall("user32.dll", "GetWindowTextW", hWnd, pszText, Len(pszText)))
    End Function
    Public Function GetClass(ByVal hWnd)
        Dim pszText
        pszText = Space(255)
        GetClass = Left(pszText, Api.ECall("user32.dll", "GetClassNameW", hWnd, pszText, Len(pszText)))
    End Function
    Public Function Find(ByVal ClassName, ByVal Text)
        Find = Api.ECall("user32", "FindWindowW", ClassName, Text)
    End Function
    Public Function FindEx(ByVal hWndParent, ByVal ClassName, ByVal Text, ByVal mode)
        Dim CallBack, obj, Args
        Set obj = Me
        Set Args = Api.Malloc(15)
        Args.SetVal Api.iStrPtr(Text), 0, 4
        Args.SetVal Api.iStrPtr(ClassName), 4, 4
        Args.SetVal mode, 8, 4
        Set CallBack = Api.CallBack(obj, "EnumChildProc", 2) '回调对象 方法 参数个数
        Call Api.ECall("user32", "EnumChildWindows", hWndParent, CallBack.GetPtr(0), Args.GetPtr(0))
        FindEx = Args.ReadVal(12, 4)
    End Function
    Public Function EnumWindows(ByVal hWndParent, ByVal ClassName, ByVal Text, ByVal mode)
        Dim h, Args, ret
        Dim WText, WClass
        If mode And 2 Then WText = 0 Else WText = Text
        If mode And 8 Then WClass = 0 Else WClass = ClassName
        Set Args = Api.Malloc(15)
        Args.SetVal Api.iStrPtr(Text), 0, 4
        Args.SetVal Api.iStrPtr(ClassName), 4, 4
        Args.SetVal mode, 8, 4
        h = 0
        ret = Array()  'Ubound=-1
        Do
            h = Api.ECall("user32", "FindWindowExW", 0, h, WClass, WText)
            If EnumChildProc(h, Args.GetPtr(0)) = 0 Then
                ReDim Preserve ret(UBound(ret) + 1)
                ret(UBound(ret)) = Args.ReadVal(12, 4)
            End If
        Loop While h > 0
        EnumWindows = ret
    End Function
    Public Function EnumChildProc(ByVal hWnd, ByVal lParam)  'mode 1:保留 2:标题模糊 4:标题不分大小写'
        Dim stmp, Text, mode
        mode = Api.ReadMem(lParam + 8)
        EnumChildProc = 1
        stmp = Api.PtrToBStr(Api.ReadMem(lParam + 4))
        Text = GetClass(hWnd)
        If mode And 8 Then '类名模糊
            If Not Api.iLike(Text, stmp, mode And 16) Then Exit Function
        ElseIf stmp <> vbNullString Then
            If mode And 16 Then '不区分大小写'
                If UCase(stmp) <> UCase(Text) Then Exit Function
            ElseIf stmp <> Text Then
                Exit Function
            End If
        End If
        stmp = Api.PtrToBStr(Api.ReadMem(lParam))
        Text = GetText(hWnd)
        If mode And 2 Then  '标题模糊
            If Not Api.iLike(Text, stmp, mode And 4) Then Exit Function
        ElseIf stmp <> vbNullString Then
            If mode And 4 Then '不区分大小写'
                If UCase(stmp) <> UCase(Text) Then Exit Function
            ElseIf stmp <> Text Then
                Exit Function
            End If
        End If
        If mode And 32 Then  '窗口必须可见
            If Api.ECall("user32", "IsWindowVisible", hWnd) = 0 Then Exit Function
        ElseIf mode And 64 Then  '窗口必须隐藏
            If Api.ECall("user32", "IsWindowVisible", hWnd) Then Exit Function
        End If
        EnumChildProc = 0
        Call Api.ECall("kernel32", "RtlMoveMemory", lParam + 12, Api.GetPtr(hWnd) + 8, 4)
    End Function
    Public Sub Restore(hWnd)
        Const SW_RESTORE = &H9
        Call Api.ECall("user32", "ShowWindow", hWnd, SW_RESTORE)
    End Sub
    Public Sub Active(hWnd)
        Call Api.ECall("user32", "SetForegroundWindow", hWnd)
        Call Api.ECall("user32", "SetActiveWindow", hWnd)
    End Sub
    Public Sub MoveTo(hWnd, x, y)
        Const WM_MOUSEMOVE = &H200
        Call Api.ECall(PostMessage, False, hWnd, WM_MOUSEMOVE, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub LeftClick(hWnd, x, y)
        LeftDown hWnd, x, y
        Api.Delay 10
        LeftUp hWnd, x, y
    End Sub
    Public Sub LeftDown(hWnd, x, y)
        Const WM_LBUTTONDOWN = &H201
        Call Api.ECall(PostMessage, False, hWnd, WM_LBUTTONDOWN, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub LeftUp(hWnd, x, y)
        Const WM_LBUTTONUP = &H202
        Call Api.ECall(PostMessage, False, hWnd, WM_LBUTTONUP, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub RightClick(hWnd, x, y)
        RightDown hWnd, x, y
        Api.Delay 10
        RightUp hWnd, x, y
    End Sub
    Public Sub RightDown(hWnd, x, y)
        Const WM_RBUTTONDOWN = &H204
        Call Api.ECall(PostMessage, False, hWnd, WM_RBUTTONDOWN, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub RightUp(hWnd, x, y)
        Const WM_RBUTTONUP = &H205
        Call Api.ECall(PostMessage, False, hWnd, WM_RBUTTONUP, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub KeyPress(hWnd, Key)
        KeyDown hWnd, Key
        Api.Delay 10
        KeyUp hWnd, Key
    End Sub
    Public Sub KeyDown(hWnd, Key)
        Const WM_KEYDOWN = &H100
        Call Api.ECall(PostMessage, False, hWnd, WM_KEYDOWN, Key, 0)
    End Sub
    Public Sub KeyUp(hWnd, Key)
        Const WM_KEYUP = &H101
        Call Api.ECall(PostMessage, False, hWnd, WM_KEYUP, Key, 0)
    End Sub
    Public Sub SendString(hWnd, Str)
        Dim i, Data
        Const WM_CHAR = 258
        Data = Api.StrToBytes(Str)
        While i <= UBound(Data)
          If Data(i) < 128 Then
            Call Api.ECall(PostMessage, False, hWnd, WM_CHAR, Data(i), 0)
            i = i + 1
          Else
            Call Api.ECall(PostMessage, False, hWnd, WM_CHAR, Data(i), 0)
            Call Api.ECall(PostMessage, False, hWnd, WM_CHAR, Data(i + 1), 0)
            i = i + 2
          End If
        Wend
    End Sub
    Public Sub GetWindowRect(hWnd, x1, y1, x2, y2)
        Dim RECT
        Set RECT = Api.Malloc(15)  '从0开始的哦
        Call Api.ECall("user32", "GetWindowRect", hWnd, RECT.GetPtr(0))
        Call ReadRECT(RECT, x1, y1, x2, y2)
    End Sub
    Public Sub GetClientRect(hWnd, x1, y1, x2, y2)
        Dim RECT
        Set RECT = Api.Malloc(15)  '从0开始的哦
        Call Api.ECall("user32", "GetClientRect", hWnd, RECT.GetPtr(0))
        Call ReadRECT(RECT, x1, y1, x2, y2)
    End Sub
    Public Sub Move(hWnd, x, y, Width, Height)
        Call Api.ECall("user32", "MoveWindow", hWnd, x, y, Width, Height, True)
    End Sub
    Public Sub MoveWindow(hWnd, x, y, z)
        Const SWP_NOSIZE = &H1
        Call Api.ECall("user32", "SetWindowPos", hWnd, z, x, y, 0, 0, SWP_NOSIZE)
    End Sub
    Public Sub Size(hWnd, w, h)
        Const SWP_NOMOVE = &H2
        Const SWP_NOZORDER = &H4
        Call Api.ECall("user32", "SetWindowPos", hWnd, 0, 0, 0, w, h, SWP_NOMOVE + SWP_NOZORDER)
    End Sub
    Public Sub ClientSize(hWnd,ByVal w,ByVal h)
        Call GetWH(hWnd, w, h)
        Size hWnd, w, h
    End Sub
    Public Sub ClientMove(hWnd, x, y, ByVal Width,ByVal Height)
        Call GetWH(hWnd, Width, Height)
        Move hWnd, x, y, Width, Height
    End Sub
    Public Sub SetStyle(hWnd, Style)
        Dim wStyle, eStyle, Code
        Dim x1, y1, x2, y2
        Const GWL_STYLE = -16
        Const GWL_EXSTYLE = -20
        Const WS_MAXIMIZEBOX = &H10000
        Const WS_MINIMIZEBOX = &H20000
        Const WS_SIZEBOX = &H40000
        Const WS_SYSMENU = &H80000
        Const WS_BORDER = &H800000
        Const WS_CAPTION = &HC00000
        Const WS_EX_TOOLWINDOW = &H80&
        wStyle = Api.ECall("user32", "GetWindowLongW", hWnd, GWL_STYLE)
        If Style And 1 Then
            Code = " Or "
        Else
            Code = " And Not "
        End If
        If Style And 2 Then
            wStyle = Eval(wStyle & Code & WS_MAXIMIZEBOX) '无最大化
        End If
        If Style And 4 Then
            wStyle = Eval(wStyle & Code & WS_MINIMIZEBOX) '无最小化
        End If
        If Style And 8 Then
            wStyle = Eval(wStyle & Code & WS_SIZEBOX) '不能拉伸大小
        End If
        If Style And 128 Then
            GetClientRect  hWnd, x1, y1, x2, y2
            wStyle = Eval(wStyle & Code & (WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SIZEBOX Or WS_SYSMENU Or WS_BORDER Or WS_CAPTION)) '无边框
        End If
        Call Api.ECall("user32.dll", "SetWindowLongW", hWnd, GWL_STYLE, wStyle)
        If Style And 128 Then
            ClientSize hWnd, x2 - x1, y2 - y1
        End If
        eStyle = Api.ECall("user32", "GetWindowLongW", hWnd, GWL_EXSTYLE)
        If Style And 16 Then
            If Style And 1 Then
                eStyle = eStyle And Not WS_EX_TOOLWINDOW
            Else
                eStyle = eStyle Or WS_EX_TOOLWINDOW
            End If
            Call Api.ECall("user32.dll", "SetWindowLongW", hWnd, GWL_EXSTYLE, eStyle)
        End If
    End Sub
    Private Sub GetWH(hWnd, w, h)
        Dim x1, y1, x2, y2
        Dim m1, n1, m2, n2
        GetWindowRect hWnd, x1, y1, x2, y2
        GetClientRect hWnd, m1, n1, m2, n2
        w = w + x2 - x1 - (m2 - m1)
        h = h + y2 - y1 - (n2 - n1)
    End Sub
    Private Sub ReadRECT(RECT, x1, y1, x2, y2)
        x1 = RECT.ReadVal(0, 4)
        y1 = RECT.ReadVal(4, 4)
        x2 = RECT.ReadVal(8, 4)
        y2 = RECT.ReadVal(12, 4)
    End Sub
    Private Sub Class_Initialize()
        Dim hModule
        hModule = "user32"
        PostMessage = Api.ProcAddress(hModule, "PostMessageW")  '参数1 模块地址/Dll路径 返回模块地址'
        SendMessage = Api.ProcAddress(hModule, "SendMessageW")
        Call Api.ProcAddress(-hModule)  'FreeLibrary'
    End Sub
End Class