b枚举进程，发现a后关闭
好像不太符合

up

to:online
不一定是杀进程，用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 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

窗体：
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

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

可以先获得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不会完成工作，直接退出

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

感谢你们的回答。

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

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

学习……

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

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

共享内存方法的一些资料

'\\ 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

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

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

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

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

程序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进程消失了。。。。

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