检测某程序运行实例数,并控制该实例

Question

还有点事情想请教一下.就是我现在一台服务器上有一个程序(DBCONFIG.EXE)因为该服务器是我们远程桌面的形式登陆控制的.同时登陆人员>=2.现在我想做个小程序对该(DBCONFIG.EXE)进行一个限制,就是只能开启一个.也就是说只能有其中某一登陆人员能运行单一实例,如第二个登陆人员想运行,或原已经运行的那个人员打开第二个实例时提示"该程序已经有人运行使用中"
我之前在单程序内做过阻止第二实例运行的,但这个(DBCONFIG.EXE)我无法修改它,所以要用一个小的检测软件来检测并限制它,这个代码的话该如何写呢?
有些注意点是这样的,我整理一下哦:
1.服务器为多用户远程桌面登陆型.
2.任何用户都有开启的权限
3.有用户已在使用的状况下检测并提示"该程序有在使用中"
4.利用信息可通知使用者(这个只是小提示)
5.有关闭使用者在使用的权限(比如关闭该进程)
6.所有的这些功能都是在一个外挂程序中检测,示警,控制
x.如果有可能的话是否可以将以运行的那个用户的实例调制到控制方使用(远程桌面用户据说可达到这个功能,不过我是一直没有实现过)

Answer 1

Public Sub Main()
    
    '仅可同时开启一个程序
    If App.PrevInstance Then Exit Sub
end sub

Answer 2

我的思路有两种方法:
第一种方法前提是你必须可以重命名DBCONFIG.EXE.把原程序: DBCONFIG.EXE  重命名成 DBCONFIG1.EXE你自己编写的检测程序如: 工程1.exe 重命名成 DBCONFIG.EXE当用户启动 DBCONFIG.EXE 就是启动 工程1.exe, 当工程1.exe启动时,就可以检测进程里是否已经包含DBCONFIG1.EXE工程1的代码如下:Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As LongPrivate Sub Form_Load()
Dim a As String
    Dim hSnapShot As Long, uProcess As PROCESSENTRY32
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    r = Process32First(hSnapShot, uProcess)
      Do While r
    a = a & Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) & vbCrLf
        r = Process32Next(hSnapShot, uProcess)
    Loop
a = UCase(a) '得到所有的进程数If InStr(a, "DBCONFIG1.EXE") = 0 Then
 'Shell App.Path & "\DBCONFIG1.EXE"  '正常启动DBCONFIG.EXE
 MsgBox "正常启动DBCONFIG.EXE"
Else
 MsgBox "该程序已经有人运行使用中"
End If
'end
End Sub上面这种方法可以避免监视程序一直在后台运行,增加服务器负担.第二种方法就是当你没有权限重命名时,你就只有必须把上面的foad中的代码放入timer中并稍加修改一下,时时监视进程,一旦出现两个该进程就立即结束刚启动的那一个进程.  

Answer 3

测试还不错...不过 InStr(a, "DBCONFIG1.EXE") = 0 在P-CODE 和本机代码中结果会出错.须改为全格式才可以..
还有一个就是MSGBOX的提醒须改掉.我改了为其他的一个FROM,因为在MSGBOX的时候,代码在此时是中止的.记时停止..

Answer 4

Function CheckApplicationIsRun(ByVal szExeFileName As String) As Boolean
On Error GoTo Err
Dim WMI, Obj, Objs
CheckApplicationIsRun = False
Set WMI = GetObject("WinMgmts:")
Set Objs = WMI.InstancesOf("Win32_Process")
For Each Obj In Objs
 If InStr(UCase(szExeFileName), UCase(Obj.Description)) <> 0 Then
 CheckApplicationIsRun = True
 If Not Objs Is Nothing Then Set Objs = Nothing
 If Not WMI Is Nothing Then Set WMI = Nothing
 Exit Function
 End If
Next++++++++++++++++++++++++
顺便问下,上面这段代码与您提供的进程获取的代码有些什么不同.两者的好坏在哪里..?