Delphi單元檔案之－防止程式重複執行

//工程引用此單元就能防止同時出現多個執行個體

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

          {收到消息的激活前一個執行個體}

          {為什麼要在另一個程式中激活?}

          {因為在同一個程序中SetForegroundWindow并不能把窗體提到最前}

          if IsIconic(lParam) then

            OpenIcon(lParam)

          else

            SetForegroundWindow(lParam);

          Application.Terminate; {終止本執行個體}

        end;

      MI_GETHANDLE: {取得程式句柄}

          PostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP, Application.Handle);

    end;

  end

  else

    Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);

end;

procedure InitInstance;

  {取代應用程式的消息處理}

  OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

  {打開互斥對象}

  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, STR_UNIQUE);

  if MutHandle = 0 then

    {建立互斥對象}

    MutHandle := CreateMutex(nil, False, STR_UNIQUE);

    Application.ShowMainForm  :=  False;

    {已經有程式執行個體,廣播消息取得執行個體句柄}

    BSMRecipients := BSM_APPLICATIONS;

    BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);

  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.