[原创]马大哈系列功能模块----使用互斥体实现只运行一个实例(VB6.0代码)

马大哈

<br/>对于写程序时,要求只运行一份实例的情况不在少数. <br/><br/>一般来说,采用App.PrevInstance属性来判断是否已经运行了一个实例的做法比较常见 <br/><br/>这种方案在EXE程序只有一个副本的情况下很有效,而且非常简单 <br/><br/>但是,如果程序被复制了多份甚至在不同的目录下运行时,也要求"只运行一份实例",这个方案就无效了. <br/><br/>因此,这里给出一种使用互斥体的方案,可以在以上的条件下仍然只运行一份实例,同时激活已经运行的实例. <br/><br/>原理: <br/>使用了互斥体(Mutex),然后在程序启动时查找是否有相应的互斥体存在 <br/>如果存在就退出,并广播一个消息; 不存在,就启动本次实例,并注册互斥体,同时监视消息. <br/>代码如下:<br/>

'*************************************************************************<br/>'**模 块 名：ModGetRun<br/>'**说 明：禁止运行多个实例,并激活已存在的实例(使用互斥体)<br/>'**创 建 人：马大哈<br/>'**日 期：2006年7月5日<br/>'**描 述：摘于网络<br/>'**版 本：V1.0<br/>'*************************************************************************<br/>Option Explicit<br/><br/>Private Declare Function OpenMutex Lib "kernel32" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long<br/><br/>Private Const STANDARD_RIGHTS_REQUIRED = &amp;HF0000<br/>Private Const SYNCHRONIZE = &amp;H100000<br/>Private Const MUTANT_QUERY_STATE = &amp;H1<br/>Private Const MUTANT_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or MUTANT_QUERY_STATE)<br/>Private Const MUTEX_ALL_ACCESS = MUTANT_ALL_ACCESS<br/><br/>Private Const BSF_IGNORECURRENTTASK = &amp;H2<br/>Private Const BSF_POSTMESSAGE = &amp;H10<br/>Private Const BSM_APPLICATIONS = &amp;H8<br/><br/>Private Type SECURITY_ATTRIBUTES<br/>nLength As Long<br/>lpSecurityDescriptor As Long<br/>bInheritHandle As Long<br/>End Type<br/><br/>Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long<br/>Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long<br/>Private Declare Function BroadcastSystemMessage Lib "user32" (ByVal dw As Long, pdw As Long, ByVal un As Long, ByVal wParam As Long, ByVal lParam As Long) As Long<br/><br/>Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long<br/><br/>Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long<br/>Private Const SW_HIDE = 0<br/>Private Const SW_SHOWNORMAL = 1<br/><br/>Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long<br/>Private Declare Function GetForegroundWindow Lib "user32" () As Long<br/><br/>Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long<br/>Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long<br/>Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long<br/>Private Const GWL_WNDPROC = (-4)<br/><br/>Private lPrevWndProc As Long '前一窗体过程<br/>Private hMutex As Long '互斥事件句柄<br/>Private WindowMsg As Long '自定义消息<br/>Private sa As SECURITY_ATTRIBUTES '安全属性<br/><br/>Private Const Unique = "hisofty" '自定义消息名<br/><br/><br/>Public Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _<br/>ByVal wParam As Long, ByVal lParam As Long) As Long '新窗体过程<br/>Select Case uMsg<br/>Case WindowMsg '自定义窗体消息处理<br/>MsgBox "我已经运行了!", vbInformation, "呵呵,Hi_Softy"<br/>ShowWindow hwnd, SW_SHOWNORMAL<br/>If GetForegroundWindow() &lt;&gt; hwnd Then<br/>SetForegroundWindow hwnd<br/>End If<br/>Case Else<br/>NewWindowProc = CallWindowProc(lPrevWndProc, hwnd, uMsg, wParam, lParam)<br/>End Select<br/>End Function<br/><br/>Public Sub WindowHook(ByVal hwnd As Long) '设置窗体钩子<br/>lPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)<br/>End Sub<br/><br/>Public Sub UnWindowHook(ByVal hwnd As Long) '卸载窗体钩子<br/>If lPrevWndProc &lt;&gt; GetWindowLong(hwnd, GWL_WNDPROC) Then<br/>SetWindowLong hwnd, GWL_WNDPROC, lPrevWndProc<br/>CloseHandle hMutex<br/>End If<br/>End Sub<br/><br/>Public Function InitializeFunction(ByRef TheForm As Form)<br/>WindowMsg = RegisterWindowMessage(Unique)<br/>hMutex = OpenMutex(MUTEX_ALL_ACCESS, False, Unique)<br/>If hMutex = 0 Then<br/>hMutex = CreateMutex(sa, False, Unique)<br/>Else<br/>BroadcastSystemMessage BSF_IGNORECURRENTTASK Or BSF_POSTMESSAGE, BSM_APPLICATIONS, WindowMsg, 0, 0<br/>Set TheForm = Nothing<br/>End<br/>End If<br/>End Function

<br/>完整示例代码在这里下载: <br/>http://www.m5home.com/blog2/blogview.asp?logID=466

[此贴子已经被作者于2008-4-18 22:23:42编辑过]

everyone

好 赞一个

dexawfn2008

<font face="Verdana">~ 蒙娜麗莎 ~</font>