用内存映射判断应用程序是否运行多次
判断应用程序是否运行多次在 VB 中多种方法可以实现:
1、查找窗口法,利用 FindWindow 函数查找同名的窗口,如找到则说明运行了多个实例。
2、枚举窗口法,利用 EnumWindows 函数枚举屏幕中的所有窗口,再用 GetWindowText 函数取得标题,然后检查标题。
3、文件标识法,在第一次运行程序时在文件中、或注册表中写入判断的标识,程序退出时再把标识修改过来,然后根据标识判断程序是否运行。
但是上述方法都有这样那样的缺点,如:
1、2 查找窗口法、枚举窗口法
如果应用程序无窗口、窗口名动态变化或窗口名相同而程序不同,则判断会出现问题,
3、文件标识法
如果程序在运行时出现非常操作,或突然系统Down 了,则也会出现判断错误的问题。
那么,有没有一种方法可以解决上述的问题呢,当然是有得了,在 VB 中可以通过 CreateMutex 函数用互斥法、 CreateFileMapping 函数用内存映射法来判断,这里由于篇幅问题,只介绍内存映射法:
内存映射文件是在内存中建立的可供所有进程共享的文件。当程序的每个实例运行时都将判断指定的内存映射文件是否存在,如果已经存在,则说明已经运行有应用程序运行了;如果不存在指定的内存映射文件,则证明当前的应用程序是第一个应用程序,同时建立一个指定的内存映射文件,直到这个实例关闭时才关闭这个内存映射文件。这样,即使发生停电、死机等意外,机器重新启动以后,内存全部刷新,指定的内存文件自然消失,对程序判断无任何影响。
程序代码如下 :
Form1.frm 文件
Option Explicit
Private Sub Form_Load()
Main
End Sub
Module.bas 文件
Option Explicit
`声明相关函数
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
(ByVal hFile As Long, lpFileMappigAttributes As SECURITY_ATTRIBUTES, ByVal flProtect _
As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName _
As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Const PAGE_READWRITE = 1
Const ERROR_ALREADY_EXISTS = 183&
Public Sub Main()
Dim ynRun As Long
Dim sa As SECURITY_ATTRIBUTES
sa.bInheritHandle = 1
sa.lpSecurityDescriptor = 0
sa.nLength = Len(sa)
ynRun = CreateFileMapping(&HFFFFFFFF, sa, PAGE_READWRITE, 0, 128, App.Title) `创建内存映射文件
If ynRun = 0 Then MsgBox "创建内存映射文件失败", vbQuestion, "错误"
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then `如果指定内存文件已存在,则提示并退出
MsgBox "程序已运行!", vbQuestion, "错误"
CloseHandle ynRun `退出程序前关闭内存映射文件
End
End If
End Sub
判断应用程序是否运行多次在 VB 中多种方法可以实现:
1、查找窗口法,利用 FindWindow 函数查找同名的窗口,如找到则说明运行了多个实例。
2、枚举窗口法,利用 EnumWindows 函数枚举屏幕中的所有窗口,再用 GetWindowText 函数取得标题,然后检查标题。
3、文件标识法,在第一次运行程序时在文件中、或注册表中写入判断的标识,程序退出时再把标识修改过来,然后根据标识判断程序是否运行。
但是上述方法都有这样那样的缺点,如:
1、2 查找窗口法、枚举窗口法
如果应用程序无窗口、窗口名动态变化或窗口名相同而程序不同,则判断会出现问题,
3、文件标识法
如果程序在运行时出现非常操作,或突然系统Down 了,则也会出现判断错误的问题。
那么,有没有一种方法可以解决上述的问题呢,当然是有得了,在 VB 中可以通过 CreateMutex 函数用互斥法、 CreateFileMapping 函数用内存映射法来判断,这里由于篇幅问题,只介绍内存映射法:
内存映射文件是在内存中建立的可供所有进程共享的文件。当程序的每个实例运行时都将判断指定的内存映射文件是否存在,如果已经存在,则说明已经运行有应用程序运行了;如果不存在指定的内存映射文件,则证明当前的应用程序是第一个应用程序,同时建立一个指定的内存映射文件,直到这个实例关闭时才关闭这个内存映射文件。这样,即使发生停电、死机等意外,机器重新启动以后,内存全部刷新,指定的内存文件自然消失,对程序判断无任何影响。
程序代码如下 :
Form1.frm 文件
Option Explicit
Private Sub Form_Load()
Main
End Sub
Module.bas 文件
Option Explicit
`声明相关函数
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
(ByVal hFile As Long, lpFileMappigAttributes As SECURITY_ATTRIBUTES, ByVal flProtect _
As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName _
As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Const PAGE_READWRITE = 1
Const ERROR_ALREADY_EXISTS = 183&
Public Sub Main()
Dim ynRun As Long
Dim sa As SECURITY_ATTRIBUTES
sa.bInheritHandle = 1
sa.lpSecurityDescriptor = 0
sa.nLength = Len(sa)
ynRun = CreateFileMapping(&HFFFFFFFF, sa, PAGE_READWRITE, 0, 128, App.Title) `创建内存映射文件
If ynRun = 0 Then MsgBox "创建内存映射文件失败", vbQuestion, "错误"
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then `如果指定内存文件已存在,则提示并退出
MsgBox "程序已运行!", vbQuestion, "错误"
CloseHandle ynRun `退出程序前关闭内存映射文件
End
End If
End Sub