一个没有窗体的程序，怎样才能接收到结束进程的消息

[qbilbo]

程序A是一个没有界面的程序，负责监视一个目录，对移进来的文件进行格式转换，并转发，程序B是一个管理程序，负责启动和停止A（有N个实例，启动时通过加启动参数的方式实现不同的功能）程序。由于A没有窗体，用什么方法才能接收到B发出的结束进程的消息，将做了一半的任务完成后再退出程序？

[qbilbo]

to:online
不一定是杀进程，用dde,sentmessage也行，关键是怎么让A知道要退了。

[daviddivad]

发送自定义消息

[daviddivad]

模块：
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 Long

Public 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 Long

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
'结束进程
Call TerminateProcess(GetCurrentProcess, ByVal 0&)
Exit Function
Else
WindowProc = CallWindowProc(lpreProc, hWnd, Msg, wParam, lParam)
End If
End Function

[daviddivad]

窗体：
Private Sub Form_Load()
lMsgID = RegisterWindowMessage(MYMESS)
lpreProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lpreProc
End Sub

[daviddivad]

结束时，B程序发送自定义的消息给所有的窗体，A程序接收到自会处理
BroadcastSystemMessage BSF_NOHANG + BSF_POSTMESSAGE + BSF_IGNORECURRENTTASK, BSM_APPLICATIONS, lMsgID, 0&, 0&

[online]

可以先获得a程序对应的pid，然后由pid获得hwnd
发送wm_close消息，a接收到消息在处理

Option Explicit

Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102

Private 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不会完成工作，直接退出

[daviddivad]

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

[qbilbo]

感谢你们的回答。

不过你们的方法我都知道，现在的关键是A程序是个没有窗体的程序，我不知道该怎样拦截消息啊。总不见得为了收消息去弄个窗体吧。(如果有窗体也不用进入消息循环了，用sentmessage的活queryunload事件就行了，用DDE的话linkexecute事件就行了。）

[lsftest]

《吃饱了撑》之杀掉无窗口进程系列之二：
另一种方法，如果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,就会把它杀掉。。。。。。。

[LichKingSZ]

。。。
这里有一法你看合适不？
可以在通过一个INI文件来设置结束标志，简单讲当B要结束A的实例时，在INI文件里写入要结束A的实例名（具体怎么写当然是你自己决定，比如通过参数来确定是哪个实例），当A实例执行后业务逻辑以后，就去读一下INI看是不是要关闭自已，如果是就关，关之前清掉INI的值。

[qbilbo]

很急，请大家再帮我想想办法。

[jone999]

学习……

[刘洪峰AIoT]

复杂一点的用共享内存方法：B写启停标志，A检测标志
简单的直接把标志写入注册表，
程序不停的循环检测标志

[flyingscv]

不知道，为什么当初不设计成自己启动和停止呢?

[online]

共享内存方法的一些资料

'\\ Global memory management functions
private Declare Function GlobalLock Lib "kernel32" (byval hMem as Long) as Long

private Declare Function GlobalSize Lib "kernel32" (byval hMem as Long) as Long

private Declare Function GlobalUnlock Lib "kernel32" (byval hMem as Long) as Long

private 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 Long

private 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

[rainstormmaster]

//不过你们的方法我都知道，现在的关键是A程序是个没有窗体的程序，我不知道该怎样拦截消息啊。总不见得为了收消息去弄个窗体吧。(

呵呵，弄个窗体也未尝不可

[daviddivad]

其实还可以做个公用的DCOM组件，里面只是简单的放个共享的全局变量
B程序改变它的值
A程序没做完一次任务后检测一次该共享的值是否改为要求停止了

[viena]

//呵呵，弄个窗体也未尝不可
同意

[viena]

没有窗体只要隐藏窗体，为啥要弄得真的没有窗体呢？有个窗体又能怎么样？

[lsftest]

程序B是一个管理程序，负责启动和停止A
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
不知道你是用什么方式启动a的？？？如果是用shell，应该可以得到程序A的pid继而将它结束。。。一个很简单的例子：

'模块中
Option Explicit

Public 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 Long

Dim hWndProcess As Long

Function 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 Function

Function FindProcessWindow(ByVal pID As Long) As Long
hWndProcess = 0
EnumWindows AddressOf EnumWindowsProc, pID
FindProcessWindow = hWndProcess
End Function


'程序中
Option Explicit

Dim pID As Long

Private Sub Command1_Click()
pID = Shell("notepad", vbHide)
End Sub

Private Sub Command2_Click()
Dim hWnd As Long

hWnd = FindProcessWindow(pID)
SetForegroundWindow hWnd
PostMessage hWnd, WM_CLOSE, 0, 0&
End Sub

Private Sub Form_Load()
Command1.Caption = "启动 NotePad"
Command2.Caption = "关闭 NotePad"
End Sub

运行程序前，先按ctl＋alt＋del，调出任务管理器，并选择"进程"选项卡。。。
运行程序，按"启动 NotePad"，可以在任务管理器中看见多了一个notepad.exe进程，但由于调用notped时用了vbhide参数，所以你不会见到记事本的窗口。。。。。
再按"关闭 NotePad"，看到notepad.exe进程消失了。。。。