强制关闭指定QQ号

'添加 Text1       Command1       List1

'在Text1输入欲检测的 QQ 号

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Const PROCESS_TERMINATE = 1 '关闭进程
Const MAXLEN = 255
Const GW_HWNDNEXT = &H2
Dim aa$, strBuffer$, intCount%, allhwnd&, qqhwnd&, qqproid&, hw&, proid&, cnt&, idProc&, rttitle As String * 256

Private Sub Form_Load()
       Text1.Text = ""
End Sub

Private Sub Command1_Click()
       hw = FindWindow("#32770", vbNullString) '以类名查找Hwnd
       cnt = GetWindowText(hw, rttitle, 255)
       allhwnd = FindWindow("#32770", vbNullString)
       proid = ProcIDFromWnd(allhwnd)
       List1.Clear
       Do Until allhwnd = 0
          DoEvents
          allhwnd = GetWindow(allhwnd, GW_HWNDNEXT)             '开始找下一个窗体句柄
          If GetCaptionFromHwnd(allhwnd) <> "" Then
             'If ProcIDFromWnd(allhwnd) = proid Then List1.AddItem CStr(allhwnd) & "," & getclassnm(allhwnd) & "," & GetCaptionFromHwnd(allhwnd)
             List1.AddItem CStr(allhwnd) & "," & getclassnm(allhwnd) & "," & GetCaptionFromHwnd(allhwnd)
          End If
       Loop
       Call chkqq
End Sub

Function getclassnm(WinWnd As Long) As String
      Dim Ret$, RetVal&, lpClassName$
      lpClassName = Space(256)
      RetVal = GetClassName(WinWnd, lpClassName, 256)
      getclassnm = Left(lpClassName, RetVal)
End Function

Private Function GetCaptionFromHwnd(hwnd As Long) As String
       strBuffer = String$(MAXLEN - 1, 0)
       intCount = GetWindowText(hwnd, strBuffer, MAXLEN)
       If intCount > 0 Then GetCaptionFromHwnd = Left$(strBuffer, intCount)
End Function

Function ProcIDFromWnd(ByVal hwnd As Long) As Long
       GetWindowThreadProcessId hwnd, idProc
       ProcIDFromWnd = idProc
End Function

Sub chkqq()
       Dim s
       qqproid = 0
       For i = 0 To List1.ListCount - 1
          aa = Trim(List1.List(i))
          s = Split(aa, ",")
          If InStr(LCase(s(2)), "qqmusic") > 0 Then
             If CStr(Val(s(2))) = Trim(Text1.Text) Then
                qqproid = Val(s(0))
                Exit For
             End If
          End If
       Next i

       If qqproid > 0 Then
          Rtn = MsgBox(Text1.Text & " 已登录, 您确定要关闭吗?", vbYesNo, "CBM666 的强制关闭QQ")
          If Rtn = 6 Then
             proid = ProcIDFromWnd(qqproid)
             qqhwnd = OpenProcess(PROCESS_TERMINATE, False, proid)
             TerminateProcess qqhwnd, 1
             CloseHandle qqhwnd
             MsgBox Text1.Text & " 已关闭"
          End If
       Else
          MsgBox Text1.Text & " 未登录或QQ没打开"
       End If
End Sub