模块: Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function BroadcastSystemMessage Lib "user32" (ByVal dw As Long, pdw As Long, ByVal un As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As LongPublic Const MYMESS As String = "This is my message" Public Const BSF_POSTMESSAGE = &H10 Public Const BSF_IGNORECURRENTTASK = &H2 Public Const BSF_NOHANG = &H8 Public Const BSM_APPLICATIONS = &H8 Public Const GWL_WNDPROC = (-4)Public lMsgID As Long Public lpreProc As LongPublic Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If lMsgID = Msg Then '结束进程 Call TerminateProcess(GetCurrentProcess, ByVal 0&) Exit Function Else WindowProc = CallWindowProc(lpreProc, hWnd, Msg, wParam, lParam) End If End Function
窗体: Private Sub Form_Load() lMsgID = RegisterWindowMessage(MYMESS) lpreProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc) End SubPrivate Sub Form_Unload(Cancel As Integer) SetWindowLong Me.hWnd, GWL_WNDPROC, lpreProc End Sub
可以先获得a程序对应的pid,然后由pid获得hwnd 发送wm_close消息,a接收到消息在处理Option ExplicitConst SYNCHRONIZE = &H100000 Const INFINITE = &HFFFF Const WAIT_OBJECT_0 = 0 Const WAIT_TIMEOUT = &H102Private 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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 Private Sub Command1_Click() Dim ShellX As String Dim lPid As Long Dim lHnd As Long Dim lRet As Long Dim VarX As String ShellX = Shell(App.Path & "\工程2.exe", vbNormalFocus)
lPid = ShellX If lPid <> 0 Then lHnd = OpenProcess(SYNCHRONIZE, 0, lPid) If lHnd <> 0 Then SendMessage lHnd, WM_CLOSE, 0&, 0& CloseHandle (lHnd) End If End If End Sub用什么方法才能接收到B发出的结束进程的消息,将做了一半的任务完成后再退出程序? 如果直接关闭进程,a不会完成工作,直接退出
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If lMsgID = Msg Then '结束进程 '当然在这里你可以不结束进程,A运行到这里说明已经接收到的关闭的消息,接 '下来要做些什么工作,你完全可以自己控制,甚至杀死B,呵呵 Call TerminateProcess(GetCurrentProcess, ByVal 0&) Exit Function Else WindowProc = CallWindowProc(lpreProc, hWnd, Msg, wParam, lParam) End If End Function
共享内存方法的一些资料'\\ Global memory management functions private Declare Function GlobalLock Lib "kernel32" (byval hMem as Long) as Longprivate Declare Function GlobalSize Lib "kernel32" (byval hMem as Long) as Longprivate Declare Function GlobalUnlock Lib "kernel32" (byval hMem as Long) as Longprivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest as Any, lpvSource as Any, byval cbCopy as Long)private Declare Function GlobalAlloc Lib "kernel32" (byval wFlags as Long, byval dwBytes as Long) as Longprivate Declare Function GlobalFree Lib "kernel32" (byval hMem as Long) as Long private mMyData() as Byte private mMyDataSize as Long private mHmem as Long public Enum enGlobalmemoryAllocationConstants GMEM_FIXED = &H0 GMEM_DISCARDABLE = &H100 GMEM_MOVEABLE = &H2 GMEM_NOCOMPACT = &H10 GMEM_NODISCARD = &H20 GMEM_ZEROINIT = &H40 End Enum '************************************** ' Name: Global memory ' Description:Allows you to read and wri ' te global memory blocks, which in turn a ' llows you to pass big chunks of data bet ' ween applications easily. ' By: Duncan Jones ' ' ' Inputs:None ' '\\ --[CopyFromHandle]--------------------------- '\\ Copies the data from a global memory handle '\\ to a private byte array copy '\\ ---------------------------------------------public Sub CopyFromHandle(byval hMemHandle as Long) Dim lRet as Long Dim lPtr as Long lRet = GlobalSize(hMemHandle) If lRet > 0 then mMyDataSize = lRet lPtr = GlobalLock(hMemHandle) If lPtr > 0 then ReDim mMyData(0 to mMyDataSize - 1) as Byte CopyMemory mMyData(0), byval lPtr, mMyDataSize Call GlobalUnlock(hMemHandle) End If End If End Sub '\\ --[CopyToHandle]----------------------------- '\\ Copies the private data to a memory handle '\\ passed in '\\ ---------------------------------------------public Sub CopyToHandle(byval hMemHandle as Long) Dim lSize as Long Dim lPtr as Long '\\ Don't copy if its empty If Not (mMyDataSize = 0) then lSize = GlobalSize(hMemHandle) '\\ Don't attempt to copy if zero size..
If lSize > 0 then lPtr = GlobalLock(hMemHandle) If lPtr > 0 then CopyMemory byval lPtr, mMyData(0), lSize Call GlobalUnlock(hMemHandle) End If End If End If End Sub
程序B是一个管理程序,负责启动和停止A =========================== 不知道你是用什么方式启动a的???如果是用shell,应该可以得到程序A的pid继而将它结束一个很简单的例子:'模块中 Option ExplicitPublic Const WM_CLOSE = &H10 Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As LongDim hWndProcess As LongFunction EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean Dim pID As Long
GetWindowThreadProcessId hWnd, pID If pID = lParam Then If GetParent(hWnd) = 0 Then hWndProcess = hWnd EnumWindowsProc = False End If End If EnumWindowsProc = True End FunctionFunction FindProcessWindow(ByVal pID As Long) As Long hWndProcess = 0 EnumWindows AddressOf EnumWindowsProc, pID FindProcessWindow = hWndProcess End Function '程序中 Option ExplicitDim pID As LongPrivate Sub Command1_Click() pID = Shell("notepad", vbHide) End SubPrivate Sub Command2_Click() Dim hWnd As Long
hWnd = FindProcessWindow(pID) SetForegroundWindow hWnd PostMessage hWnd, WM_CLOSE, 0, 0& End SubPrivate Sub Form_Load() Command1.Caption = "启动 NotePad" Command2.Caption = "关闭 NotePad" End Sub运行程序前,先按ctl+alt+del,调出任务管理器,并选择"进程"选项卡 运行程序,按"启动 NotePad",可以在任务管理器中看见多了一个notepad.exe进程,但由于调用notped时用了vbhide参数,所以你不会见到记事本的窗口。。 再按"关闭 NotePad",看到notepad.exe进程消失了。
《吃饱了撑》之杀掉无窗口进程系列之二: 另一种方法,如果A真的无窗口,就用TerminateProcess去终止它,前提仍是程序B用shell启动程序A,下面的例子在vb6+sp5+xp下通过:程序A的代码: '作为测试,程序A中没有form,只有很简单的一个过程: Sub Main() Do Until i = 100 DoEvents i = i + 1 DoEvents i = i - 1 DoEvents Loop End Sub生成一个test.exe 程序B的代码: '模块中 Option Explicit Public Const TOKEN_ADJUST_PRIVILEGES = &H20 Public Const TOKEN_QUERY = &H8 Public Const ANYSIZE_ARRAY = 1 Public Const PROCESS_ALL_ACCESS = &H1F0FFF Public Const SE_DEBUG_NAME = "SeDebugPrivilege" Public Const SE_PRIVILEGE_ENABLED = &H2 Type LARGE_INTEGER lowpart As Long highpart As Long End Type Type Luid lowpart As Long highpart As Long End Type Type LUID_AND_ATTRIBUTES pLuid As Luid Attributes As Long End Type Type TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES End Type Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Declare Function GetCurrentProcess Lib "kernel32" () As Long Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As Luid) As Long 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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Public Sub SeDebugSample(ApplicationPID As Long) Dim hProcessID As Long Dim hProcess As Long Dim hToken As Long Dim lPrivilege As Long Dim iPrivilegeflag As Boolean Dim lResult As Long hProcessID = ApplicationPID hProcess = GetCurrentProcess lResult = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) lResult = SetPrivilege(hToken, SE_DEBUG_NAME, True) hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID) lResult = SetPrivilege(hToken, SE_DEBUG_NAME, False) lResult = TerminateProcess(hProcess, 0) CloseHandle (hProcess) CloseHandle (hToken) End Sub Private Function SetPrivilege(hToken As Long, Privilege As String, bSetFlag As Boolean) As Boolean Dim TP As TOKEN_PRIVILEGES Dim TPPrevious As TOKEN_PRIVILEGES Dim Luid As Luid Dim cbPrevious As Long Dim lResult As Long cbPrevious = Len(TP) lResult = LookupPrivilegeValue("", Privilege, Luid) If (lResult = 0) Then SetPrivilege = False End If TP.PrivilegeCount = 1 TP.Privileges(0).pLuid = Luid TP.Privileges(0).Attributes = 0 SetPrivilege = lResult lResult = AdjustTokenPrivileges(hToken, -1, TP, Len(TP), TPPrevious, cbPrevious) If (lResult = 0) Then SetPrivilege = False End If TPPrevious.PrivilegeCount = 1 TPPrevious.Privileges(0).pLuid = Luid Select Case bSetFlag Case True: TPPrevious.Privileges(0).Attributes = TPPrevious.Privileges(0).Attributes Or (SE_PRIVILEGE_ENABLED) Case False: TPPrevious.Privileges(0).Attributes = TPPrevious.Privileges(0).Attributes Xor (SE_PRIVILEGE_ENABLED And TPPrevious.Privileges(0).Attributes) End Select lResult = AdjustTokenPrivileges(hToken, -1, TPPrevious, cbPrevious, TP, cbPrevious) If (lResult = 0) Then SetPrivilege = False Else SetPrivilege = True End If End Function'程序中: Private iAppPID As Long Private Sub Command1_Click() iAppPID = Shell("test.exe", vbNormalFocus) End Sub Private Sub Command2_Click() SeDebugSample CLng(iAppPID) End Sub生成main.exe,与test.exe放在同一目录下。 运行main,按command1,在任务管理器中见到test.exe的进程,按command2,就会把它杀掉。
不一定是杀进程,用dde,sentmessage也行,关键是怎么让A知道要退了。
Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function BroadcastSystemMessage Lib "user32" (ByVal dw As Long, pdw As Long, ByVal un As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As LongPublic Const MYMESS As String = "This is my message"
Public Const BSF_POSTMESSAGE = &H10
Public Const BSF_IGNORECURRENTTASK = &H2
Public Const BSF_NOHANG = &H8
Public Const BSM_APPLICATIONS = &H8
Public Const GWL_WNDPROC = (-4)Public lMsgID As Long
Public lpreProc As LongPublic Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If lMsgID = Msg Then
'结束进程
Call TerminateProcess(GetCurrentProcess, ByVal 0&)
Exit Function
Else
WindowProc = CallWindowProc(lpreProc, hWnd, Msg, wParam, lParam)
End If
End Function
Private Sub Form_Load()
lMsgID = RegisterWindowMessage(MYMESS)
lpreProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lpreProc
End Sub
BroadcastSystemMessage BSF_NOHANG + BSF_POSTMESSAGE + BSF_IGNORECURRENTTASK, BSM_APPLICATIONS, lMsgID, 0&, 0&
发送wm_close消息,a接收到消息在处理Option ExplicitConst SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102Private 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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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
Private Sub Command1_Click()
Dim ShellX As String
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
Dim VarX As String
ShellX = Shell(App.Path & "\工程2.exe", vbNormalFocus)
lPid = ShellX
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
If lHnd <> 0 Then
SendMessage lHnd, WM_CLOSE, 0&, 0&
CloseHandle (lHnd)
End If
End If
End Sub用什么方法才能接收到B发出的结束进程的消息,将做了一半的任务完成后再退出程序?
如果直接关闭进程,a不会完成工作,直接退出
If lMsgID = Msg Then
'结束进程
'当然在这里你可以不结束进程,A运行到这里说明已经接收到的关闭的消息,接
'下来要做些什么工作,你完全可以自己控制,甚至杀死B,呵呵
Call TerminateProcess(GetCurrentProcess, ByVal 0&)
Exit Function
Else
WindowProc = CallWindowProc(lpreProc, hWnd, Msg, wParam, lParam)
End If
End Function
private Declare Function GlobalLock Lib "kernel32" (byval hMem as Long) as Longprivate Declare Function GlobalSize Lib "kernel32" (byval hMem as Long) as Longprivate Declare Function GlobalUnlock Lib "kernel32" (byval hMem as Long) as Longprivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest as Any, lpvSource as Any, byval cbCopy as Long)private Declare Function GlobalAlloc Lib "kernel32" (byval wFlags as Long, byval dwBytes as Long) as Longprivate Declare Function GlobalFree Lib "kernel32" (byval hMem as Long) as Long
private mMyData() as Byte
private mMyDataSize as Long
private mHmem as Long
public Enum enGlobalmemoryAllocationConstants
GMEM_FIXED = &H0
GMEM_DISCARDABLE = &H100
GMEM_MOVEABLE = &H2
GMEM_NOCOMPACT = &H10
GMEM_NODISCARD = &H20
GMEM_ZEROINIT = &H40
End Enum
'**************************************
' Name: Global memory
' Description:Allows you to read and wri
' te global memory blocks, which in turn a
' llows you to pass big chunks of data bet
' ween applications easily.
' By: Duncan Jones
'
'
' Inputs:None
'
'\\ --[CopyFromHandle]---------------------------
'\\ Copies the data from a global memory handle
'\\ to a private byte array copy
'\\ ---------------------------------------------public Sub CopyFromHandle(byval hMemHandle as Long)
Dim lRet as Long
Dim lPtr as Long
lRet = GlobalSize(hMemHandle)
If lRet > 0 then
mMyDataSize = lRet
lPtr = GlobalLock(hMemHandle)
If lPtr > 0 then
ReDim mMyData(0 to mMyDataSize - 1) as Byte
CopyMemory mMyData(0), byval lPtr, mMyDataSize
Call GlobalUnlock(hMemHandle)
End If
End If
End Sub
'\\ --[CopyToHandle]-----------------------------
'\\ Copies the private data to a memory handle
'\\ passed in
'\\ ---------------------------------------------public Sub CopyToHandle(byval hMemHandle as Long)
Dim lSize as Long
Dim lPtr as Long
'\\ Don't copy if its empty
If Not (mMyDataSize = 0) then
lSize = GlobalSize(hMemHandle)
'\\ Don't attempt to copy if zero size..
If lSize > 0 then
lPtr = GlobalLock(hMemHandle)
If lPtr > 0 then
CopyMemory byval lPtr, mMyData(0), lSize
Call GlobalUnlock(hMemHandle)
End If
End If
End If
End Sub
B程序改变它的值
A程序没做完一次任务后检测一次该共享的值是否改为要求停止了
===========================
不知道你是用什么方式启动a的???如果是用shell,应该可以得到程序A的pid继而将它结束一个很简单的例子:'模块中
Option ExplicitPublic Const WM_CLOSE = &H10
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As LongDim hWndProcess As LongFunction EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim pID As Long
GetWindowThreadProcessId hWnd, pID
If pID = lParam Then
If GetParent(hWnd) = 0 Then
hWndProcess = hWnd
EnumWindowsProc = False
End If
End If
EnumWindowsProc = True
End FunctionFunction FindProcessWindow(ByVal pID As Long) As Long
hWndProcess = 0
EnumWindows AddressOf EnumWindowsProc, pID
FindProcessWindow = hWndProcess
End Function
'程序中
Option ExplicitDim pID As LongPrivate Sub Command1_Click()
pID = Shell("notepad", vbHide)
End SubPrivate Sub Command2_Click()
Dim hWnd As Long
hWnd = FindProcessWindow(pID)
SetForegroundWindow hWnd
PostMessage hWnd, WM_CLOSE, 0, 0&
End SubPrivate Sub Form_Load()
Command1.Caption = "启动 NotePad"
Command2.Caption = "关闭 NotePad"
End Sub运行程序前,先按ctl+alt+del,调出任务管理器,并选择"进程"选项卡
运行程序,按"启动 NotePad",可以在任务管理器中看见多了一个notepad.exe进程,但由于调用notped时用了vbhide参数,所以你不会见到记事本的窗口。。
再按"关闭 NotePad",看到notepad.exe进程消失了。
另一种方法,如果A真的无窗口,就用TerminateProcess去终止它,前提仍是程序B用shell启动程序A,下面的例子在vb6+sp5+xp下通过:程序A的代码:
'作为测试,程序A中没有form,只有很简单的一个过程:
Sub Main()
Do Until i = 100
DoEvents
i = i + 1
DoEvents
i = i - 1
DoEvents
Loop
End Sub生成一个test.exe
程序B的代码:
'模块中
Option Explicit
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const ANYSIZE_ARRAY = 1
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const SE_DEBUG_NAME = "SeDebugPrivilege"
Public Const SE_PRIVILEGE_ENABLED = &H2
Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type Type Luid
lowpart As Long
highpart As Long
End Type Type LUID_AND_ATTRIBUTES
pLuid As Luid
Attributes As Long
End Type Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As Luid) As Long
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
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Sub SeDebugSample(ApplicationPID As Long)
Dim hProcessID As Long
Dim hProcess As Long
Dim hToken As Long
Dim lPrivilege As Long
Dim iPrivilegeflag As Boolean
Dim lResult As Long
hProcessID = ApplicationPID
hProcess = GetCurrentProcess
lResult = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
lResult = SetPrivilege(hToken, SE_DEBUG_NAME, True)
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
lResult = SetPrivilege(hToken, SE_DEBUG_NAME, False)
lResult = TerminateProcess(hProcess, 0)
CloseHandle (hProcess)
CloseHandle (hToken)
End Sub
Private Function SetPrivilege(hToken As Long, Privilege As String, bSetFlag As Boolean) As Boolean
Dim TP As TOKEN_PRIVILEGES
Dim TPPrevious As TOKEN_PRIVILEGES
Dim Luid As Luid
Dim cbPrevious As Long
Dim lResult As Long
cbPrevious = Len(TP)
lResult = LookupPrivilegeValue("", Privilege, Luid)
If (lResult = 0) Then
SetPrivilege = False
End If
TP.PrivilegeCount = 1
TP.Privileges(0).pLuid = Luid
TP.Privileges(0).Attributes = 0
SetPrivilege = lResult
lResult = AdjustTokenPrivileges(hToken, -1, TP, Len(TP), TPPrevious, cbPrevious)
If (lResult = 0) Then
SetPrivilege = False
End If
TPPrevious.PrivilegeCount = 1
TPPrevious.Privileges(0).pLuid = Luid
Select Case bSetFlag
Case True: TPPrevious.Privileges(0).Attributes = TPPrevious.Privileges(0).Attributes Or (SE_PRIVILEGE_ENABLED)
Case False: TPPrevious.Privileges(0).Attributes = TPPrevious.Privileges(0).Attributes Xor (SE_PRIVILEGE_ENABLED And TPPrevious.Privileges(0).Attributes)
End Select
lResult = AdjustTokenPrivileges(hToken, -1, TPPrevious, cbPrevious, TP, cbPrevious)
If (lResult = 0) Then
SetPrivilege = False
Else
SetPrivilege = True
End If
End Function'程序中:
Private iAppPID As Long
Private Sub Command1_Click()
iAppPID = Shell("test.exe", vbNormalFocus)
End Sub
Private Sub Command2_Click()
SeDebugSample CLng(iAppPID)
End Sub生成main.exe,与test.exe放在同一目录下。
运行main,按command1,在任务管理器中见到test.exe的进程,按command2,就会把它杀掉。
这里有一法你看合适不?
可以在通过一个INI文件来设置结束标志,简单讲当B要结束A的实例时,在INI文件里写入要结束A的实例名(具体怎么写当然是你自己决定,比如通过参数来确定是哪个实例),当A实例执行后业务逻辑以后,就去读一下INI看是不是要关闭自已,如果是就关,关之前清掉INI的值。