Related
Is there a global WinProc for all windows in an application or a way to capture all paint messages to the application for a brief period of time? Some of the third party libraries that we use add their own wndproc's to controls (e.g. DevExpress ribbon, Docking Manager).
We have some code that should be run in a background thread but that's not possible at the moment. This code can take a long time to run and obviously the application becomes unresponsive during this time. We can't use things like processmessages because that would result in the code being reentered. To get around this I thought it should be possible to create our own version of ProcessMessages that looks for specific messages. The idea is that I would create a small panel with a progress bar and a cancel button and then only allow messages for the cancel button's windows handle.
The simplified code to process a single message looks something like this:
begin
if PeekMessage(aMsg, 0, 0, 0, PM_NOREMOVE) then
begin
Unicode := (aMsg.hwnd = 0) or IsWindowUnicode(aMsg.hwnd);
if Unicode then
MsgExists := PeekMessageW(aMsg, 0, 0, 0, PM_REMOVE)
else
MsgExists := PeekMessageA(aMsg, 0, 0, 0, PM_REMOVE);
if MsgExists then
begin
Result := True;
if aMsg.hwnd = aButtonWindowsHandle then
begin
TranslateMessage(aMsg);
if Unicode then
DispatchMessageW(aMsg)
else
DispatchMessageA(aMsg);
end
else
begin
// WM_PAINT is a special message. If you don't handle a WM_PAINT
// then windows will just stick it back in the queue again.
if (aMsg.message = WM_PAINT) and (aMsg.hwnd <> 0) then
begin
// Queue this paint message so we do an update when the
// processing is finished.
FQueuedPaintMessages.Add(aMsg);
// Paint nothing here otherwise Windows will send it again and
// insist that we paint it.
if BeginPaint(aMsg.hwnd, paintStruct) <> 0 then
EndPaint(aMsg.hwnd, paintStruct);
end;
end;
end;
end;
end;
This is called as follows:
while ProcessMessage(msg) do {loop};
This appeared to work correctly but during testing I picked up a couple of cases where one of the Windows API calls (PeekMeesage, TranslateMessage, DispatchMessage, or the two painting calls) is triggering a call back to our docking control's WndProc via KiUserCallbackDispatcher in ntdll.dll. The docking control is ultimately triggering a paint which is a problem. I am not sure what Windows API call it is because the stack trace is missing some lines at that point. It only happens on one of our test machines so I can't put in a breakpoint.
I am aware that this is far from an ideal solution and that we would be better off rewriting the code so that it can be run in a background thread but that would be a huge amount of work and is not feasible at this time.
It looks like SetWindowsHookEx with WH_MOUSE_LL might be a solution but that still needs a message loop.
Not so much an answer to your question than maybe a potential solution to your problem...
Instead of having a panel with a "cancel" button, instead display a label saying "Press and hold ESC to cancel process". Then, within your process you can get the status of the ESC key by calling GetAsyncKeyState at regular interval. I did not test it, but I'd expect it to work at least "well enough" for your needs.
The selected answer gave me a solution to my problem but #IInspectable answered the question about catching all of the paint messages. So for other people looking at that question. The answer is this:
"None of this can be made to work reliably with reasonable effort. It's just a clumsy attempt at fighting the system, and the system is going to win that one."
In other words. Don't try and do it.
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions concerning problems with code you've written must describe the specific problem — and include valid code to reproduce it — in the question itself. See SSCCE.org for guidance.
Closed 9 years ago.
Improve this question
In my execute block that gets called with a button click, I create a popup menu to appear where the button was clicked. It current appears properly, with a few items with one of them having a couple sub items. When this that runs once then calls the destructor, it is fine. But if I execute it twice (show the popup and click an item twice) then destruct, the application crashes. I think it is because I'm not freeing the popup correctly (which is declared as a private property).
procedure TPlugIn.Execute(AParameters : WideString);
var
i: Integer;
pnt: TPoint;
begin
GetCursorPos(pnt);
FPopup := TPopupMenu.Create(nil);
FPopup.OwnerDraw:=True;
FPopup.AutoHotkeys := maManual;
//SQL Upgrade
Item := TMenuItem.Create(FPopup);
Item.Caption := 'Database Install/Upgrade';
Item.OnClick := ShowItemCaption;
FPopup.Items.Add(Item);
//Language Folder
Item := TMenuItem.Create(FPopup);
Item.Caption := 'Language Folder';
Item.OnClick := ShowItemCaption;
FPopup.Items.Add(Item);
//Machines
Item := TMenuItem.Create(FPopup);
Item.Caption := 'Machines';
MachineItem := TMenuItem.Create(FPopup);
MachineItem.Caption := 'Sample Machine 1';
MachineItem.OnClick := ShowItemCaption;
Item.Add(MachineItem);
MachineItem := TMenuItem.Create(FPopup);
MachineItem.Caption := 'Sample Machine 2';
MachineItem.OnClick := ShowItemCaption;
Item.Add(MachineItem);
FPopup.Items.Add(Item);
Self.FPopup := FPopup;
FPopup.Popup(pnt.X, pnt.Y);
end;
In the ShowItemCaption procedure I just show the caption of that sender object. I haven't coded specific events yet. If it free the popup in the execute procedure, the popup doesn't appear anymore.
destructor TPlugIn.Destroy;
begin
inherited;
FPopup.Free;
//ShowMessage('freed');
end;
First of all, you have completely misdiagnosed your problem. As a result you haven't given the information that we need in order to give you a definite solution.
If I take the code you provided, and test it similar to your description: using one button to call the code in the Execute method, and another button to Free FPopup, I don't get an error. In fact you should try this yourself; you also shouldn't get an error; which means that the problem doesn't lie in the code you've provided.
However, that said: I can help you to better diagnose the problem, after which you may be able to solve it yourself - or at least give us better information to help you.
Also you do still have a number of mistakes in this code that need to be fixed - even if the mistakes don't cause your application to crash.
Let's start by diagnosing the real problem. Is your program really crashing or are you just getting an exception in the debugger? I ask, because it usually requires something a little more extreme to truly crash a Delphi application.
If you are just getting an exception, I suspect the debugger is taking you to the line FPopup.Free; (Note this is not the line where the problem is - the debugger usually takes you to the line after; which would mean the problem is somewhere in the inherited Destroy). Also you need to tell us the exception class and message you are getting.
Either way, even if your application really is crashing, it will almost always be preceded by an exception. And you need to pinpoint exactly where that exception is happening. To do so, you need to:
Run your application through the debugger.
Make sure the debugger is set to stop whenever an exception occurs.
Given that the exception may be happening inside the TPlugIn class, make sure that unit is not disabling debug information.
You might also need to set your project options to "Use Debug DCU's".
Do your test.
When you get your exception, remember the debugger will usually show you the line after the one that caused the exception. You now need to consider the problem line in conjunction with the error message to figure out what might be going wrong.
If you're getting an Access Violation, that is usually because you're trying to:
Use something that hasn't been created.
Destroy something that has already been destroyed.
Use something that has already been destroyed.
To investigate the Access Violation further:
Identify the problem object.
Put breakpoints in your code where the object is created/destroyed.
Run through your code, hitting the breakpoints and figure out what is going on.
Additional Problems
You mentioned that "if you Free the popup in the Execute procedure, it doesn't appear anymore". (Presumably this was your attempt to avoid the memory leak.) This is because when you call FPopup.Popup(pnt.X, pnt.Y); it doesn't "pause your code" and wait for an item to be selected. Your code continues running because menus use an event driven model to callback when the item is clicked. Therefore your popup menu would be destroyed, and disappear immediately after it popped up.
The line Self.FPopup := FPopup; is totally redundant and does nothing. You're effectively saying FPopup := FPopup - you're not changing FPopup's value in any way.
It should be very obvious that the title "Freeing the popup twice crashes application" is totally incorrect. As per your code and description: you are creating the popup twice and freeing it only once.
That in itself is a problem, because as Jerry pointed out - you have a memory leak. Basically your code overwrites the reference to the first TPopup you created, leaving it "orphaned" and holding onto memory. You then only Free/Destroy the last one created in the TPlugIn destructor.
And therein: free the popup before calling the inherited destructor of TPlugIn. It is not neccessary in this case, but normally it is wise to clean up in reverse order of creation.
There isn't (or at least shouldn't be) any need to re-create the popup every time Execute is called. All you should be doing is causing it to popup again with FPopup.Popup. This is in fact part of the point behind making FPopup a private class field. I.e. you set it up once and reuse it as needed.
You could use a technique called lazy-initialisation; but really it's usually an unnecessary complication. You're much better off simply mirroring your creation and destruction of FPopup. I.e. If you Destroy FPopup when TPlugIn is destroyed - you should Create FPopup when TPlugIn is created.
I use the standard Cut, Copy, Paste actions on my Main Menu. They have the shortcuts Ctrl-X, Ctrl-C and Ctrl-V.
When I open a modal form, e.g. FindFilesForm.ShowModal, then all the shortcuts work from the form.
But when I open a non-modal form, e.g. FindFilesForm.Show, then the shortcuts do not work.
I would think that those actions should work if the FindFilesForm is the active form. It's modality should have nothing to do with it, or am I wrong in my thinking?
Never-the-less, how can I get the shortcuts to work on a non-modal form?
After Cary's response, I researched it further. It is not a problem with certain controls, e.g. TMemo or TEdit.
But it is for some others. Specifically, the ones where it happens include:
the text in a TComboBox
the text in a TFindDialog
a TElTreeInplaceEdit control, part of LMD's ElPack
I'll see if there are others and add them to the list.
These are all on important Non-Modal forms in my program.
So I still need a solution.
Okay. I really need help with this. So this becomes the first question I am putting a bounty on.
My discussion with Cary that takes place through his answer and the comments there describe my problem in more detail.
And as I mentioned in one of those comments, a related problem seems to be discussed here.
What I need is a solution or a workaround, that will allow the Ctrl-X, Ctrl-C and Ctrl-V to always work in a TComboBox and TFindDialog in a Non-Modal window. If those two get solved, I'm sure my TElTreeInplaceEdit will work as well.
It takes only a couple of minutes to set up an simple test program as Cary describes. Hopefully someone will be able to solve this.
Just be wary that there seems to be something that allows it to work sometimes but not work other times. If I can isolate that in more detail, I'll report it here.
Thanks for any help you can offer me.
Mghie worked very hard to find a solution, and his OnExecute handler combined with his ActionListUpdate handler do the trick. So for his effort, I'm giving him the accepted solution and the bounty points.
But his actionlist update handler is not simple and you need to specify in it all the cases you want to handle. Let's say there's also Ctrl+A for select all or Ctrl-Y for undo you might want. A general procedure would be better.
So if you do come across this question in your search for the answer, try first the answer I supplied that adds an IsShortcut handler. It worked for me and should handle every case and does not need the OnExecute handlers, so is much simpler. Peter Below wrote that code and Uwe Molzhan gets finders fee.
Thanks Cary, mghie, Uwe and Peter for helping me solve this. Couldn't have done it without you. (Maybe I could have, but it might have taken me 6 months.)
OK, first thing first: This has nothing to do with modal or non-modal forms, it is a limitation of the way the Delphi action components work (if you want to call it that).
Let me prove this by a simple example: Create a new application with a new form, drop a TMemo and a TComboBox onto it, and run the application. Both controls will have the system-provided context menu with the edit commands, and will correctly react on them. They will do the same for the menu shortcuts, with the exception of Ctrl + A which isn't supported for the combo box.
Now add a TActionList component with the three standard actions for Cut, Copy and Paste. Things will still work, no changes in behaviour.
Now add a main menu, and add the Edit Menu from the template. Delete all commands but those for Cut, Copy and Paste. Set the corresponding action components for the menu items, and run the application. Observe how the combo box still has the context menu and the commands there still work, but that the shortcuts do no longer work.
The problem is that the standard edit actions have been designed to work with TCustomEdit controls only. Have a look at the TEditAction.HandlesTarget() method in StdActns.pas. Since edit controls in combo boxes, inplace editors in tree controls or edit controls in native dialogs are not caught by this they will not be handled. The menu commands will always be disabled when one of those controls has the focus. As for the shortcuts working only some of the time - this depends on whether the VCL does at some point map the shortcuts to action commands or not. If it doesn't, then they will finally reach the native window procedure and initiate the edit command. In this case the shortcuts will still work. I assume that for modal dialogs the action handling is suspended, so the behaviour is different between modal and non-modal dialogs.
To work around this you can provide handlers for OnExecute of these standard actions. For example for the Paste command:
procedure TMainForm.EditPaste1Execute(Sender: TObject);
var
FocusWnd: HWND;
begin
FocusWnd := GetFocus;
if IsWindow(FocusWnd) then
SendMessage(FocusWnd, WM_PASTE, 0, 0);
end;
and similar handlers for the Cut command (WM_CUT) and the Copy command (WM_COPY). Doing this in the little demo app makes things work again for the combo box. You should try in your application, but I assume this will help. It's a harder task to correctly enable and disable the main menu commands for all native edit controls. Maybe you could send the EM_GETSEL message to check whether the focused edit control has a selection.
Edit:
More info why the behaviour is different between combo boxes on modal vs. non-modal dialogs (analysis done on Delphi 2009): The interesting code is in TWinControl.IsMenuKey() - it tries to find an action component in one of the action lists of the parent form of the focused control which handles the shortcut. If that fails it sends a CM_APPKEYDOWN message, which ultimately leads to the same check being performed with the action lists of the application's main form. But here's the thing: This will be done only if the window handle of the application's main form is enabled (see TApplication.IsShortCut() code). Now calling ShowModal() on a form will disable all other forms, so unless the modal dialog contains itself an action with the same shortcut the native shortcut handling will work.
Edit:
I could reproduce the problem - the key is to somehow get the edit actions become disabled. In retrospect this is obvious, the Enabled property of the actions needs of course to be updated too.
Please try with this additional event handler:
procedure TForm1.ActionList1Update(Action: TBasicAction; var Handled: Boolean);
var
IsEditCtrl, HasSelection, IsReadOnly: boolean;
FocusCtrl: TWinControl;
FocusWnd: HWND;
WndClassName: string;
SelStart, SelEnd: integer;
MsgRes: LRESULT;
begin
if (Action = EditCut1) or (Action = EditCopy1) or (Action = EditPaste1) then
begin
IsEditCtrl := False;
HasSelection := False;
IsReadOnly := False;
FocusCtrl := Screen.ActiveControl;
if (FocusCtrl <> nil) and (FocusCtrl is TCustomEdit) then begin
IsEditCtrl := True;
HasSelection := TCustomEdit(FocusCtrl).SelLength > 0;
IsReadOnly := TCustomEdit(FocusCtrl).ReadOnly;
end else begin
FocusWnd := GetFocus;
if IsWindow(FocusWnd) then begin
SetLength(WndClassName, 64);
GetClassName(FocusWnd, PChar(WndClassName), 64);
WndClassName := PChar(WndClassName);
if AnsiCompareText(WndClassName, 'EDIT') = 0 then begin
IsEditCtrl := True;
SelStart := 0;
SelEnd := 0;
MsgRes := SendMessage(FocusWnd, EM_GETSEL, WPARAM(#SelStart),
LPARAM(#SelEnd));
HasSelection := (MsgRes <> 0) and (SelEnd > SelStart);
end;
end;
end;
EditCut1.Enabled := IsEditCtrl and HasSelection and not IsReadOnly;
EditCopy1.Enabled := IsEditCtrl and HasSelection;
// don't hit the clipboard three times
if Action = EditPaste1 then begin
EditPaste1.Enabled := IsEditCtrl and not IsReadOnly
and Clipboard.HasFormat(CF_TEXT);
end;
Handled := TRUE;
end;
end;
I didn't check for the native edit control being read-only, this could probably be done by adding this:
IsReadOnly := GetWindowLong(FocusWnd, GWL_STYLE) and ES_READONLY <> 0;
Note: I've given mghie the answer as he did a lot of work and his answer is correct, but I have implemented a simpler solution that I added as an answer myself
I posted a link to this question on my blog, and got a suggestion from Uwe Molzhan who is not on StackOverflow. Uwe used to run DelphiPool. He pointed me to this thread at borland.public.delphi.objectpascal:
Action List (mis)behavior.
Tom Alexander who asked the original question in this thread even said:
This behavior occurs usually, but not
all the time. Sometimes after a series
of the above errors, the behavior
starts acting as I would expect.
which is exactly the strange behaviour I've been having that has made this problem near to impossible to track down.
Peter Below responded in that thread that if there are colliding shortcuts, you have to take steps to make sure the active control gets first crack at the shortcut.
Taking his code (which was written for a frames problem) and I just had to modify “ctrl is TCustomFrame” to “ctrl is TControl” and it works perfect. So here is what was needed:
public
Function IsShortcut( var Message: TWMKey): Boolean; override;
Function TMyform.IsShortcut( var Message: TWMKey): Boolean;
Var
ctrl: TWinControl;
comp: TComponent;
i: Integer;
Begin
ctrl := ActiveControl;
If ctrl <> Nil Then Begin
Repeat
ctrl := ctrl.Parent
Until (ctrl = nil) or (ctrl Is TControl);
If ctrl <> nil Then Begin
For i:= 0 To ctrl.componentcount-1 Do Begin
comp:= ctrl.Components[i];
If comp Is TCustomActionList Then Begin
result := TCustomActionList(comp).IsShortcut( message );
If result Then
Exit;
End;
End;
End;
End;
// inherited; { Originally I had this, but it caused multiple executions }
End;
So far this seems to work in all cases for me.
The ironic thing is that it didn't work for Tom Alexander, the original question asker. What he did instead was add a procedure to the FrameEnter event that set the focus to the appropriate grid for the frame. That might imply yet another alternative solution to my question, but I have no need to explore that since Peter's solution works for me.
Also note that Peter includes in his answer an excellent summary of the complex steps of key handling that is worth knowing.
But I do want to now check mghie's edit on his answer and see if that is also a solution.
I created a very simple example with two forms in Delphi 2009 (Update 3 and Update 4 installed) running on Vista 64-bit. The second form, Form2 is displayed non-modally (Form2.Show;). I have a TMemo on Form2. Ctrl-X, Ctrl-V, and Ctrl-C work just fine.
This was before I placed a TMainMenu on Form2.
So, I placed a TMainMenu on the form, and added a TActionList. I create an Edit menu items, and added Copy, Cut, Paste submenu items. I hooked these up to the standard actions EditCopy, EditCut, and EditPaste. Still, everything works fine as before. I can either use the menu items, or the Ctrl-C, Ctrl-X, and Ctrl-V key combinations.
There must be something else going on here.
I have a Windows Service written in Delphi which runs a number of programs.
On Stopping the service, I want to also close these programs. When the service was originally written, this worked fine, but I think I've updated the tProcess component and now - The subordinate programs are not being closed.
in tProcess - Here's the code which starts the new processes.
if CreateProcess( nil , PChar( FProcess.Command ) , nil , nil , False ,
NORMAL_PRIORITY_CLASS , nil , Directory ,
StartupInfo , ProcessInfo ) then
begin
if FProcess.Wait then
begin
WaitForSingleObject( ProcessInfo.hProcess , Infinite );
GetExitCodeProcess( ProcessInfo.hProcess , ExitCode );
if Assigned( FProcess.FOnFinished ) then
FProcess.FOnFinished( FProcess , ExitCode );
end;
CloseHandle( ProcessInfo.hProcess );
CloseHandle( ProcessInfo.hThread );
end;
Each of the executables called by this are Windows GUI Programs (With a close button at the top).
When I stop the service, I also want to stop (not kill) the programs I've started up via the createProcess procedure.
How would you do this?
I'd use TJvCreateProcess component of JVCL which wraps about any process related functionality of win32 in a graceful way. This answer comes from Dont-touch-winapi-unless-really-required department :-)
You want to enumerate open windows that match your launched ProcessId and tell those windows to close. Here's some sample code for that:
uses Windows;
interface
function MyTerminateAppEnum(hHwnd:HWND; dwData:LPARAM):Boolean; stdcall;
implementation
function MyTerminateAppEnum(hHwnd:HWND; dwData:LPARAM):Boolean;
var
vID:DWORD;
begin
GetWindowThreadProcessID(hHwnd, #vID);
if vID = dwData then
begin
PostMessage(hHwnd, WM_CLOSE, 0, 0); //tell window to close gracefully
Result := False; //can stop enumerating
end
else
begin
Result := TRUE; //keep enumerating until you find your id
end;
end;
Then you'll want to utilize this in your code when you want to shut down the launched applications:
Procedure TerminateMe(YourSavedProcessInfo:TProcessInformation);
var
vExitCode:UINT;
begin
GetExitCodeProcess(YourSavedProcessInfo.hProcess, vExitCode);
if (vExitCode = STILL_ACTIVE) then //launched app still running..
begin
//tell it to close
EnumWindows(#MyTerminateAppEnum, YourSavedProcessInfo.dwProcessId);
if WaitForSingleObject(YourSavedProcessInfo.hProcess, TIMEOUT_VAL) <> WAIT_OBJECT_0 then
begin
if not TerminateProcess(YourSavedProcessInfo.hProcess, 0) then //didn't close, try to terminate
begin
//uh-oh Didn't close, didn't terminate..
end;
end;
end;
CloseHandle(YourSavedProcessInfo.hProcess);
CloseHandle(YourSavedProcessInfo.hThread);
end;
The only generic way to stop a process is to use TerminateProcess. But that's as far from graceful as you can get. To gracefully close a process, you need to tell the process that you'd like it to stop, and then hope it obeys. There is no way to do that in general, though.
For a GUI program, the usual way to tell it that you want it to stop running is to close its main window. There's no formal idea of "main window," though. A program can have zero or more windows, and there's no way to know externally which one you're supposed to close in order to make the program stop working.
You could use EnumWindows to cycle through all the windows and select the ones that belong to your process. (They'd be the ones for which GetWindowThreadProcessId gives the same process ID that CreateProcess gave you.)
Closing a window might not be enough. The program might display a dialog box (prompting for confirmation, or asking to save changes, etc.). You would need to know in advance how to dismiss that dialog box.
Non-GUI programs can have similar problems. It might be enough to simulate a Ctrl+C keystroke. It might catch and handle that keystroke differently, though. It might have a menu system that expects you to type "Q" to quit the program.
In short, you cannot gracefully close a program unless you know in advance how that program expects to be closed.
How do i tell if one instance of my program is running?
I thought I could do this with a data file but it would just be messy :(
I want to do this as I only want 1 instance to ever be open at one point.
As Jon first suggested, you can try creating a mutex. Call CreateMutex. If you get a non-null handle back, then call GetLastError. It will tell you whether you were the one who created the mutex or whether the mutex was already open before (Error_Already_Exists). Note that it is not necessary to acquire ownership of the mutex. The mutex is not being used for mutual exclusion. It's being used because it is a named kernel object. An event or semaphore could work, too.
The mutex technique gives you a Boolean answer: Yes, there is another instance, or no, there is not.
You frequently want to know more than just that. For instance, you might want to know the handle of the other instance's main window so you can tell it to come to the foreground in place of your other instance. That's where a memory-mapped file can come in handy; it can hold information about the first instance so later instances can refer to it.
Be careful when choosing the name of the mutex. Read the documentation carefully, and keep in mind that some characters (such as backslash) are not allowed in some OS versions, but are required for certain features in other OS versions.
Also remember the problem of other users. If your program could be run via remote desktop or fast user switching, then there could be other users already running your program, and you might not really want to restrict the current user from running your program. In that case, don't use a global name. If you do want to restrict access for all users, then make sure the mutex object's security attributes are such that everyone will be able to open a handle to it. Using a null pointer for the lpSecurityAttributes parameter is not sufficient for that; the "default security descriptor" that MSDN mentions gives full access to the current user and no access to others.
You're allowed to edit the DPR file of your program. That's usually a good place to do this kind of thing. If you wait until the OnCreate event of one of your forms, then your program already has a bit of momentum toward running normally, so it's clumsy to try to terminate the program at that point. Better to terminate before too much UI work has been done. For example:
var
mutex: THandle;
mutexName: string;
begin
mutexName := ConstructMutexName();
mutex := CreateMutex(nil, False, PChar(mutexName));
if mutex = 0 then
RaiseLastOSError; // Couldn't open handle at all.
if GetLastError = Error_Already_Exists then begin
// We are not the first instance.
SendDataToPreviousInstance(...);
exit;
end;
// We are the first instance.
// Do NOT close the mutex handle here. It must
// remain open for the duration of your program,
// or else later instances won't be able to
// detect this instance.
Application.Initialize;
Application.CreateForm(...);
Application.Run;
end.
There's a question of when to close the mutex handle. You don't have to close it. When your process finally terminates (even if it crashes), the OS will automatically close any outstanding handles, and when there are no more handles open, the mutex object will be destroyed (thus allowing another instance of your program to start and consider itself to be the first instance).
But you might want to close the handle anyway. Suppose you chose to implement the SendDataToPreviousInstance function I mentioned in the code. If you want to get fancy, then you could account for the case that the previous instance is already shutting down and is unable to accept new data. Then you won't really want to close the second instance. The first instance could close the mutex handle as soon as it knows it's shutting down, in effect becoming a "lame duck" instance. The second instance will try to create the mutex handle, succeed, and consider itself the real first instance. The previous instance will close uninterrupted. Use CloseHandle to close the mutex; call it from your main form's OnClose event handler, or wherever else you call Application.Terminate, for example.
You can create a Semaphore and stop execution (put the code into your *.dpr file) and bring you running application to the screen.
var
Semafor: THandle;
begin
{ Don't start twice ... if already running bring this instance to front }
Semafor := CreateSemaphore(nil, 0, 1, 'MY_APPLICATION_IS_RUNNING');
if ((Semafor <> 0) and { application is already running }
(GetLastError = ERROR_ALREADY_EXISTS)) then
begin
RestoreWindow('TMyApplication');
CloseHandle(Semafor);
Halt;
end;
Application.CreateForm(....);
Application.Initialize;
Application.Run;
CloseHandle(Semafor);
end;
EDIT (added the RestoreWindow method):
The aFormName is the name of your main form class in your application.
procedure RestoreWindow(aFormName: string);
var
Wnd,
App: HWND;
begin
Wnd := FindWindow(PChar(aFormName), nil);
if (Wnd <> 0) then
begin { Set Window to foreground }
App := GetWindowLong(Wnd, GWL_HWNDPARENT);
if IsIconic(App) then
ShowWindow(App, SW_RESTORE);
SetForegroundwindow(App);
end;
end;
The all-mighty JVCL has a component for this purpose. See "TJvAppInstances".
The normal solution is to create a named, system-wide mutex.
If you manage to create it, you're the one running application.
If you don't, you know there's a different one.
EDIT:
I haven't provided code as I don't know Delphi. I can provide C# code if that would be helpful though.
You create a system mutex.
I don't have Delphi code, but here's C++ code:
HANDLE Mutex;
const char MutexName[] = "MyUniqueProgramName";
Mutex = OpenMutex(MUTEX_ALL_ACCESS, false, MutexName);
if (Mutex)
throw Exception("Program is already running.");
else
Mutex = CreateMutex(NULL, true, MutexName);
I'd like to add one point to the excellent answer by Rob Kennedy (apart from the fact that it would be best to make a function out of his code instead of copying everything into the DPR file. You only need two parameters, the name of the mutex, and a boolean whether the mutext should be per-user or system-wide).
The answer does not give much consideration to the naming of the mutex. If you expect your program to be installed via Inno Setup (and maybe other setup tools too) you should choose the name carefully, as the mutex can be used to have the setup program check whether the application is currently running, and alert the user that they should close all instances of the application. If you choose to allow one instance of the program per user you may need to create a second system-wide mutex too, as the setup may need to have no running instances of the application at all in order to be able to replace files. The name that is to be used for synchronization with an InnoSetup installer must be hard-coded.
I would say that there are several different strategies that you can employ. But the easiest one (and not platform specific) is the one you yourself suggested, namely to, at the start of the program check to see if there is a lock file created in a set, specific location. If this lock file exists, then another instance is already running, if it doesn't exist, then there is not another instance running. When your program exits, you delete the lock file.
However, employing this strategy you have another problem, what happens if your program crashes? The lock file still remains, and this specific case need to be handled.
Another strategy is the system-wide mutex solution, where you register your presence within the operating system (or it's also plausible that this is done automagically). When a second instance then tries to start, it checks if there's already a process active with a specific ID. If it already exists, the second process chooses not to start, and optionally brings the first process' window in focus (if the process in question owns a window that is).
However, this strategy is platform specific, and the implementation will differ from platform to platform.
You can simply use FindWindow windows api function. In delphi class name of the window is the same as class name, you can redefine class name by overriding CreateParams function. To check if window exists add code before main window is created , before Application.Initialize;
Program test
var
handle :HWND;
begin
handle := FindWindow('TMySuperApp', nil);
if IsWindow(handle) then
begin
//app is running
exit;
end.
Application.Initialize;
Application.CreateForm(TMySuperApp, SuperApp);
Application.Run;
end;
Controlling the number of application instances:
http://delphi.about.com/od/windowsshellapi/l/aa100703a.htm
If You want to stop execution your app more then once in the same time (put the code into *.dpr file of the project).
will show a message after second app will be running and stop it instantly .
Forms,
Unit1 in 'Unit1.pas' {Form1},
// add this units ....
TlHelp32,SysUtils,Windows,Dialogs;
{$R *.res}
function ProcessCount(const ExeName: String): Integer;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize:= SizeOf(FProcessEntry32);
ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
Result:= 0;
while Integer(ContinueLoop) <> 0 do begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeName))) then Inc(Result);
ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
begin
if ProcessCount(ExtractFileName(Application.ExeName)) > 1 then begin
MessageDlg('Application is already running!', mtError, [mbOK], 0);
Application.Terminate;
end else begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
See this unit (using CreateMutex): UiApp
Additionally at this page, you can read the advantages and disadvantages for to this work with differents methods (mutex, FindWindows,...).
This unit have the solution to activate the previos instance of the application when this is detected.
Regards and excuse-me for my bad english.
Neftalí -Germán Estévez-
In the past, I've used a socket to prevent multiple instances from running at the same time. If the socket is in use, don't continue the program, if it's available let everything run as normal.