Author: Jonas Bilinkevicius
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:
1 unit MultInst;
2
3 interface
4
5 const
6 MI_QUERYWINDOWHANDLE = 1;
7 MI_RESPONDWINDOWHANDLE = 2;
8 MI_ERROR_NONE = 0;
9 MI_ERROR_FAILSUBCLASS = 1;
10 MI_ERROR_CREATINGMUTEX = 2;
11
12 {Call this function to determine if error occurred in startup. Value will be one
13 or
14 more of the MI_ERROR_* error flags.}
15
16 function GetMIError: Integer;
17
18 implementation
19
20 uses
21 Forms, Windows, SysUtils;
22
23 const
24 UniqueAppStr = 'DDG.I_am_the_Eggman!';
25
26 var
27 MessageId: Integer;
28 WProc: TFNWndProc;
29 MutHandle: THandle;
30 MIError: Integer;
31
32 function GetMIError: Integer;
33 begin
34 Result := MIError;
35 end;
36
37 function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint;
38 stdcall;
39 begin
40 Result := 0;
41 {If this is the registered message...}
42 if Msg = MessageID then
43 begin
44 case wParam of
45 MI_QUERYWINDOWHANDLE:
46 {A new instance is asking for main window handle in order to focus the
47 main window, so normalize app and send back message with main window handle.}
48 begin
49 if IsIconic(Application.Handle) then
50 begin
51 Application.MainForm.WindowState := wsNormal;
52 Application.Restore;
53 end;
54 PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
55 Application.MainForm.Handle);
56 end;
57 MI_RESPONDWINDOWHANDLE:
58 {The running instance has returned its main window handle, so we need to
59 focus it and go away.}
60 begin
61 SetForegroundWindow(HWND(lParam));
62 Application.Terminate;
63 end;
64 end;
65 end
66 {Otherwise, pass message on to old window procedure}
67 else
68 Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
69 end;
70
71 procedure SubClassApplication;
72 begin
73 {We subclass Application window procedure so that Application.OnMessage
74 remains available for user.}
75 WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
76 Longint(@NewWndProc)));
77 {Set appropriate error flag if error condition occurred}
78 if WProc = nil then
79 MIError := MIError or MI_ERROR_FAILSUBCLASS;
80 end;
81
82 procedure DoFirstInstance;
83 {This is called only for the first instance of the application}
84 begin
85 {Create the mutex with the (hopefully) unique string}
86 MutHandle := CreateMutex(nil, False, UniqueAppStr);
87 if MutHandle = 0 then
88 MIError := MIError or MI_ERROR_CREATINGMUTEX;
89 end;
90
91 procedure BroadcastFocusMessage;
92 {This is called when there is already an instance running.}
93 var
94 BSMRecipients: DWORD;
95 begin
96 {Prevent main form from flashing}
97 Application.ShowMainForm := False;
98 {Post message to try to establish a dialogue with previous instance}
99 BSMRecipients := BSM_APPLICATIONS;
100 BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
101 @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE, Application.Handle);
102 end;
103
104 procedure InitInstance;
105 begin
106 SubClassApplication; {hook application message loop}
107 MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
108 if MutHandle = 0 then
109 {Mutex object has not yet been created, meaning that no previous instance
110 has been created.}
111 DoFirstInstance
112 else
113 BroadcastFocusMessage;
114 end;
115
116 initialization
117 MessageID := RegisterWindowMessage(UniqueAppStr);
118 InitInstance;
119 finalization
120 {Restore old application window procedure}
121 if WProc <> nil then
122 SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
123 if MutHandle <> 0 then
124 CloseHandle(MutHandle); {Free mutex}
125 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.
126 program Project1;
127
128 uses
129 Forms, Windows, Unit1 in 'Unit1.pas' {Form1};
130
131 {$R *.RES}
132
133 begin
134 if FindWindow('TForm1', nil) <> 0 then
135 begin
136 SetForegroundWindow(FindWindow('TForm1', nil));
137 Exit;
138 end;
139 Application.Initialize;
140 Application.CreateForm(TForm1, Form1);
141 Application.Run;
142 end.
|
