如何通过线程ID取得进程ID呢？

Question

我搞了一个 ActiveX DLL 的动态连接库，想在里面结束掉调用他的程序。
但调用他的程序如果是在 Sub main() 里调用它，那能给DLL类的有关结
束程序的参数好像就是 App.ThreadID 了，所以想问一下如何通过线程ID
取得进程ID的方法，谢谢。

Answer 1

结束程序并不是一个ActiveX应该做的事情。你怎么能确保调用DLL的程序正常退出？至少COM库是不能在ActiveX执行过程中被卸载的。

Answer 2

自动销毁思想
Option ExplicitPrivate RunFile$Private Const NORMAL_PRIORITY_CLASS = &H20      '如果进程位于前台，则基本值是9；如果在后台，则优先值为7
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102&             '对象保持未发出信号的状态，但等待超时时间已经超过
Private Flag As Boolean ‘进程活动监视标志
'说明∶PROCESS_INFORMATION结构由CreateProcess函数将关于新建立的进程和
'主要线索的信息写入其中成员变量
Private Type PROCESS_INFORMATION      '
          hProcess As Long
          hThread As Long
          dwProcessId As Long
          dwThreadId As Long
End Type'说明∶STARTUPINFO结构用在CreateProcess函数中指定为新进程建立的新窗口的主要属性。这一
'一信息影响由CreateWindows函数建立的第一个窗口
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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Sub command1_Click()
      Dim res&
      Dim sinfo As STARTUPINFO
      Dim pinfo As PROCESS_INFORMATION
      sinfo.cb = Len(sinfo)
      sinfo.lpReserved = vbNullString
      sinfo.lpDesktop = vbNullString
      sinfo.lpTitle = vbNullString
      sinfo.dwFlags = 0
    
      Label1.Caption = "正在启动程序"
      Label1.Refresh
     ' CreateProcess函数，用于创建一个新的进程
      res = CreateProcess(DemoFile, vbNullString, 0, 0, True, _
                         NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
      If res Then
          Label1.Caption = "程序正在运行中"
          WaitForTerm pinfo
          Label1.Caption = "程序已经结束"
      Else
          Label1.Caption = "启动程序时出错，可能未正确输入" & Chr(13) & "程序名或程序所在路径。"
      End If
End SubPrivate Sub WaitForTerm(pinfo As PROCESS_INFORMATION)
      Dim res&
      Dim res1&
      ' 等待指定的进程进入空闲状态，,空闲(Idle)指的是进程准备处理一条消息、但目前暂时没有消息需要处理的一种状态
      Call WaitForInputIdle(pinfo.hProcess, INFINITE)
      Command1.Enabled = False
      Command2.Enabled = True
      Label1.Refresh
      Do
         If Flag Then Exit Do
       
          '等待发出信号
          res = WaitForSingleObject(pinfo.hProcess, 0)
          If res <> WAIT_TIMEOUT Then        '如果对象发出了信号
             command1_Click
                     
             Exit Do
          End If
          DoEvents
          Debug.Print res
        
      Loop While True
      Command1.Enabled = True
      Command2.Enabled = False
     End SubPrivate Sub Command3_Click()
Flag = True
End SubPrivate Sub Form_Load()
      RunFile = InputBox$("请输入需要运行的程序名与路经")
      Flag = False
    
End Sub 

Answer 3

jiangsheng 的意见完全正确。
楼主的做法就好像要在车用蓄电池上装自爆装置一样。

Answer 4

问题是我想知道的是通过线程ID取得进程ID呀，我也不想考虑那么多。
试验是最好的方法，对吗？呵呵

Answer 5

.........100分  LZ  给偶吧  =.=!`
Private Declare Function NtQueryInformationThread Lib "Ntdll.dll" (ByVal hThread As Long, ByVal ThreadInformationClass As Long, ByVal ThreadInformation As Long, ByVal ThreadInformationLength As Long, ReturnLength As Long) As Long
Private Type CLIENT_ID
    UniqueProcess   As Long
    UniqueThread    As Long
End Type
Private Type THREAD_BASIC_INFORMATION
    ExitStatus      As Long
    TebBaseAddress  As Long
    ClientId        As CLIENT_ID
    AffinityMask    As Long
    Priority        As Long
    BasePriority    As Long
End Type
Private Const THREAD_QUERY_INFORMATION = &H40Public Function GetPID_ByTID(ByVal ThreadId As Long) As long    Dim hThread As Long
    Dim TBI As THREAD_BASIC_INFORMATION
    
    hThread = OpenThread(THREAD_QUERY_INFORMATION, False, ThreadId)
    
    If hThread Then
        NtQueryInformationThread hThread, 0&, VarPtr(TBI), Len(TBI), ByVal 0&
        GetPID_ByTID = TBI.ClientId.UniqueProcess
        CloseHandle hThread
    End If
    
End Function