form1.frm

1212 1121 22112 121212 121211 212211221

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "命令监控台"
   ClientHeight    =   6000
   ClientLeft      =   195
   ClientTop       =   0
   ClientWidth     =   3135
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6000
   ScaleWidth      =   3135
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer1 
      Left            =   840
      Top             =   4440
   End
   Begin QQ命令控制台.Play78QQForm Play78QQForm1 
      Height          =   6000
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   10583
      Begin QQ命令控制台.Play78QQButton Play78QQButton2 
         Height          =   495
         Left            =   1680
         TabIndex        =   6
         Top             =   5280
         Width           =   1215
         _ExtentX        =   2143
         _ExtentY        =   873
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin QQ命令控制台.Play78QQButton Play78QQButton1 
         Height          =   495
         Left            =   240
         TabIndex        =   5
         Top             =   5280
         Width           =   1215
         _ExtentX        =   2143
         _ExtentY        =   873
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Frame Frame1 
         BackColor       =   &H00FFFFFF&
         Caption         =   "窗体选择:"
         Height          =   1935
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   2895
         Begin VB.ListBox List1 
            Height          =   1500
            ItemData        =   "Form1.frx":058A
            Left            =   120
            List            =   "Form1.frx":058C
            TabIndex        =   4
            Top             =   240
            Width           =   2655
         End
      End
      Begin VB.Frame Frame2 
         BackColor       =   &H00FFFFFF&
         Caption         =   "内容监控:"
         Height          =   2775
         Left            =   120
         TabIndex        =   1
         Top             =   2310
         Width           =   2895
         Begin VB.Timer Timer2 
            Interval        =   100
            Left            =   1800
            Top             =   2160
         End
         Begin VB.TextBox Text1 
            Enabled         =   0   'False
            Height          =   2415
            Left            =   120
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   2
            Top             =   240
            Width           =   2655
         End
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETEXTT = &HD
Dim QQTextHwnd As Long
Option Explicit
  Private Enum HowExitConst
  EWX_LOGOFF = 0
  EWX_SHUTDOWN = 1
  EWX_REBOOT = 2
  EWX_FORCE = 4
  End Enum
  Const TOKEN_ADJUST_PRIVILEGES = &H20
  Const TOKEN_QUERY = &H8
  Const SE_PRIVILEGE_ENABLED = &H2
  Const ANYSIZE_ARRAY = 1
  Private Type LUID
  lowpart As Long
  highpart As Long
  End Type
  Private Type LUID_AND_ATTRIBUTES
               pLuid   As LUID
               Attributes As Long
  End Type
  Private Type TOKEN_PRIVILEGES
  PrivilegeCount   As Long
  Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
  End Type
  Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
  Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
                    "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
                    ByVal lpName As String, lpLuid As LUID) As Long
  Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _
                    (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
                    NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
                    PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
  Private Declare Function OpenProcessToken Lib "advapi32.dll" _
                    (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
                      TokenHandle As Long) As Long
  Dim method As HowExitConst
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
    Function AdjustToken()
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
    hdlProcessHandle = GetCurrentProcess()
    OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
    hdlTokenHandle
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    tkp.PrivilegeCount = 1
    tkp.Privileges(0).pLuid = tmpLuid
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
    tkpNewButIgnored, lBufferNeeded
  End Function
Private Function GetWinText(ByVal WinHwnd As Long) As String
Dim lLen As Long
GetWinText = String(255, Chr(0))
lLen = SendMessage(WinHwnd, WM_GETEXTT, Len(GetWinText), ByVal GetWinText)
GetWinText = Left(GetWinText, lLen)
End Function
Private Sub form_load()
Play78QQButton1.Caption = "获取窗口(&G)"
Play78QQButton2.Caption = "监听命令(&M)"
Text1.Text = ""
Timer1.Interval = 100
Timer1.Enabled = False
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
Private Sub Play78QQButton1_Click()
List1.Clear
Dim hFindWnd As Long
hFindWnd = FindWindowEx(0, 0, "#32770", vbNullString)
Do While hFindWnd <> 0
If InStr(GetWinText(hFindWnd), "聊天中") > 0 Or InStr(GetWinText(hFindWnd), "发送消息") > 0 Then
List1.AddItem GetWinText(hFindWnd)
End If
hFindWnd = FindWindowEx(0, hFindWnd, "#32770", vbNullString)
Loop
If List1.ListCount = 0 Then
MsgBox "很抱歉，您目前没有可用的消息窗口", 64, "提示"
End If
End Sub
Private Sub Play78QQButton2_Click()
If Play78QQButton2.Caption = "监听命令(&M)" Then
Play78QQButton2.Caption = "暂停监听(&S)"
Timer1.Enabled = True
Else
Play78QQButton2.Caption = "监听命令(&M)"
Timer1.Enabled = False
End If
End Sub
Private Sub Timer1_Timer()
Dim str As String * 255
Dim Txt(64000) As Byte
Dim MyCMD As String
Dim QQHwnd As Long
QQHwnd = FindWindow("#32770", List1.Text)
QQHwnd = FindWindowEx(QQHwnd, 0, "#32770", vbNullString)
QQTextHwnd = FindWindowEx(QQHwnd, 0, "AfxWnd42", vbNullString)
QQTextHwnd = FindWindowEx(QQHwnd, 0, "RICHEDIT", vbNullString)
SendMessage QQTextHwnd, &HD, 64000, Txt(0)
Text1.Text = StrConv(Txt, vbUnicode)
MyCMD = Right(Text1.Text, 4)
If MyCMD = "关闭系统" Then
On Error Resume Next
        Call AdjustToken
        Call ExitWindowsEx(EWX_SHUTDOWN, 0)
ElseIf MyCMD = "重启系统" Then
On Error Resume Next
        Call AdjustToken
        Call ExitWindowsEx(EWX_REBOOT, 0)
ElseIf MyCMD = "注销系统" Then
On Error Resume Next
        Call AdjustToken
        Call ExitWindowsEx(EWX_LOGOFF, 0)
ElseIf MyCMD = "强行关机" Then
On Error Resume Next
        Call AdjustToken
        Call ExitWindowsEx(EWX_FORCE, 0)
End If
End Sub
Private Sub Timer2_Timer()
    Dim p As POINTAPI
    Dim f As RECT
    GetCursorPos p
    GetWindowRect Me.hwnd, f
    If Me.WindowState <> 1 Then
        If p.X > f.Left And p.X < f.Right And p.Y > f.Top And p.Y < f.Bottom Then
            If Me.Top < 0 Then
                Me.Top = -10
                Me.Show
            ElseIf Me.Left < 0 Then
                Me.Left = -10
                Me.Show
            ElseIf Me.Left + Me.Width >= Screen.Width Then
                Me.Left = Screen.Width - Me.Width + 10
                Me.Show
            End If
        Else
            If f.Top <= 4 Then
                Me.Top = 40 - Me.Height
            ElseIf f.Left <= 4 Then
                Me.Left = 40 - Me.Width
            ElseIf Me.Left + Me.Width >= Screen.Width - 4 Then
                Me.Left = Screen.Width - 40
            End If
        End If
    End If
End Sub