Option Explicit
' By音符，QQ：337855632 Time:2020-03-17 功能定制：20元起
Class Window_Class
    Private PostMessage, SendMessage, KMMessage
    Private EnumS, Sleep
    Public Property Let Delay(iTime) '设置LeftClick KeyPress间隔
        Sleep = iTime
    End Property
    Public Property Let Async(IsAsync) '设置鼠标键盘是否异步
        If CBool(IsAsync) Then KMMessage = PostMessage Else KMMessage = SendMessage
    End Property
    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
    Private Function SetArgs(ClassName, text, mode)
        Dim h
        Set SetArgs = Api.Malloc(15)
        h = 0
        If VarType(text) <> 8 Then
            If text = 0 Then h = 1 Else text = CStr(text)
        End If
        If h = 0 Then SetArgs.SetVal(0, 4) = Api.StrPtr(text)
        h = 0
        If VarType(ClassName) <> 8 Then
            If ClassName = 0 Then h = 1 Else ClassName = CStr(ClassName)
        End If
        If h = 0 Then SetArgs.SetVal(4, 4) = Api.StrPtr(ClassName)
        SetArgs.SetVal(8, 4) = mode
    End Function
    Private Sub SetEnum(hWndParent, ClassName, text, mode, Args)
        Dim CallBack
        Set Args = SetArgs(ClassName, text, mode)
        Set CallBack = Api.CallBack(Me, "EnumChildProc", 2) '回调对象 方法 参数个数
        If mode And &H4000 Then
            Call Api.ECall("user32", "EnumThreadWindows", hWndParent, CallBack.GetPtr(0), Args.GetPtr(0))
        Else
            Call Api.ECall("user32", "EnumChildWindows", hWndParent, CallBack.GetPtr(0), Args.GetPtr(0))
        End If
    End Sub
    Public Function FindEx(ByVal hWndParent, ByVal ClassName, ByVal text, ByVal mode)
        Dim Args, h
        If mode And 1024 Then    '仅下级
            FindEx = 0
            Args = EnumWindows(hWndParent, ClassName, text, mode Or &H20000)
            If UBound(Args) >= 0 Then FindEx = Args(0)
        Else  '所有子窗口
            SetEnum hWndParent, ClassName, text, mode, Args
            FindEx = Args.Read(12, 4)
        End If
    End Function
    Public Function EnumWindows(ByVal hWndParent, ByVal ClassName, ByVal text, ByVal mode) '下级子窗口
        Dim h, Args, ret
        Dim WText, WClass
        Set Args = SetArgs(ClassName, text, mode)
        If mode And 2 Then WText = 0 Else WText = text
        If mode And 8 Then WClass = 0 Else WClass = ClassName
        ret = Array()  'Ubound=-1
        Do
            h = Api.ECall("user32", "FindWindowExW", hWndParent, h, WClass, WText)
            If EnumChildProc(h, Args.GetPtr(0)) = 0 Then
                ReDim Preserve ret(UBound(ret) + 1)
                ret(UBound(ret)) = Args.Read(12, 4)
                If mode And &H20000 Then Exit Do
            End If
        Loop While h > 0
        EnumWindows = ret
    End Function
    Public Function EnumWindowsEx(ByVal hWndParent, ByVal ClassName, ByVal text, ByVal mode)  '全部子窗口
        Dim Args, h
        EnumS = Array()
        SetEnum hWndParent, ClassName, text, mode Or &H10000, Args
        EnumWindowsEx = EnumS
        EnumS = Empty
    End Function
    Public Function EnumChildProc(ByVal hWnd, ByVal lParam)  'mode 1:保留 2:标题模糊 4:标题不分大小写'
        Dim stmp, text, mode, h
        EnumChildProc = 1
        If hWnd = 0 Then Exit Function
        mode = Api.ReadMem(lParam + 8)
        h = Api.ReadMem(lParam + 4)
        If h Then
            stmp = Api.PtrToBStr(h)
            text = GetClass(hWnd)
            If mode And 16 Then '类名忽略大小写
                stmp = UCase(stmp)
                text = UCase(text)
            End If
            If mode And 8 Then '类名模糊
                If Not Api.iLike(text, stmp) Then Exit Function
            ElseIf stmp <> text Then
                Exit Function
            End If
        End If
        h = Api.ReadMem(lParam)
        If h Then
            stmp = Api.PtrToBStr(h)
            If mode And 128 Then
                text = Space(2550)
                text = Left(text, Api.ECall(SendMessage, False, hWnd, &HD, Len(text), text))
            Else
                text = GetText(hWnd)
            End If
            If mode And 4 Then  '标题忽略大小写
                stmp = UCase(stmp)
                text = UCase(text)
            End If
            If mode And 2 Then  '标题模糊
                If Not Api.iLike(text, stmp) 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
        If mode And &H10000 Then
            h = UBound(EnumS) + 1
            ReDim Preserve EnumS(h)
            EnumS(h) = hWnd
        Else
            EnumChildProc = 0
            Call Api.ECall("kernel32", "RtlMoveMemory", lParam + 12, Api.GetPtr(hWnd) + 8, 4)
        End If
    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(KMMessage, False, hWnd, WM_MOUSEMOVE, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub LeftClick(hWnd, x, y)
        Dim i
        LeftDown hWnd, x, y
        i = SleepTime()
        LeftUp hWnd, x, y
        Api.Delay i
    End Sub
    Public Sub LeftDown(hWnd, x, y)
        Const WM_LBUTTONDOWN = &H201
        Call Api.ECall(KMMessage, 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(KMMessage, False, hWnd, WM_LBUTTONUP, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub RightClick(hWnd, x, y)
        Dim i
        RightDown hWnd, x, y
        i = SleepTime()
        RightUp hWnd, x, y
        Api.Delay i
    End Sub
    Public Sub RightDown(hWnd, x, y)
        Const WM_RBUTTONDOWN = &H204
        Call Api.ECall(KMMessage, 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(KMMessage, False, hWnd, WM_RBUTTONUP, 0, (x And &HFFFF) + (y And &HFFFF) * &H10000)
    End Sub
    Public Sub KeyPress(hWnd, Key)
        Dim i
        KeyDown hWnd, Key
        i = SleepTime()
        KeyUp hWnd, Key
        Api.Delay i
    End Sub
    Public Sub KeyDown(hWnd, Key)
        Const WM_KEYDOWN = &H100
        Call Api.ECall(KMMessage, False, hWnd, WM_KEYDOWN, Key, 0)
    End Sub
    Public Sub KeyUp(hWnd, Key)
        Const WM_KEYUP = &H101
        Call Api.ECall(KMMessage, False, hWnd, WM_KEYUP, Key, 0)
    End Sub
    Public Sub SendString(hWnd, Str)
        Dim i, Data
        Const WM_CHAR = 258
        Set Data = Api.Malloc
        Data.FromString = Str
        ' Data = Data.ToArray
        ' For i = 0 To UBound(Data)
        '   Call Api.ECall(KMMessage, False, hWnd, WM_CHAR, Data(i), 0)
        ' Next
        For i = 0 To Data.Size
          Call Api.ECall(KMMessage, False, hWnd, WM_CHAR, Data.Read(i, 1), 0)
        Next
    End Sub
    Private Function SleepTime()
        Dim t, i
        t = Split(Sleep, "-")
        i = UBound(t)
        If i > 0 Then
            Api.Delay Int((t(1) - t(0) + 1) * Rnd(1) + t(0))
            If i > 2 Then
                SleepTime = Int((t(3) - t(2) + 1) * Rnd(3) + t(2))
            ElseIf i > 1 Then
                SleepTime = t(2)
            End If
        Else
            Api.Delay Sleep
        End If
    End Function
    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
        'Call Api.ECall("user32.dll", "UpdateWindow", hWnd)
    End Sub
    Public Sub SetState(ByVal hWnd, ByVal State)
        Select Case State
        Case 0 '关闭窗口

        Case 1 '激活窗口

        Case 2 '最小化窗口

        Case 3 '最小化窗口并释放内存

        Case 4 '最大化窗口

        Case 5 '还原窗口

        Case 6 '隐藏窗口

        Case 7 '使窗口可见

        Case 8 '使窗口置顶

        Case 9 '取消窗口置顶

        Case 10 '使窗口不可用

        Case 11 '使窗口可用

        Case 12 '窗口只读（用于文本框）

        Case 13 '取消窗口只读（用于文本框）

        Case 14 '使窗口闪烁

        Case 15 '强制关闭窗口
            State = GetInfo(hWnd, 3)
            State = Api.ECall("kernel32", "OpenProcess", 1, False, State)
            Call Api.ECall("kernel32", "TerminateProcess", State, 0)
            Call Api.ECall("kernel32", "CloseHandle", State)
        End Select
    End Sub
    Public Function GetState(ByVal hWnd, ByVal State)
        Select Case State
        Case 0 '是否存在
            GetState = Api.ECall("user32", "IsWindow", hWnd)
        Case 1 '是否处于激活

        Case 2 '是否可见
            GetState = Api.ECall("user32", "IsWindowVisible", hWnd)
        Case 3 '是否最小化

        Case 4 '是否最大化

        Case 5 '是否置顶

        Case 6 '是否无响应
            GetState = Api.ECall("user32", "IsHungAppWindow", hWnd)
        End Select
    End Function
    Public Function GetInfo(ByVal hWnd, ByVal Info)
        Dim pszText
        pszText = Space(255)
        Info = CLng(Info)
        Select Case Info
        Case 0 '窗口文本
            GetInfo = Left(pszText, Api.ECall(SendMessage, False, hWnd, &HC, pszText, Len(pszText)))
        Case 1 '窗口类名
            GetInfo = GetClass(hWnd)
        Case 2 '线程ID

        Case 3 '进程ID
            Call Api.ECall("user32", "GetWindowThreadProcessId", hWnd, Api.VarPtr(Info) + 8)
            GetInfo = Info
        Case 4 '窗口标识符

        Case 5 '程序路径

        Case 6 '进程名

        End Select
    End Function
    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.Read(0, 4)
        y1 = RECT.Read(4, 4)
        x2 = RECT.Read(8, 4)
        y2 = RECT.Read(12, 4)
    End Sub
    
    Public Sub TimerProc(hWnd, uMsg, idEvent, dwTime, user)
        Dim i, j, text, txt
        i = CLng(0)
        j = CLng(0)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", Api.VarPtr(i) + 8, user, 4)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", Api.VarPtr(j) + 8, user + 4, 4)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", Api.VarPtr(uMsg) + 8, user + 8, 4)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", Api.VarPtr(hWnd) + 8, user + 12, 4)
        j = j - 1
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", user + 4, Api.VarPtr(j) + 8, 4)
        If hWnd = 0 Then
            hWnd = Api.ECall("user32", "FindWindowW", "#32770", CStr(Api.PtrToBStr(i)))
            Call Api.ECall("kernel32.dll", "RtlMoveMemory", user + 12, Api.VarPtr(hWnd) + 8, 4)
        End If
        If uMsg And &H1000000 Then
            hWnd = Api.ECall("user32", "FindWindowExW", hWnd, 0, "Static", 0)
            text = GetText(hWnd)
            text = Left(text, InStrRev(text, "(")) & j & ")"
        ElseIf uMsg And &H2000000 Then
            hWnd = Api.ECall("user32", "FindWindowExW", hWnd, 0, "Button", 0)
            text = Split(GetText(hWnd), " = ")(0) & " = " & j
        Else
            txt = Api.PtrToBStr(i)
            text = Left(txt, InStrRev(txt, "(")) & j & Mid(txt, InStrRev(txt, ")")) & Chr(0)
            Call Api.ECall("kernel32.dll", "RtlMoveMemory", i, text, Len(text))
        End If
        Call Api.ECall("user32.dll", "SetWindowTextW", hWnd, text)
    End Sub
    Public Function MessageBox(ByVal hWnd, ByVal lpText, ByVal lpCaption, ByVal wType, ByVal timeOut)
        If timeOut <= 0 Then
            MessageBox = Api.ECall("user32.dll", "MessageBoxW", hWnd, CStr(lpText), CStr(lpCaption), wType)
            Exit Function
        End If
        Dim Memory, user, j
        timeOut = CLng(timeOut)
        wType = CLng(wType)
        user = Api.ECall("kernel32.dll", "LocalAlloc", 0, 16)
        Set Memory = Api.CallBack(Me, "TimerProc", 4, user)
        If wType And &H1000000 Then
            lpText = lpText & " (" & timeOut & ")"
        ElseIf wType And &H2000000 Then
        Else
            lpCaption = lpCaption & " (" & timeOut & ")"
        End If
        lpCaption = lpCaption & Chr(28) & Chr(29) & Chr(30) & Chr(31) & Chr(0) & user
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", user, Api.VarPtr(Api.StrPtr(lpCaption)) + 8, 4)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", user + 4, Api.VarPtr(timeOut) + 8, 4)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", user + 8, Api.VarPtr(wType) + 8, 4)
        Call Api.ECall("kernel32.dll", "RtlMoveMemory", user + 12, Api.VarPtr(CLng(0)) + 8, 4)
        j = Api.ECall("user32.dll", "SetTimer", 0, user, 1000, Memory.GetPtr(0))

        MessageBox = Api.ECall("user32.dll", "MessageBoxTimeoutW", hWnd, CStr(lpText), CStr(lpCaption), wType, 0, timeOut * 1000)
        Call Api.ECall("user32.dll", "KillTimer", 0, j)
        Call Api.ECall("kernel32.dll", "LocalFree", user)
    End Function

    Private Sub Class_Initialize()
        Dim hModule
        hModule = "user32"
        PostMessage = Api.ProcAddress(hModule, "PostMessageW")  '参数1 模块地址/Dll路径 返回模块地址'
        SendMessage = Api.ProcAddress(hModule, "SendMessageW")
        Async = True
        Call Api.ProcAddress(-hModule)  'FreeLibrary'
    End Sub
End Class