怎样用VB读取进程ID？

Question

近日，小生正在研究一个问题：怎样用VB读取进程的ID，从而控制进程，不让重复进程出现，请各位高手们赐教！~!~

Answer 1

If App.PrevInstance Then MsgBox "程序已打开不能重载"
如是是在VB测试打开的VB程序的话可以这样.
判断一个进程ID是否为有效进程可以用API来控制

Answer 2

xr105 我请教你,怎样用API来控制

Answer 3

'模块代码
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 Long
Dim hWndProcess As Long
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
    Dim pID As Long
On Error GoTo ErrH
    GetWindowThreadProcessId hwnd, pID
    If pID = lParam Then
        If GetParent(hwnd) = 0 Then
            hWndProcess = hwnd
            EnumWindowsProc = False
        End If
    End If
    EnumWindowsProc = True
    Exit Function
ErrH:
    Err.Clear
    Exit Function
End FunctionFunction FindProcessWindow(ByVal pID As Long) As Long
On Error GoTo ErrH
    hWndProcess = 0
    EnumWindows AddressOf EnumWindowsProc, pID
    FindProcessWindow = hWndProcess
    Exit Function
ErrH:
    Err.Clear
    Exit Function
End Function
'页面代码
'比方说有10个模块
Private sID(10)         As Long'执行一个模块功能
Private Sub cmdRMSCGL_Click()
    Dim hwndF        As Long
On Error GoTo ErrH
    If sID(1) <> 0 Then
        hwndF = RMSCDL_USERINOUT.FindProcessWindow(sID(1))
        If hwndF <> 0 Then
            RM_MSG.MsgOK "程序已经运行，不能再次装载。"
            Exit Sub
        End If
    End If
    If UCase(Dir(App.Path & "\****.EXE")) <> "RMSCGL.EXE" Then
        RM_MSG.MsgOK "找不到《系统****》模块!"
    Else
        sID(1) = Shell(App.Path & "\****.EXE", vbNormalFocus)
    End If
    Exit Sub
ErrH:
    Err.Clear
    Exit Sub
End Sub
'退出时
'sID(1) 记录系统管理的进程ID
Private Sub cmdQuit_Click()
    Dim hwndF                As Long
On Error GoTo ErrH:
    if sID(1))<>0 then
        hwndF = RMSCDL_USERINOUT.FindProcessWindow(sID(1))
        PostMessage hwndF, WM_CLOSE, 0, 0&
        End
    end if
    Exit Sub
ErrH:
    Err.Clear
    Exit Sub
End Sub