VB.NET + QQ文件助手实现远程控制

gdyabc · 发表于 2018-8-14 23:32

本帖最后由 gdyabc 于 2018-8-14 23:35 编辑

这前看到一篇文件介绍用Python+itchat微信接口实现“远程控制”电脑，最近无聊试了下利用“QQ文件传输助手”可以接收手机端发送的消息原理来写了一个VB.NET(Visual Studio2013)版的，
具体实现如下：
一.主要原理是利用了Microsft UI Automation自动化测试技术去获取QQ窗体的句柄
第一步：在VS中引用项目Automation程序集


第二步，在项目中导入

[Visual Basic .NET] 纯文本查看 复制代码

Imports System.Windows.Automation
Imports System.Text.RegularExpressions

第三步，打开QQ文件传输窗体（我事先给它发送一个notepad.exe命令，等会程序将读取到这条消息，并打开“记事本”）


第四步，看代码先用windows api (Findwindow)获取这个窗体的句柄

[Visual Basic .NET] 纯文本查看 复制代码

    Sub Main()        
        Dim QQHandle As Integer = getQQTransFileHandle("怀念刨地瓜的童年的 Android手机")
        Dim strMessage() As String = getTextMessage(QQHandle)
        If strMessage IsNot Nothing Then
            Dim strLastCmd As String = strMessage(strMessage.Length - 1).ToString.Trim()
            If Not String.IsNullOrWhiteSpace(strLastCmd) Then
                RunCommand(strLastCmd)
            End If
        End If
        Console.ReadLine()
    End Sub

    ''' <summary>
    ''' 先获取QQ传输文件的窗体的句柄
    ''' </summary>
    ''' <param name="title"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function getQQTransFileHandle(ByVal title As String) As Integer
        Try
            Return API.FindWindow("TXGuiFoundation", title)
        Catch ex As Exception
            Return 0
        End Try
    End Function

第五步，获取到窗体句柄后，继续寻找下一级控件句柄，这里说个题外话，QQ等应用程序的窗体基本上是用DX自绘的窗体如果使用window api 函数（FindWindowEx）是无法获取到窗体中其它控件的句柄消息的，所以这里用 Automation技术，请看代码

将刚刚找到的窗体的句柄传入这个函数来获取到窗体中的"notepad.exe"字符串

[Visual Basic .NET] 纯文本查看 复制代码

