`

vb 启动外部程序并且模拟鼠标点击

    博客分类:
  • vb
阅读更多

Imports System.Runtime.InteropServices
Imports System.Reflection
Imports System.ComponentModel
'Imports System.Runtime.InteropServices

Public Class Form1

    Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
        My.Settings.Save()
        If p.StartInfo.FileName <> "" Then
            If p.HasExited = False Then
                p.Kill()
            End If
        End If


    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        On Error Resume Next
        Me.Show()
        With ListBox1.Items
            'TextBox1.Text = "kxyt:" & My.Settings.kxytks & "----" & My.Settings.kxytjs
            'MsgBox(My.Settings.qxytks)


            .Add("千橡鱼塘(kxyt.exe):" & My.Settings.qxytks & "----" & My.Settings.qxytjs & "  耗时: " & Math.Round((CDate(My.Settings.qxytjs).Ticks - CDate(My.Settings.qxytks).Ticks) / 10 ^ 7 / 60, 2) & "分")
            .Add("开心外挂:" & My.Settings.wgks & "----" & My.Settings.wgjs & "  耗时: " & Math.Round((CDate(My.Settings.wgjs).Ticks - CDate(My.Settings.wgks).Ticks) / 10 ^ 7 / 60, 2) & "分")
            .Add("开心鱼塘:" & My.Settings.kxytks & "----" & My.Settings.kxytjs & "  耗时: " & Math.Round((CDate(My.Settings.kxytjs).Ticks - CDate(My.Settings.kxytks).Ticks) / 10 ^ 7 / 60, 2) & "分")
            .Add("小号外挂:" & My.Settings.xhwgks & "----" & My.Settings.xhwgjs & "  耗时: " & Math.Round((CDate(My.Settings.xhwgjs).Ticks - CDate(My.Settings.xhwgks).Ticks) / 10 ^ 7 / 60, 2) & "分")

        End With

    End Sub

    Public Sub yxcx(ByVal cxname As String, ByVal cxpath As String, ByVal btname As String)
        'MsgBox(cxpath + "\log")
        'End
        cxks = Now.Ticks
        pq = IntPtr.Zero
        p.StartInfo.FileName = cxname
        p.StartInfo.WorkingDirectory = cxpath
        p.StartInfo.WindowStyle = FormWindowState.Normal
        p.Start()
        p.EnableRaisingEvents = True
        p.WaitForInputIdle()

        Do While p.MainWindowTitle = ""
            Threading.Thread.Sleep(2000)
            p.Refresh()
        Loop


        Dim tt As Int32 = 1
        Do While pq.ToInt32 < 1
            Dim title As New System.Text.StringBuilder(55)
            Dim MyCallBack As New funcCallBackParent(AddressOf EnumChildWindowsProc)
            EnumChildWindows(p.MainWindowHandle, MyCallBack, IntPtr.Zero)

            'With ListBox1.Items
            '.Add("mc:" & p.MainWindowTitle)
            For Each pq1 As IntPtr In lngHWND
                '  .Add(pq1.ToString)

                GetWindowText(pq1, title, title.Capacity + 1)
                ' .Add(title.ToString)
                'MsgBox(title.ToString)

                If InStr(title.ToString, btname) > 0 Then
                    'TextBox1.Text = pq1.ToString & title.ToString
                    TextBox1.Text = p.MainWindowTitle & "正在运行"
                    pq = pq1
                    Exit For
                End If

            Next
            'End With
            If pq.ToInt32 < 1 Then
                Threading.Thread.Sleep(2000)
                p.Refresh()
            End If

            tt = tt + 1
            If tt > 5 Then
                MsgBox("无法运行")
                Exit Sub

            End If
        Loop

        PostMessage(pq, WM_LBUTTONDOWN, IntPtr.Zero, 1)
        PostMessage(pq, WM_LBUTTONUP, IntPtr.Zero, 1)
        PostMessage(p.MainWindowHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0)
        FileSystemWatcher1.Path = Trim(cxpath) + "\log"
        FileSystemWatcher1.Filter = "*.*"
        FileSystemWatcher1.EnableRaisingEvents = True

        'p.WaitForExit()
        Do
            'System.Threading.Thread.Sleep(2000)
            Application.DoEvents()
        Loop While p.HasExited = False
    End Sub

    Public Function EnumChildWindowsProc(ByVal hWndParent As IntPtr, ByVal lParam As IntPtr) As Boolean

        lngHWND.Add(hWndParent)
        EnumChildWindowsProc = True
    End Function



    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click


        My.Settings.qxytks = Now.ToString
        kxytks = Now.Ticks
        ii.StartInfo.FileName = "d:\exe\kxyt.exe"
        ii.StartInfo.WindowStyle = FormWindowState.Minimized
        ii.Start()
        Timer1.Interval = 3000
        Timer1.Enabled = True

        My.Settings.Save()
        PostMessage(ii.MainWindowHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0)
        'My.Settings.qxytjs = Now.ToString


        My.Settings.wgks = Now.ToString
        Call yxcx("F:\wg714\开心网花园农夫.exe", "F:\wg714", "开始工作")
        My.Settings.wgjs = Now.ToString

        My.Settings.kxytks = Now.ToString
        Call yxcx("F:\XXXXX.exe", "F:\dm\开心钓鱼1008", "开始")
        My.Settings.kxytjs = Now.ToString

        My.Settings.xhwgks = Now.ToString
        Call yxcx("F:\xhwg\开心网花园农夫.exe", "F:\xhwg", "开始工作")
        My.Settings.xhwgjs = Now.ToString
        My.Settings.Save()
    End Sub

    Private Sub FileSystemWatcher1_Changed(ByVal sender As System.Object, ByVal e As System.IO.FileSystemEventArgs) Handles FileSystemWatcher1.Changed

    End Sub

    Private Sub FileSystemWatcher1_Created(ByVal sender As Object, ByVal e As System.IO.FileSystemEventArgs) Handles FileSystemWatcher1.Created
        My.Settings.Save()
        'PostMessage(pq, WM_CLOSE, IntPtr.Zero, IntPtr.Zero)
        Dim t1 As DateTime = Now


        'If p.StartInfo.FileName = "F:\xhwg\开心网花园农夫.exe" Then
        'MsgBox(e.Name)

        Dim title As New System.Text.StringBuilder(55)
        Dim MyCallBack As New funcCallBackParent(AddressOf EnumChildWindowsProc)
        Do
            EnumChildWindows(p.MainWindowHandle, MyCallBack, IntPtr.Zero)

            For Each pq1 As IntPtr In lngHWND


                GetWindowText(pq1, title, title.Capacity + 1)

                If InStr(title.ToString, "距下次") > 0 Then
                    'TextBox1.Text = pq1.ToString & title.ToString
                    Exit Do

                End If

            Next
            Application.DoEvents()
        Loop
        'End If

        Do While (Now.Ticks - t1.Ticks) < (10 * 10 ^ 7)
            Application.DoEvents()
        Loop
        'MsgBox(Now.Ticks - t1.Ticks)
        If p.HasExited = False Then
            'MsgBox(pq.ToString)

            ListBox1.Items.Add(p.StartInfo.FileName() & "  运行完毕  耗时:" & Math.Round((Now.Ticks - cxks) / 10 ^ 7 / 60, 2) & "分")
            p.Kill()
            'p.Close()
        End If
        My.Settings.Save()
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If ii.HasExited = True Then
            My.Settings.qxytjs = Now.ToString
            ListBox1.Items.Add("d:\exe\kxyt.exe  运行完毕  耗时:" & Math.Round((Now.Ticks - kxytks) / 10 ^ 7 / 60, 2) & "分")
            Timer1.Enabled = False
        End If
    End Sub

    Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        kxytks = Now.Ticks
        ii.StartInfo.FileName = "d:\exe\kxyt.exe"
        ii.StartInfo.WindowStyle = FormWindowState.Minimized
        ii.Start()
        Timer1.Interval = 3000
        Timer1.Enabled = True
    End Sub
End Class


''''''''
Module Module1
    Public p As Process = New Process()
    Public ii As Process = New Process()
    Public pq As IntPtr
    Public cxks As UInt64
    Public kxytks As UInt64
    Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String)
    'Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    'Public Delegate Function EnumWindowsCallback( _
    '                   ByVal hWnd As IntPtr, _
    '                  ByVal lParam As IntPtr) As Boolean

    '<DllImport("user32.dll ")> _
    'Public Function EnumChildWindows( _
    '                   ByVal hwndParent As IntPtr, _
    '                  ByVal lpEnumFunc As EnumWindowsCallback, _
    '                 ByVal lParam As IntPtr) As Boolean
    'End Function
    'Friend Declare Function EnumChildWindows Lib "User32" (ByVal hWndParent As IntPtr, ByVal funcCallBack As funcCallBackParent, ByVal lParam As IntPtr) As Boolean
    Public Const WM_CHAR As Long = &H102
    Public Const WM_KEYDOWN = &H100
    Public Const WM_SYSKEYDOWN = &H104
    Public Const WM_CLOSE = &H10
    Public Const BM_CLICK = &HF5
    Public Const WM_LBUTTONDOWN = &H201
    Public Const WM_LBUTTONUP = &H202
    Public Const WM_SETTEXT = &HC
    Public Const WM_SYSCOMMAND = &H112
    Public Const SC_MINIMIZE = &HF020&

    Public Delegate Function funcCallBackParent(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
    Public Delegate Function funcCallBackChild(ByVal hWndParent As IntPtr, ByVal lpEnumFunc As Long, ByVal lParam As Integer) As Boolean

    ' --> EnumChildWindows matches the funcCallParent Delegate 
    Friend Declare Function EnumChildWindows Lib "User32" (ByVal hWndParent As IntPtr, ByVal funcCallBack As funcCallBackParent, ByVal lParam As IntPtr) As Boolean
    Friend Declare Function EnumWindows Lib "User32" (ByVal funcCallBack As funcCallBackParent, ByVal lParam As IntPtr) As IntPtr
    Public Declare Function GetDesktopWindow Lib "user32" () As IntPtr
    Public lngHWND As New ArrayList
    <Runtime.InteropServices.DllImport("user32.dll")> _
    Public Function GetWindowText(ByVal hWnd As IntPtr, ByVal lpWindowText As System.Text.StringBuilder, _
    ByVal nMaxCount As Integer) As Integer
    End Function


    <Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True, CharSet:=Runtime.InteropServices.CharSet.Auto)> _
    Public Function PostMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Boolean
    End Function
End Module

分享到:
评论

相关推荐

    鼠标 自动 点击 VB 源代码

    根据提供的文件信息,我们可以分析出该VB程序的主要功能是实现鼠标的自动点击操作。下面将对这段代码的关键知识点进行详细解读: ### 1. 定义类型与声明函数 #### 定义类型 - `Private Type RECT`: 定义一个矩形...

    VB编的试验赛车程序

    在赛车程序中,可能会有一个“点击开始按钮启动赛车”的Click事件处理程序。 【编程逻辑】 赛车游戏的逻辑可能包括赛车的移动、碰撞检测、得分计算等。这些都需要通过编写逻辑代码实现,例如,用循环控制赛车的...

    VB API详细教程

    2. `Shell`:执行外部程序或命令,可以用来启动其他应用程序。 3. `GetLastError`:获取最近一次系统调用的错误代码,用于调试和错误处理。 4. `FindWindow` 和 `SetWindowLong`:用于查找和修改窗口属性,例如改变...

    VB仿QQ屏幕右下角弹消息窗口

    例如,添加Click事件处理程序来响应关闭按钮的点击,或者在窗体的MouseMove事件中检查鼠标是否位于消息窗口外部,如果在外部则开始淡出并关闭窗口。 8. **代码组织与优化**:良好的代码结构和优化对于大型项目来说...

    VB6星际旅行仿真类似屏保

    例如,可以设置鼠标点击事件启动或停止动画,或者设置键盘事件控制飞船的移动方向。 4. **对象和类**:为了代码的可维护性和扩展性,可以将星体、飞船等抽象为独立的对象,每个对象有自己的属性(如位置、大小、...

    VB API实例150

    3. **用户界面控制**:例如,模拟鼠标和键盘操作,可以使用`SendInput`;控制窗口大小、位置,可以使用`SetWindowPos`。 4. **进程和线程管理**:启动、结束进程,可以使用`CreateProcess`,`TerminateProcess`;...

    仿苹果系统桌面浮动图标菜单

    这需要开发者在VB中编写相应的逻辑,如使用系统进程管理函数来启动外部程序。 【标签解析】 - **vb**:Visual Basic,微软开发的一种面向对象的编程语言,常用于创建Windows应用程序。在这个项目中,VB被用来构建...

    VByk识别答题卡颜色

    1. **mouse_event**:来自"user32"库,用于模拟鼠标事件。 2. **GetCursorPos**:同样来自"user32"库,用于获取当前鼠标光标的屏幕坐标。 3. **CreateDCA**:来自"gdi32"库,用于创建设备上下文环境。 4. **GetPixel...

    病毒攻杀编程技术资料!

    [终结进程] [自动鼠标点击模拟] [获取OS版本] [获取所有操作系统版本信息] [获取进程用户] [读取硬件信息] [调用DLL] [调用文件的属性对话框] [进程-端口-IP地址关联演示] [进程保护] [进程模块相关] [远程注入卸载...

    Make a Label Act Like an Internet Link

    通常,它们不响应鼠标点击事件,但我们可以自定义其行为。 在VB中,可以实现这个功能如下: 1. **添加事件处理程序**:首先,我们需要为标签控件添加一个`Click`事件处理程序。这可以通过在代码编辑器中双击标签...

    VBkongzhiqitacxu.rar_Visual_Basic_

    然而,如果需要更精细地控制其他软件,如发送键盘输入、模拟鼠标点击等,我们就需要使用到如`SendInput`这样的API。`SendInput`函数可以模拟用户在键盘上的按键行为,这对于自动化测试或模拟用户操作非常有用。例如...

    超链接怎么做?(9KB)

    超链接是网页设计和互联网交互中的基础元素,它允许用户点击文本或图像,跳转到其他页面、资源或执行特定操作。在HTML(超文本标记语言)中,超链接是通过`&lt;a&gt;`标签实现的。这篇教程将详细介绍如何创建和使用超链接...

    按键精灵使用

    按键精灵是一款通过制作脚本来模拟鼠标键盘操作的自动化工具。它可以帮助用户自动化完成一些重复性高的任务,提高工作效率。 **优点:** 1. **简单易用**:支持脚本录制及图形界面操作,无需复杂的编程知识。 2. **...

    qq自动登录代码

    1. **启动QQ应用程序**:通过VBScript的`CreateObject`函数创建一个对象来启动QQ的可执行文件,如`WScript.Shell`对象可以用来运行程序。 2. **自动化输入账号和密码**:可以使用`SendKeys`方法模拟键盘输入,将...

    API之网络函数---整理网络函数及功能

    GetMessagePos 取得消息队列中上一条消息处理完毕时的鼠标指针屏幕位置 GetMessageTime 取得消息队列中上一条消息处理完毕时的时间 PostMessage 将一条消息投递到指定窗口的消息队列 PostThreadMessage 将一条...

    2021-2022计算机二级等级考试试题及答案No.19219.docx

    Visual Basic应用程序不具有明显的开始和结束语句:VB应用程序通常在启动时自动执行一些初始化代码,在程序退出时自动清理资源。 - C. Visual Basic工具箱中的所有控件都具有宽度(Width)和高度(Height)属性:实际...

    Java开发技术大全(500个源代码).

    HelloNative.obj 用VB编译生成的目标文件 HelloNativeTest.java 测试本地化是否成功的类文件 instanceVar.java 定义一个实例成员变量 invokeByObject.java 对象实参传递示例程序 invokeByValue.java 传值调用...

    1345个易语言模块

    DirectX8VB组件调用模块.ec disk.ec DisplaySettings.ec DIY 热键框模块.ec DLL.ec DLL注入模块.ec DOS命令模块.ec dqf1996.ec EC.EC edb-html.ec EdbServer1.0 客户端.ec EDB、高级表格、XLS互换.ec edb到...

    1350多个精品易语言模块

    DirectX8VB组件调用模块.ec disk.ec DisplaySettings.ec DIY 热键框模块.ec DLL.ec DLL注入模块.ec DOS命令模块.ec dqf1996.ec EC.EC edb-html.ec EdbServer1.0 客户端.ec EDB、高级表格、XLS互换.ec edb到...

Global site tag (gtag.js) - Google Analytics