强制关闭指定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