当前位置: 首页 > 技术文档 > 正文
avatar

做软件时,难免需要禁止自己的程序被多次打开。我就是这样,网上找了好久。终于找到一个好用的代码,直接加入uses […]

做软件时,难免需要禁止自己的程序被多次打开。我就是这样,网上找了好久。终于找到一个好用的代码,直接加入uses里就可以用。
使用方法:
直接将以下代码另存为”MultInst.pas”,并在uses中加入’MultInst’.

unit MultInst; 

interface 

uses 
   Windows ,Messages, SysUtils, Classes, Forms; 

implementation 

const 
   STR_UNIQUE     = '{2BE6D96E-827F-4BF9-B33E-8740812CDE96}'; //这里是互诉标识可以自行修改
   MI_ACTIVEAPP   = 1;   //激活应用程序 
   MI_GETHANDLE   = 2;   //取得句柄 

var 
   iMessageID     : Integer; 
   OldWProc       : TFNWndProc; 
   MutHandle      : THandle; 
   BSMRecipients : DWORD; 

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): 
   Longint; stdcall; 
begin 
   Result := 0; 
   if Msg = iMessageID then 
   begin 
     case wParam of 
       MI_ACTIVEAPP: //激活应用程序 
         if lParam<>0 then 
         begin 
           //收到消息的激活前一个实例 
           //为什么要在另一个程序中激活? 
           //因为在同一个进程中SetForegroundWindow并不能把窗体提到最前 
           if IsIconic(lParam) then 
             OpenIcon(lParam) 
           else 
             SetForegroundWindow(lParam); 
           //终止本实例 
           Application.Terminate; 
         end; 
       MI_GETHANDLE: //取得程序句柄 
         begin 
           PostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP, 
             Application.Handle); 
         end; 
     end; 
   end 
   else 
     Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam); 
end; 

procedure InitInstance; 
begin 
   //取代应用程序的消息处理 
   OldWProc     := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, 
     Longint(@NewWndProc))); 

   //打开互斥对象 
   MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, STR_UNIQUE); 
   if MutHandle = 0 then 
   begin 
     //建立互斥对象 
     MutHandle := CreateMutex(nil, False, STR_UNIQUE); 
   end 
   else begin 
     Application.ShowMainForm   :=   False; 
     //已经有程序实例,广播消息取得实例句柄 
     BSMRecipients := BSM_APPLICATIONS; 
     BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, 
         @BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle); 
   end; 
end; 

initialization 
   //注册消息 
   iMessageID   := RegisterWindowMessage(STR_UNIQUE); 
   InitInstance; 

finalization 
   //还原消息处理过程 
   if OldWProc <> Nil then 
     SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc)); 

   //关闭互斥对象 
   if MutHandle <> 0 then CloseHandle(MutHandle); 

end.
本文固定链接: https://blog.yanhualou.com/jishu/126.html | 烟花楼博客
标签:

delphi 防止程序多开:等您坐沙发呢!

发表评论

快捷键:Ctrl+Enter