&#8203;

 Private Function getTextMessage(ByVal qqhandle As Integer) As String()
        Dim qqClassName As AutomationElement
        Dim qqMsg() As String = Nothing
        Try
            Dim msgTitleName As AutomationElement
            Dim qqRoot As AutomationElement = AutomationElement.RootElement
            If qqhandle > 0 Then
                msgTitleName = AutomationElement.FromHandle(qqhandle)
                Console.Title = String.Concat(msgTitleName.Current.Name, ",", msgTitleName.Current.ClassName)            
            End If
            Dim qqMsgWindow As AutomationElement = qqRoot.FindFirst(TreeScope.Children,
                           New AndCondition(
                           New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Window),
                           New PropertyCondition(AutomationElement.NameProperty, msgTitleName.Current.Name)))
            If Not IsNothing(qqMsgWindow) Then
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqMsgWindow)
                qqClassName = TreeWalker.RawViewWalker.GetNextSibling(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetNextSibling(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetNextSibling(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)

                Dim tempMsg As ValuePattern = qqClassName.GetCurrentPattern(ValuePattern.Pattern)
                Dim MyReg As Regex = New Regex(" ", RegexOptions.Multiline)
                qqMsg = Regex.Split(MyReg.Replace(tempMsg.Current.Value, Environment.NewLine), Environment.NewLine)
                qqMsg = qqMsg.Where(Function(s) Not String.IsNullOrEmpty(s)).ToArray
            End If
        Catch ex As Exception
            Return Nothing
        End Try
        Return qqMsg
    End Function

[点击并拖拽以移动]
&#8203;

核心代码到处完成了，这里只是做了一个简单的“抛砖引玉”的功能，只执行了打开"notepad.exe"的命令，有需要的可以自行修改加完善自己需要的功能，全部代码如下：

[Visual Basic .NET] 纯文本查看 复制代码

Imports System.Windows.Automation
Imports System.Text.RegularExpressions
Module Module1

    Sub Main()        
        Dim QQHandle As Integer = getQQTransFileHandle("怀念刨地瓜的童年的 Android手机")
        Dim strMessage() As String = getTextMessage(QQHandle)
        If strMessage IsNot Nothing Then
            Dim strLastCmd As String = strMessage(strMessage.Length - 1).ToString.Trim()
            If Not String.IsNullOrWhiteSpace(strLastCmd) Then
                RunCommand(strLastCmd)
            End If
        End If
        Console.ReadLine()
    End Sub

    ''' <summary>
    ''' 先获取QQ传输文件的窗体的句柄
    ''' </summary>
    ''' <param name="title"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function getQQTransFileHandle(ByVal title As String) As Integer
        Try
            Return API.FindWindow("TXGuiFoundation", title)
        Catch ex As Exception
            Return 0
        End Try
    End Function

    ''' <summary>
    ''' 获取QQ传输文件消息文本框中的数据
    ''' </summary>
    ''' <param name="qqhandle"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function getTextMessage(ByVal qqhandle As Integer) As String()
        Dim qqClassName As AutomationElement
        Dim qqMsg() As String = Nothing
        Try
            Dim msgTitleName As AutomationElement
            Dim qqRoot As AutomationElement = AutomationElement.RootElement
            If qqhandle > 0 Then
                msgTitleName = AutomationElement.FromHandle(qqhandle)
                Console.Title = String.Concat(msgTitleName.Current.Name, ",", msgTitleName.Current.ClassName)            
            End If
            Dim qqMsgWindow As AutomationElement = qqRoot.FindFirst(TreeScope.Children,
                           New AndCondition(
                           New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Window),
                           New PropertyCondition(AutomationElement.NameProperty, msgTitleName.Current.Name)))
            If Not IsNothing(qqMsgWindow) Then
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqMsgWindow)
                qqClassName = TreeWalker.RawViewWalker.GetNextSibling(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetNextSibling(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetNextSibling(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)
                qqClassName = TreeWalker.RawViewWalker.GetFirstChild(qqClassName)

                Dim tempMsg As ValuePattern = qqClassName.GetCurrentPattern(ValuePattern.Pattern)
                Dim MyReg As Regex = New Regex(" ", RegexOptions.Multiline)
                qqMsg = Regex.Split(MyReg.Replace(tempMsg.Current.Value, Environment.NewLine), Environment.NewLine)
                qqMsg = qqMsg.Where(Function(s) Not String.IsNullOrEmpty(s)).ToArray
            End If
        Catch ex As Exception
            Return Nothing
        End Try
        Return qqMsg
    End Function

    ''' <summary>
    ''' 运行接收到的命令
    ''' </summary>
    ''' <param name="cmd"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function RunCommand(ByVal cmd As String) As Boolean
        Try
            Process.Start(cmd)
        Catch ex As Exception
            Return False
        End Try
        Return True
    End Function

End Module

标题

gdyabc · 发表于 2018-8-15 00:21

苏紫方璇发表于 2018-8-15 00:06
学习下楼主的思路，前几年试过用c写此类程序，但是最后不知道为何读不到qq数据，最后就放弃了

现在90%的软件的UI都是用DX技术自绘的，这种自绘的用win32api中的函数无法取得控件的句柄了，所以只有用其他方式

gdyabc · 发表于 2018-8-15 00:23

吾爱看雪发表于 2018-8-14 23:45
现在使用VB的好少啊。。

是的，我以前用VB6现在用VB.NET，无所谓了能做一些简单的应用满足工作需求就行了，我不是专业的码农只是兴趣爱好

吾爱看雪 · 发表于 2018-8-14 23:45

现在使用VB的好少啊。。

苏紫方璇 · 发表于 2018-8-15 00:06

学习下楼主的思路，前几年试过用c写此类程序，但是最后不知道为何读不到qq数据，最后就放弃了

sqchr888 · 发表于 2018-8-15 00:33

感谢分享了。。。

孤狼微博 · 发表于 2018-8-15 00:46

直接使用框架吧,更省心一些处理还方便

gdyabc · 发表于 2018-8-15 06:53

孤狼微博发表于 2018-8-15 00:46
直接使用框架吧,更省心一些处理还方便

这个没了解过，是那个框架分享下呗

yangcongs · 发表于 2018-8-15 07:59

正在自学VB 用的人太少了哪里不会问都没地方问

gdyabc · 发表于 2018-8-15 10:39

yangcongs 发表于 2018-8-15 07:59
正在自学VB 用的人太少了哪里不会问都没地方问

vb学起来相对简单多了

帐号		自动登录	找回密码
密码			注册[Register]

[其他转载] VB.NET + QQ文件助手实现远程控制

免费评分

本帖被以下淘专辑推荐: