防止程序多开

{*******************************************************}
{                                                       }
{                                                       }
{                                                       }
{       版权所有 (C) 2010 公司名                        }
{       防止程序多开                                    }
{                                                       }
{*******************************************************}


unit JuUniInst;

interface

implementation

uses
  SysUtils, Windows, Forms, Dialogs;

const
  JF_RESTORE = 0;
  JF_TERMINATE = 1;

const
  SUniparous = 'JuUniparousInstance';
  SErrKernelObject = 'Can not create kernel object. Shut down other applications before running this program.';
  SInfoUniqueInst = 'Only one instance can run in a computer simultaneously. Click Ok to awake it or bring it into front.';

var
  MsgId: Integer;
  OldWndProc: Pointer;
  hEvent: THandle;

function UniWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := 0;
  if Msg = MsgId then
  begin
    case wParam of
      JF_RESTORE:
      begin
        if Windows.IsIconic(Application.Handle) then
        begin
          Application.MainForm.WindowState := wsNormal;
          Application.Restore();
        end;
        Windows.PostMessage(HWND(lParam), MsgId, JF_TERMINATE, Application.MainForm.Handle);
      end;
      JF_TERMINATE:
      begin
        Windows.SetForegroundWindow(HWND(lParam));
        Application.Terminate();
      end;
    end;
  end
  else
    Result := Windows.CallWindowProc(OldWndProc, Handle, Msg, wParam, lParam);
end;

procedure SwitchToLastAppInst();
var
  LFlags: DWORD;
  LRecipients: DWORD;
begin
  Application.ShowMainForm := False;
  LFlags := BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE;
  LRecipients := BSM_APPLICATIONS;
  Windows.BroadcastSystemMessage(LFlags, @LRecipients, MsgId, JF_RESTORE, Application.Handle);
end;

function AppInstExists(): Boolean;
var
  LEvent: THandle;
begin
  LEvent := Windows.OpenEvent(EVENT_ALL_ACCESS, False, SUniparous);
  if LEvent = 0 then Result := False else Result := True;
end;

procedure InitAppInst();
begin
  if not AppInstExists() then
  begin
    hEvent := Windows.CreateEvent(nil, True, True, SUniparous);
    if hEvent = 0 then
    begin
      Dialogs.MessageDlg(SErrKernelObject, mtError, [mbOk], 0);
      Application.Terminate();
    end;
  end
  else
    SwitchToLastAppInst();
end;

initialization
  OldWndProc := Pointer(Windows.SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@UniWndProc)));
  MsgId := Windows.RegisterWindowMessage(SUniparous);
  hEvent := 0;
  InitAppInst();

finalization
  if Assigned(OldWndProc) then
    Windows.SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));
  if hEvent <> 0 then Windows.CloseHandle(hEvent);

end.