网站 › 『编程语言区』 › VB.NET + QQ文件助手实现远程控制

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

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

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


这前看到一篇文件介绍用Python+itchat微信接口实现“远程控制”电脑，最近无聊试了下利用“QQ文件传输助手”可以接收手机端发送的消息原理来写了一个VB.NET(Visual Studio2013)版的，
具体实现如下：
一.主要原理是利用了Microsft UI Automation自动化测试技术去获取QQ窗体的句柄
第一步：在VS中引用项目Automation程序集
https://img-blog.csdn.net/20180813200259399?watermark/2/text/aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2dkeWFiYw==/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70data:image/gif;base64,R0lGODlhAQABAPABAP///wAAACH5BAEKAAAALAAAAAABAAEAAAICRAEAOw==​
第二步，在项目中导入
Imports System.Windows.Automation
Imports System.Text.RegularExpressions

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

https://img-blog.csdn.net/20180813200553954?watermark/2/text/aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2dkeWFiYw==/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70data:image/gif;base64,R0lGODlhAQABAPABAP///wAAACH5BAEKAAAALAAAAAABAAEAAAICRAEAOw==​
第四步，看代码先用windows api (Findwindow)获取这个窗体的句柄
    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"字符串
​

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

[点击并拖拽以移动]
​

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

​
https://img-blog.csdn.net/20180813201851417?watermark/2/text/aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2dkeWFiYw==/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70​标题data:image/gif;base64,R0lGODlhAQABAPABAP///wAAACH5BAEKAAAALAAAAAABAAEAAAICRAEAOw==​

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 用的人太少了 哪里不会问都没地方问{:1_909:}

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

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

vb学起来相对简单多了

查看完整版本: VB.NET + QQ文件助手实现远程控制