How to allow only one instance of an application (Views: 30)
Problem/Question/Abstract: I use Delphi 6 to make an application. Everytime I run the executable, an instance of my application starts up (of course). Is there any way to detect at runtime if another instance of the same application is running and switch control to the original window instead of making a new one? Answer: Solve 1: Include the following unit in your code: unit MultInst; interface const MI_QUERYWINDOWHANDLE = 1; MI_RESPONDWINDOWHANDLE = 2; MI_ERROR_NONE = 0; MI_ERROR_FAILSUBCLASS = 1; MI_ERROR_CREATINGMUTEX = 2; {Call this function to determine if error occurred in startup. Value will be one or more of the MI_ERROR_* error flags.} function GetMIError: Integer; implementation uses Forms, Windows, SysUtils; const UniqueAppStr = 'DDG.I_am_the_Eggman!'; var MessageId: Integer; WProc: TFNWndProc; MutHandle: THandle; MIError: Integer; function GetMIError: Integer; begin Result := MIError; end; function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall; begin Result := 0; {If this is the registered message...} if Msg = MessageID then begin case wParam of MI_QUERYWINDOWHANDLE: {A new instance is asking for main window handle in order to focus the main window, so normalize app and send back message with main window handle.} begin if IsIconic(Application.Handle) then begin Application.MainForm.WindowState := wsNormal; Application.Restore; end; PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE, Application.MainForm.Handle); end; MI_RESPONDWINDOWHANDLE: {The running instance has returned its main window handle, so we need to focus it and go away.} begin SetForegroundWindow(HWND(lParam)); Application.Terminate; end; end; end {Otherwise, pass message on to old window procedure} else Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam); end; procedure SubClassApplication; begin {We subclass Application window procedure so that Application.OnMessage remains available for user.} WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc))); {Set appropriate error flag if error condition occurred} if WProc = nil then MIError := MIError or MI_ERROR_FAILSUBCLASS; end; procedure DoFirstInstance; {This is called only for the first instance of the application} begin {Create the mutex with the (hopefully) unique string} MutHandle := CreateMutex(nil, False, UniqueAppStr); if MutHandle = 0 then MIError := MIError or MI_ERROR_CREATINGMUTEX; end; procedure BroadcastFocusMessage; {This is called when there is already an instance running.} var BSMRecipients: DWORD; begin {Prevent main form from flashing} Application.ShowMainForm := False; {Post message to try to establish a dialogue with previous instance} BSMRecipients := BSM_APPLICATIONS; BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE, Application.Handle); end; procedure InitInstance; begin SubClassApplication; {hook application message loop} MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr); if MutHandle = 0 then {Mutex object has not yet been created, meaning that no previous instance has been created.} DoFirstInstance else BroadcastFocusMessage; end; initialization MessageID := RegisterWindowMessage(UniqueAppStr); InitInstance; finalization {Restore old application window procedure} if WProc <> nil then SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc)); if MutHandle <> 0 then CloseHandle(MutHandle); {Free mutex} end. Solve 2: The simplest way to do this is to make the following changes to your dpr where TForm1 is the name of your main form. program Project1; uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1}; {$R *.RES} begin if FindWindow('TForm1', nil) <> 0 then begin SetForegroundWindow(FindWindow('TForm1', nil)); Exit; end; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. |