两种Delphi防止多实例运行的方法

  在学习Delphi时,遇到需要程序单实例运行的时候,经过查阅,暂时发现以下两种比较简单的方法,可以防止程序多实例运行,各有优劣,据需选择。


方法一,添加以下unit即可,优点是可激活已存在的程序窗口,即使已最小化(包括最小化到托盘),缺点是可能存在与其他程序的互斥(可自行修改STR_UNIQUE的值以尽量减少该可能性)。代码如下:

//工程引用此单元就能防止同时出现多个实例
unit MultInst;

interface

uses
 Windows ,Messages, SysUtils, Classes, Forms;

implementation

const
 STR_UNIQUE    = '{2BE6D96E-827F-4BF9-B33E-8740412CDE96}';//建议修改
 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
         {激活前一个实例}
         if IsIconic(lParam) then
         begin
           OpenIcon(lParam);
           SendMessage(lParam,WM_SYSCOMMAND,SC_DEFAULT ,SC_SCREENSAVE);{激活窗口}
           end
         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.

方法二,修改工程文件源代码,程序初始化时创建互斥对象,并检查是否互斥以保证单实例运行。优点是代码少且简单,缺点是无法将已运行的窗口激活。实例代码如下:

program Project1;
uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Windows,Messages,ShellApi;
{$R *.res}
var
  HMutex:Hwnd;
  Ret:Integer;
  Reg :integer;
begin
  Application.Initialize;
  Application.Title :='这是一个防止多个实例运行的程序';
  HMutex  :=CreateMutex(nil,False,Pchar('这是一个防止多个实例运行的程序'));
  Reg :=GetLastError;
  if Reg<>ERROR_ALREADY_EXISTS then
    begin
      Application.CreateForm(TForm1, Form1);
    end
  else
    begin
      MessageBox(0,'实例已经运行了!','错误', MB_OK + MB_ICONERROR);
      ReleaseMutex(hMutex);
    end;
  Application.Run;
end
有人爱: 醉倚黄昏
有事做: https://zyhh.me/delphi/delphi-single-instance.html
有所期待: 一个有雨有肉的夜晚,和你没头没尾分一瓶酒。