关于防止程序多重运行的问题
在写程序时有一个问题解决不了，特来求教高手指点。此程序需要在后台做一些操作，并且程序中窗体的Visible和ShowInTaskbar属性都已经设为False，程序将来运行时，可以放到任何一个目录中。
我现在想做到，此程序的一个实例启动后（任意目录中的），先判断是否有其它的实例正在运行，如果有就循环等待其它程序实例结束后再继续执行。
程序的其它功能能已经做好了，现在就在这一个功能上卡壳了。
试过几个方法都不太理想：
1、用CreateFile 带FILE_FLAG_DELETE_ON_CLOSE创建临时文件。
2、用CreateMutex创建约定名称的互斥体。
3、用BroadcastSystemMessage或PostMessage传递自定义消息。
这几种方法都试了一下，好像都存在先前实例非正常结束，没有正确关闭某句柄，导致后面运行的实例不能正常判断先前的程序已经结束。
也许是我对这几个函数的用法不太了解，希望高手给个解决方案。不甚感谢！
App.PrevInstance 属性只能判断同一位置的实例。如果两个程序在不同的文件夹就不行了。 --------------------编程问答-------------------- 使用CreateFile创建一个知名文件，并且使用eXclusive Lock，完全可以达到应用。除非程序进程没有完全退出，否则即便是非正常退出，系统也会帮你把文件句柄给关闭掉，相比之下，这个就可以做到按用户来保证单一实例，也可以是全局，关键看文件放在什么地方去。
包括MSDN当中关闭CreateMutex的Remarks当中也有提到：
If you are using a named mutex to limit your application to a single instance, a malicious user can create this mutex before you do and prevent your application from starting. To prevent this situation, create a randomly named mutex and store the name so that it can only be obtained by an authorized user. Alternatively, you can use a file for this purpose. To limit your application to one instance per user, create a locked file in the user's profile directory. --------------------编程问答-------------------- 你也可以用 FindWindow (lpszYourWndClassName, NULL) 来判断。 --------------------编程问答-------------------- DECLARE INTEGER FindWindow IN Win32API STRING,STRING
*Declare integer FindWindow IN USER32.DLL STRING,STRING &&或用此句
LOCAL cTitle
cTitle="窗体的Caption"
IF FindWindow(0,cTitle)<>0
MESSAGEBOX("程序已运行！",48,"信息提示")
RETURN
*QUIT
ENDIF
CLEAR DLLS
--------------------编程问答-------------------- 把程序的标题搞得特别一点，每个实例运行前先遍历系统看看有没有这个特别的标题就行了。 --------------------编程问答-------------------- 最好的办法就是unsigned所说的方法
说通俗点就是这样
sub form_load()
on error goto errhandler
if not fileexist("C:\windows\temp\applock.tmp") then
filecreate "C:\windows\temp\applock.tmp"
end if
open "C:\windows\temp\applock.tmp" for binary as #1
'占用此文件
'在进程结束时windows会自动释放
errhandler:
'说明程序正在使用
end sub
--------------------编程问答-------------------- up --------------------编程问答-------------------- up --------------------编程问答--------------------
貌似互斥体在宿主挂了后也会消失?不知道有没有记错.
不过我检查了一下我以前的一个代码,好象没这现象:
http://www.m5home.com/blog2/blogview.asp?logID=466&cateID=2
测试过程:
先启动一个实例,再启动另一复制的EXE,先启动的实例会提示已经启动.
然后结束先启动的实例(用任务管理器),再启动复制的或原EXE,均正常启动..... --------------------编程问答--------------------
楼主所说的情况，是程序没有完全退出的情况，即进程实例可能没有界面了，但是还在运行（挂起了），在这种情况下任何方式都会存在问题。之所以提意使用文件，而不是内核对象，是因为内核对象的维护成本相对要高。 --------------------编程问答-------------------- 高手都出来了。有戏看！！ --------------------编程问答-------------------- 额 我的方法行么 --------------------编程问答-------------------- 晕，写注册表或写文件来判断，不就得了.
具体是:
Option Explicit
Private iCount As Integer '记录实例个数
Private Sub Form_Load()
Open "C:\Windows\System32\Data.ini" For Binary As #1
If LOF(1) Then '文件长度不为0(说明已记录)
Get #1, , iCount '获取实例个数
iCount = iCount + 1 '实例个数加1
Seek #1, 1 '定位到文件开头
Put #1, , iCount '写入当前实例个数
Else '文件长度为0(说明没有记录)
Put #1, , 1 '表示是第一个实例
End If
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Open "C:\Data.ini" For Binary As #1
Get #1, , iCount
iCount = iCount - 1 '实例个数减1
Seek #1, 1
Put #1, , iCount '写入当前实例个数
Close #1
End Sub
--------------------编程问答-------------------- 写错了
Option Explicit
Private iCount As Integer '记录实例个数
Private Sub Form_Load()
Open "C:\Windows\System32\Data.ini" For Binary As #1
If LOF(1) Then '文件长度不为0(说明已记录)
Get #1, , iCount '获取实例个数
iCount = iCount + 1 '实例个数加1
Seek #1, 1 '定位到文件开头
Put #1, , iCount '写入当前实例个数
Else '文件长度为0(说明没有记录)
Put #1, , 1 '表示是第一个实例
End If
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Open "C:\Windows\System32\Data.ini" For Binary As #1
Get #1, , iCount
iCount = iCount - 1 '实例个数减1
Seek #1, 1
Put #1, , iCount '写入当前实例个数
Close #1
End Sub
--------------------编程问答-------------------- mark --------------------编程问答-------------------- option explicit
Private Sub Timer1_Timer()
Dim iCount As Integer
Open "c:\Windows\System32\data.ini" For Binary Access Read As #1
Get #1, , iCount
Close #1
if iCount <> 0 then Msgbox "有实例在运行","提示"
End Sub
--------------------编程问答-------------------- To jy497759649,如果两个程序同一时间运行呢？虽然这种可能性很低，但是如果是通过程序一调用就大不一样了。 --------------------编程问答-------------------- To jy497759649
如果你的程序非正常退出，比如被任务管理器关了，你的计数不就不对了？ --------------------编程问答-------------------- 不会吧!............. --------------------编程问答-------------------- 是的 --------------------编程问答-------------------- 额 form_unload里面的代码在非正常退出时是不会执行的 --------------------编程问答-------------------- 是的,没错,可至少是管用的 --------------------编程问答-------------------- 这个问题我也曾经考虑过，想法到有，但未经过测试，今天正好说说，如果楼主试成功了，可以在此大家共享：
方案一，使用互斥体，CreateMutex
因为进程中止前，如不慎未采取删除措施，就会将这个互斥体标记为废弃，并自动释放所有权。共享这个互斥体的其他应用程序也许仍然能够用它，但会接收到一个废弃状态信息，指出上一个所有进程未能正常关闭。这种状况是否会造成影响取决于涉及到的具体应用程序。
方案二：使用两个比较古老的API，SetProp和GetProp，以桌面为窗口写入/读取信息。当然这可能不利于“环保”^_^
首先, 这两个方案都是全局的，因此不同的程序也可以读取或修改它。这在程序正常启动和停止时都没有任何问题。关键点在于它们的命名，我考虑除了加一个有特点的前缀外，还要加入窗口的hwnd和进程ID，这样，如果没有得到数据，说明没有前一个实例在运行，通常这是程序正常运行时的状态。另外，在读取这个值后，可以通过API来判断这个窗口或进程的状态，这样就可以知道窗口是否已关闭或进程是否仍在正常运行中了。 --------------------编程问答-------------------- 呃......还没结帖呀. --------------------编程问答-------------------- 帮顶！ --------------------编程问答-------------------- 很简单,试试这个就可以了
Private Sub Form_Load()
If App.PrevInstance Then MsgBox "程序已经启动了，": End
End Sub --------------------编程问答-------------------- 很简单,试试这个就可以了,在不同的文件夹全可以
Private Sub Form_Load()
On Error GoTo aa
If VB.App.PrevInstance Then MsgBox "程序已经启动了，": End
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.Createfolder("c:\" & "tt")
Exit Sub
aa: MsgBox "程序已经启动了，": End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set fs = CreateObject("Scripting.FileSystemObject")
fs.Deletefolder "c:\" & "tt"
End Sub
--------------------编程问答-------------------- 创建不共享文件是最保险的方法了，副程序检查指定文件是否存在，不存在则证明没有另外实例
存在则试图打开那个文件，打的开则证明没有实例，打不开证明有另外的实例
或者用类似共享内存的方式，达到不写文件的目的 --------------------编程问答-------------------- 分别有一下几种方法
1.查找窗口法
用Findwindow函数查找窗口类名和标题的窗口，然后在去判断是否执行程序。如果找到了说明程
序已经运行，不运行程序。如果没有找到，则启动当前程序。
Findwindow的API函数声明如下：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
具体实现：调用Findwindow函数，得到一个返回值，把此值赋给句柄变量，
用IF语句判断句柄变量等于0时启动程序，否则结束程序，提示程序已运行
演示代码如下：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Findwindow的API声明
Private Sub Form_Initialize()
Dim Frmhwnd As Long '定义一个变量接收Findwindow返回的句柄
Frmhwnd = FindWindow(vbNullString, "运行的窗口") '调用Findwindow查找"运行的窗口"标题的窗口
If hwnd = 0 Then '没有找到返回0
FrmMain.Show '创建并显示窗口
Else
MsgBox "程序已经运行，不能再次装载", vbExclamation, "提示" '返回句柄不为0，找到窗口提示程序运行
End '软件不运行，退出程序
End If
End Sub
2.使用互斥对象
互斥对象：能够确保多个线程对单个资源的互斥访问，即一起运行的任何线程对某资源的访问都是排他的。
该资源不会同时被两个或两个以上的线程所访问。利用互斥对象就可以限制进程的启动。
Createmutex的API函数声明如下
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As Long, _
ByVal bInitialOwner As Long, ByVal lpName As String) As Long
具体实现：通过调用API函数Createmutex创建一个互斥对象，如果成功并同时调用GetlasError函数返回的值
ERROR_ALREADY_EXISTS比较，若相等，那么说明当前进程不是应用程序的第一个实例，直接结束掉程序并提示
程序已运行。若不相等，则说明是应用程的第一个实例。
演示代码如下：
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As Long, _
ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long '释放由线程拥有的一个互斥体
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '关闭一个互斥体对象
Public ret As Long
Private Sub Form_Load()
ret = CreateMutex(ByVal 0, 1, "互斥对象") '调用CreateMutex创建一个名为“互斥对象”的互斥对象
If Err.LastDllError = 183 Then '判断程序是不是第一个实例
MsgBox "程序只能运行一次!", vbExclamation, "提示" '不是第一个实例提示
End '软件不执行，程序退出
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call ReleaseMutex(ret) '释放互斥对象
Call CloseHandle(ret) '关闭互斥对象
End Sub
注意：在软件关闭之时应该要释放和关闭互斥对象，否则在下次运行程序将无法打开程序，原因是互斥对象还存在。
3.全局原子法
全局原子：由Windows系统负责维持的，它能保证其中的每个原子都是唯一的，管理其引用计数，
并且当该全局原子的引用计数为0时，系统就会从该内存将该原子清除掉。
添加全局原子用API函数GlobalAddatom
Public Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
查找全局原子用API函数GlobalFindAtomA
Public Declare Function GlobalFindAtom Lib "kernel32" Alias "GlobalFindAtomA" (ByVal lpString As String) As Integer
删除全局原子用API函数GlobalDeleteAtom
Public Declare Function GlobalDeleteAtom Lib "kernel32" Alias "GlobalDeleteAtom" (ByVal nAtom As Integer) As Integer
具体实现：利用GlobalAddatom函数向系统添加全局原子，然后利用GlobalFindAtomA函数查找是否存在该原子，
若村子结束运行并提示程序已运行，否则启动程序。在进程退出时记得使用GlobalDeleteAtom函数删除之前添加
的全局原子，否则下次程序将无法启动。
利用全局原子的引用计数规则，还可以判断当前共运行了该程序的多少个实例。
4.利用App对象的PrevInstance属性
这个比较简单一点，利用VB自带的利用App对象的PrevInstance属性的真假就可以判断程序有没有运行了
当App.PrevInstance为True说明程序已经运行了，此时在运行程序将提示程序已经运行了，不可以在运再
次装在，否则App.PrevInstance为False则可以运行程序。
演示代码如下：
Private Sub Form_Load()
If App.PrevInstance = True Then
MsgBox "程序已经运行，不能再次装载", vbExclamation, "提示"
Unload Me
End If
End Sub
--------------------编程问答-------------------- 楼主说"我现在想做到，此程序的一个实例启动后（任意目录中的），先判断是否有其它的实例正在运行，如果有就循环等待其它程序实例结束后再继续执行。 "
可以判断楼主不是想简单的判断是否有其他实例在运行，而是每次运行程序时先判断是否有其他实例在运行，如果有的话就做一个循环等待直到没有任何其他实例运行时在继续执行下面的代码，那这就需要一个执行队列。
假设用注册表的键值来保存实例执行队列的pid值（用字符隔开好拆分）
程序运行后从头检测pid队列中各值是否有效，如存在有效pid则将本实例pid添加至队列末尾，然后循环检测pid队列，直到队列为空或者pid队列中值全部无效，跳出循环继续执行代码。
退出程序时将pid队列中本实例的pid移除。
--------------------编程问答-------------------- 记得不要重复添加同一实例pid --------------------编程问答--------------------
Option Explicit
Public Const SYNCHRONIZE = &H100000
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public cpid As Long
Public Sub Main()
Dim st As String
Dim et As String
Dim pidQueue As String
Dim pid As Long
Dim apid() As String
Dim i As Integer
st = Format(Time, "HH:MM:SS")
cpid = GetCurrentProcessId
pidQueue = GetSetting("multiapp", "pid", "queue", "NONE")
If pidQueue = "NONE" Or pidQueue = "" Then
SaveSetting "multiapp", "pid", "queue", CStr(cpid)
Else
AddQueue
Do While Not SelfTurn
Sleep 100
DoEvents
Loop
End If
et = Format(Time, "HH:MM:SS")
MsgBox "启动时间：" & st & vbCrLf & "运行时间：" & et
RemoveQueue
End Sub
Public Function isPID(pid As Long) As Boolean
Dim Handle As Long
Handle = OpenProcess(SYNCHRONIZE, 0, pid)
If Handle = 0 Then Exit Function
CloseHandle Handle
isPID = True
End Function
Public Function SelfTurn() As Boolean
Dim pqueue As String
Dim pid() As String
SelfTurn = True
Do While True
pqueue = GetSetting("multiapp", "pid", "queue")
If pqueue = "" Then Exit Function
pid = Split(pqueue, "|", , vbTextCompare)
If isPID(Val(pid(0))) Then
SelfTurn = cpid = Val(pid(0))
Exit Function
Else
If Not RemoveQueue Then Exit Function
End If
DoEvents
Loop
SelfTurn = False
End Function
Public Sub AddQueue()
Dim pqueue As String
pqueue = GetSetting("multiapp", "pid", "queue")
SaveSetting "multiapp", "pid", "queue", pqueue & "|" & CStr(cpid)
End Sub
Public Function RemoveQueue() As Boolean
Dim i As Integer
Dim pqueue As String
pqueue = GetSetting("multiapp", "pid", "queue")
If pqueue = "" Then Exit Function
i = InStr(1, pqueue, "|", vbTextCompare)
If i = 0 Then
SaveSetting "multiapp", "pid", "queue", ""
Else
SaveSetting "multiapp", "pid", "queue", Right(pqueue, Len(pqueue) - i)
End If
RemoveQueue = True
End Function
给分吧老大。 --------------------编程问答-------------------- mark --------------------编程问答-------------------- 我看有必要在显要位置给出CSDN分值运作系统的原理.....
不然总有人不知道结帖...... --------------------编程问答-------------------- 这几句都中了
Private Sub Form_Load()
If App.PrevInstance Then
End
End If
End Sub
--------------------编程问答-------------------- 无论程序放在任何地方，程序只能运行一次。
Option Explicit
'防止程序重复执行
Private Declare Function ReleaseSemaphore Lib "kernel32" (ByVal hSemaphore As Long, ByVal lReleaseCount As Long, lpPreviousCount As Long) As Long
Private Declare Function CreateSemaphore Lib "kernel32" Alias "CreateSemaphoreA" (lpSemaphoreAttributes As SECURITY_ATTRIBUTES, ByVal lInitialCount As Long, ByVal lMaximumCount As Long, ByVal lpName As String) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Sub Form_Load()
On Error Resume Next
'让程序在不同地点只能运行一次
'用此程序段的原因：因为App.PrevInstance 只能影响同目录的同一程序
'但不能影响其它目录的同一程序。
'--------------------------------------------------------------
Dim MdiMenuHwnd As Long
Dim hMenu As Long
Dim Semaphore As String, Sema As Long, Security As SECURITY_ATTRIBUTES
Dim PrevSemaphore As Long, Turn As Long
Security.bInheritHandle = True
'默认的安全值
Security.lpSecurityDescriptor = 0
Security.nLength = Len(Security)
Semaphore = "第一个" '此处的值每个程序都不能一样，否则凡是此处写第一个的程序都不能运行二次
'创建或打开一个Semaphore记数信号，设资源空闲使用量为1
Sema = CreateSemaphore(Security, 1, 1, Semaphore)
'申请一个权限，并立即返回
Turn = WaitForSingleObject(Sema, 0)
'如果不是正常返回，则表示没有申请到资源的使用权限
If Turn <> 0 Then
MsgBox "此程序已经在运行了！", vbExclamation Or vbOKOnly, Me.Caption
End
End If
End Sub
源文件下载地址:http://hi.baidu.com/icecept/blog/item/2d357dd10e7f1e3b9a502743.html --------------------编程问答-------------------- LS的代码应该标准一点 虽然最后都会被销毁 但感觉还是按套路出牌好点
Private Sub Form_Unload(Cancel As Integer)
ReleaseSemaphore Sema, 1, ByVal 0
CloseHandle Sema
End Sub
也可以用GlobalAddAtom GlobalFindAtom GlobalDeleteAtom
warcraftmgq 的方法有点离谱。。。
个人感觉
Findwindow 是简单并实用的方法 如果找到 直接SHOWWINDOW 多方便 --------------------编程问答--------------------
'好办--------------------编程问答-------------------- 值得学习，帮顶 --------------------编程问答-------------------- 大家的方法都很好，不过我有一个想法更简单的，不知道可行不，现在提出来。
Set wlclass=Nothing
由于套接字的端口都是独占的，
所以我建议程序启动后监听一个端口，
如果另外一个程序发现该端口有人开着，证明这个程序还在执行，
所以就建立一个Timer等待它的结束，同时，您还可以和开着的程序对话，例如，叫它退出来，该轮到自己（当前程序）工作了。
--------------------编程问答-------------------- --------------------编程问答-------------------- LS的
帮顶 --------------------编程问答-------------------- mark --------------------编程问答-------------------- 标记,查看. --------------------编程问答-------------------- 小经验，有用的。 --------------------编程问答--------------------
11 --------------------编程问答-------------------- 1111 --------------------编程问答-------------------- 有用 --------------------编程问答-------------------- 纯属路过。 --------------------编程问答-------------------- [img=http://p.blog.csdn.net/images/p_blog_csdn_net/zswang/%E9%B9%BF%E8%BF%87.gif]图[/img] --------------------编程问答-------------------- 69348 --------------------编程问答-------------------- 纯属路过。 --------------------编程问答-------------------- [img=http://p.blog.csdn.net/images/p_blog_csdn_net/zswang/%E7%85%A7%E7%9B%B8.gif]图[/img] --------------------编程问答-------------------- 这贴老老了，估计LZ都失踪了~~
呵呵~~
感觉文件独占法~~ACTIVE部件法比较实用~~
REG法用过，不太理想~~INI配置文件法，其实中REG法类似~ --------------------编程问答-------------------- 有用 --------------------编程问答-------------------- CreateMutex还有vb自带的一个apint的属性都可以做
CreateMutex 不知道你跟过代码没有
getlasterror值如果是废弃的话
不妨碍判断的，因为如果有这个互斥体的话
那么getlasterror就是ERROR_ALREADY_EXISTS
你不需要对这个互斥体进行操作 废弃不会影响你使用 --------------------编程问答-------------------- 学习了，受教了！！ --------------------编程问答--------------------
Private Sub Form_Load()--------------------编程问答-------------------- App.PrevInstance --------------------编程问答-------------------- 用CreateMutex可以。自动释放。 --------------------编程问答--------------------
If App.PrevInstance Then End
End Sub
补充：VB , API
