VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4620
   ClientLeft      =   3225
   ClientTop       =   2145
   ClientWidth     =   5790
   LinkTopic       =   "Form1"
   ScaleHeight     =   4620
   ScaleWidth      =   5790
   Begin MSComDlg.CommonDialog cmdlg 
      Left            =   2520
      Top             =   3600
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Refresh List Box"
      Height          =   375
      Left            =   3240
      TabIndex        =   5
      Top             =   4080
      Width           =   2055
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Teminate App"
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   4080
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Process and wait"
      Height          =   375
      Left            =   3240
      TabIndex        =   3
      Top             =   3480
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Shell and Continue"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   3480
      Width           =   1815
   End
   Begin VB.ListBox List1 
      Height          =   2400
      ItemData        =   "Form1.frx":0000
      Left            =   480
      List            =   "Form1.frx":0002
      TabIndex        =   0
      Top             =   720
      Width           =   4695
   End
   Begin VB.Label Label1 
      Caption         =   "Current Tasks"
      Height          =   255
      Left            =   2040
      TabIndex        =   1
      Top             =   360
      Width           =   1695
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_MAX = 5
Private Const GW_CHILD = 5
Private Const GW_OWNER = 4
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const INFINITE = &HFFFF      '  Infinite timeout
Private Const GWL_STYLE = (-16)
Private Const WS_DISABLED = &H8000000
Private Const WM_CLOSE = &H10
Private Const WM_CANCELMODE = &H1FPublic glCurrentHwnd
Private Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type
Private Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type
Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End TypePrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDriectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) 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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Dim MyHwnd(100) As Long
Sub LoadTaskList()
Dim Currwnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long
Dim i As Integer
i = 0
List1.Clear
Currwnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)
While Currwnd <> 0
Parent = GetParent(Currwnd)
Length = GetWindowTextLength(Currwnd)
TaskName = Space$(Length + 1)
Length = GetWindowText(Currwnd, TaskName, Length + 1)
TaskName = Left$(TaskName, Len(TaskName) - 1)
If Length > 0 Then
If TaskName <> Me.Caption Then
List1.AddItem TaskName & Chr(9) & Chr(9) & Currwnd
MyHwnd(i) = Currwnd
i = i + 1
End If
End If
Currwnd = GetWindow(Currwnd, GW_HWNDNEXT)
DoEvents
WendEnd Sub
Sub ShellAndContinue(ByVal AppToRun As String)
Dim hProcess As Long
Dim Retval As Long
Dim Msg, Style, Title, Response
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, Shell(AppToRun, vbNormalFocus))
Do
GetExitCodeProcess hProcess, Retval
DoEvents
Loop While Retval = STILL_ACTIVE
Msg = AppToRun & " Terminated by user"
Style = vbOKOnly + vbInformation
Title = "Termination Notice"
Response = MsgBox(Msg, Style, Title)
End Sub
Public Sub ShellAndWait(AppToRun)
Dim NameOfProc As PROCESS_INFORMATION
Dim NameStart As STARTUPINFO
Dim rc As Long
NameStart.cb = Len(NameStart)
rc = CreateProcessA(0&, AppToRun, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, NameStart, NameOfProc)
rc = WaitForSingleObject(NameOfProc.hProcess, INFINITE)
rc = CloseHandle(NameOfProc.hProcess)End Sub
Function EndTask(TargetHwnd As Long) As Long
Dim rc As Integer
Dim ReturnVal As Integer
If TargetHwnd = Form1.hwnd Or GetWindow(TargetHwnd, GW_OWNER) = Form1.hwnd Then
End
End If
If IsWindow(TargetHwnd) = False Then
GoTo EndTaskFail
End If
If (GetWindowLong(TargetHwnd, GWL_STYLE) And WS_DISABLED) Then
GoTo EndTaskSucceed
End If
If IsWindow(TargetHwnd) Then
If Not (GetWindowLong(TargetHwnd, GWL_STYLE) And WS_DISABLED) Then
rc = PostMessage(TargetHwnd, WM_CANCELMODE, 0, 0&)
rc = PostMessage(TargetHwnd, WM_CLOSE, 0, 0&)
DoEvents
End If
End If
GoTo EndTaskSucceed
EndTaskFail:
ReturnVal = False
GoTo EndTaskEndSubEndTaskSucceed:
ReturnVal = TrueEndTaskEndSub:
EndTask = ReturnValEnd FunctionPrivate Sub Command1_Click()
cmdlg.Filter = "可执行程序(*.exe)|*.exe"
cmdlg.ShowOpen
cmdlg.CancelError = False
ShellAndContinue (cmdlg.FileName)
LoadTaskList
End SubPrivate Sub Command2_Click()
cmdlg.Filter = "可执行程序(*.exe)|*.exe"
cmdlg.ShowOpen
cmdlg.CancelError = False
ShellAndWait (cmdlg.FileName)
LoadTaskList
End SubPrivate Sub Command3_Click()
 EndTask (MyHwnd(List1.ListIndex))
 LoadTaskList
End SubPrivate Sub Command4_Click()
LoadTaskList
End SubPrivate Sub Form_Load()
LoadTaskList
End Sub这个程序里是先监测系统当前运行的窗口加入list中,再停止选种list中的窗口,另外还有
其他功能,自己看吧

解决方案 »

  1.   

    楼上的兄弟,我说的是SHELL的那个程序已经打开,当然可以用它自己的退出关闭,但是我想用调用它的VB程序里的代码把它关闭!
      

  2.   

    我有没说要用全不的,如果你找到句并,直接用endtask就可以了
      

  3.   

    那老兄是不是可以在说说找句柄呀,怎样遍历,并且知道哪个是SHELL出来的窗体的句柄,不胜感激!
      

  4.   

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As LongPrivate 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 Sub Command1_Click()
    Dim hanDle As Long
    Const WM_CLOSE = &H10
    hanDle = FindWindow(0&, "计算器")
    If hanDle > 0 Then
            SendMessage hanDle, WM_CLOSE, 0, 0
            
    End IfEnd Sub

    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongConst WM_CLOSE = &H10PostMessage hwnd, WM_CLOSE, 0&, 0&