Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As LongPrivate Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, _ ByVal uExitCode As Long) As Long Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * 1024 End TypeConst TH32CS_SNAPHEAPLIST = &H1 Const TH32CS_SNAPPROCESS = &H2 Const TH32CS_SNAPTHREAD = &H4 Const TH32CS_SNAPMODULE = &H8 Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE) Const TH32CS_INHERIT = &H80000000Dim pid As Long Private Sub Command1_Click() Dim my As PROCESSENTRY32 Dim l As Long Dim l1 As Long Dim mName As String Dim i As Integer l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0) If l Then my.dwSize = 1060 If (Process32First(l, my)) Then '遍历第一个进程 Do i = InStr(1, my.szExeFile, Chr(0)) mName = LCase(Left(my.szExeFile, i - 1)) If Trim(mName) = "XXX.exe" Then '这里填你调用的程序进程名 pid = my.th32ProcessID Dim mProcID As Long mProcID = OpenProcess(1&, -1&, pid) TerminateProcess mProcID, 0& Exit Sub End If Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False End If l1 = CloseHandle(l) End If End Sub
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd 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 Const WM_CLOSE = &H10 Const GW_HWNDNEXT = 2 Dim mWnd As Long Function InstanceToWnd(ByVal target_pid As Long) As Long Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long 'Find the first window test_hwnd = FindWindow(ByVal 0&, ByVal 0&) Do While test_hwnd <> 0 'Check if the window isn't a child If GetParent(test_hwnd) = 0 Then 'Get the window's thread test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid) If test_pid = target_pid Then InstanceToWnd = test_hwnd Exit Do End If End If 'retrieve the next window test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT) Loop End Function Private Sub Form_Load() Dim Pid As Long 'Execute notepad.Exe Pid = Shell("c:\win\notepad.exe", vbNormalFocus) If Pid = 0 Then MsgBox "Error starting the app" 'retrieve the handle of the window mWnd = InstanceToWnd(Pid) End Sub Private Sub Form_Unload(Cancel As Integer) 'Unload notepad DestroyWindow mWnd 'End this program TerminateProcess GetCurrentProcess, 0 End Subprivate sub command1_click() postMessage mwnd,WM_CLOSE,byval 0,byval 0 end sub
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As LongPrivate Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, _
ByVal uExitCode As Long) As Long
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End TypeConst TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000Dim pid As Long
Private Sub Command1_Click()
Dim my As PROCESSENTRY32
Dim l As Long
Dim l1 As Long
Dim mName As String
Dim i As Integer l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If l Then
my.dwSize = 1060
If (Process32First(l, my)) Then '遍历第一个进程
Do
i = InStr(1, my.szExeFile, Chr(0))
mName = LCase(Left(my.szExeFile, i - 1))
If Trim(mName) = "XXX.exe" Then '这里填你调用的程序进程名
pid = my.th32ProcessID
Dim mProcID As Long
mProcID = OpenProcess(1&, -1&, pid)
TerminateProcess mProcID, 0&
Exit Sub
End If
Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
End If
l1 = CloseHandle(l)
End If
End Sub
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd 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 Const WM_CLOSE = &H10
Const GW_HWNDNEXT = 2
Dim mWnd As Long
Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
'Find the first window
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0
'Check if the window isn't a child
If GetParent(test_hwnd) = 0 Then
'Get the window's thread
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
'retrieve the next window
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Private Sub Form_Load()
Dim Pid As Long
'Execute notepad.Exe
Pid = Shell("c:\win\notepad.exe", vbNormalFocus)
If Pid = 0 Then MsgBox "Error starting the app"
'retrieve the handle of the window
mWnd = InstanceToWnd(Pid)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unload notepad
DestroyWindow mWnd
'End this program
TerminateProcess GetCurrentProcess, 0
End Subprivate sub command1_click()
postMessage mwnd,WM_CLOSE,byval 0,byval 0
end sub
如果在98的话, terminateprocess 返回值,0
尝试下