So i started to implement such component based in simpleipc. First i searched how the Delphi programmers resolved this problem. I found two open source components TRunOnce and TInstanceControl. Both uses a file mapping technic which is win32 centric, so without use for me and i already had another idea. But i learned with them that the best place to do the implemantation is inside the Loaded procedure which is called just after the components are streamed and before the form is show.
The algorithm is pretty simple: a client (TSimpleIPCClient) checks is there's a corresponding server (TSimpleIPCServer) running, if so (a instance is already running) notify the server (the running instance) and terminate the app, otherwise it means that is the first instance so init a server and let the program go.
The next step was a little more difficult: how to pass the command line arguments to the second instance. I had 3 options:
- Pass the cmdline as is and let the receiver (server) parse it. Not good since the parsing of the command line is not so simple and probably platform dependent
- Pass each argument (ParamStr(x)) separately. It was considered but, in the server side, i needed a way to tell that the argument passing was starting (to set the length of the array), than pass the parameters itself and finally notify that the arguments finished (to fire the event). I could do that passing special chars as markers or with numerical values in the beginning of the stream. Definitely an overkill.
- Create an easily parsable string with the parameters in the client side and then send once. The chosen one.
The results can be found here
Delphi is far away from Lazarus/fpc, no doubt, but this is an example that some problems can be resolved cleaner and easier with the open source solution.
PS: more difficult than write the component is creating a icon for it. And the result... LOL
10 comments:
Hi there,
I'm really interested in using your UniqueInstance component. I have two questions about it (maybe for in the FAQ as well).
1) Does UniqueInstance run on OS X, e.g. have people successfully used it there?
2) Does the SimpleIPCServer method require a network card for it to work?
I'm looking forward to hearing from you.
Kind regards,
Jarno
>1) Does UniqueInstance run on OS X, e.g. have people successfully used it there?
I don't know since i don't have a osx machine to test. None reported success nor failure. If simpleipc is implemented under OSX it should work.
> 2) Does the SimpleIPCServer method require a network card for it to work?
No. SimpleIPCServer uses named pipes to comunicate between applications under unixes. I not sure how and if works under OSX but surely does not rely on specific hardware.
To test the uniqueinstance just compile the testraw program available in the latest package release (v0.2)
Will UniqueInstance work with the latest build of Lazarus. I have tried installing the package and the component is still not install
I Just tested with latest Lazarus (Lazarus 0.9.27 r21322 FPC 2.2.4 i386-win32-win32/win64). Try using the svn version: https://luipack.googlecode.com/svn/trunk/uniqueinstance
Hello -
This is potentially very useful. However, both the stable 0.2 version and the SVN code can fail on my Redhat Server 5.5 x86-64 bit version.
1.) The crash application button does not crash the program with Lazarus 0.9.28.3 - the 1/0 returns the value +Inf rather than crashing. To make it crash you can do i := 1 div 0; where i is an integer.
2.) While the code works with the graceful crash described above, it does not work if I open up System/Administration/SystemMonitor and select EndProcess. In this case, the pipe /tmp/tuniqueinstance_test0.1 is not destroyed and one can no longer start the testinstance executable (until you rm /tmp/tunique*
@Chris:
I'm aware of this problem and in long term the best way to fix it is to use DBUS instead of SimpleIPC. Recently i tried to see a solution using shm but did not finished the research. I' would be glad if you could help me to find a solution.
Here is my attempt. The good news is that the program does not freeze. This code will not update if a program crashes until a reboot of the machine. This is not ideal, but is an improvement WRT your code that never automatically updates after a crash. One bad apsect of my code is that I think it is Unix only.
---------------------
unit sharemem;
{$mode objfpc}{$H+}
interface
//http://community.freepascal.org:10000/docs-html/rtl/ipc/shmctl
// call CreateSharedMem when an application is created and CloseSharedMem when a program is closed
// along with NInstances, these functions return the number of concurrent instances.
// if a program crashes, the values may not be reset until the next reboot
uses
BaseUnix,Classes, SysUtils, ipc, dialogs;
function CreateSharedMem: integer; //returns number of instances after including this one...
function NInstances: integer; //returns number of instances
function CloseSharedMem: integer; //returns number of instances after after this one closes
implementation
type
TIntBuffer = Array[0..6] of longint;
PINtBuffer = ^TIntBuffer;
const
SegSize = sizeof (TIntBuffer);
var
fshmid: longint;
gShareIntBuf: PIntBuffer;
segptr : Pointer;
function CreateSharedMem: integer;
var
key : Tkey;
new: boolean;
const ftokpath = '.'#0;
begin
key := ftok (pchar(@ftokpath[1]),ord('S'));
fshmid := shmget(key,segsize,IPC_CREAT or IPC_EXCL or 438);
If fshmid=-1 then begin
//showmessage('Loading existing memory.');
new := false;
fshmid := shmget(key,segsize,0);
If fshmid = -1 then begin
showmessage ('Shared memory : Error !'+inttostr(fpgeterrno));
halt(1);
end
end
else begin
new := true;
//showmessage ('Creating new shared memory segment.');
end;
segptr:=shmat(fshmid,nil,0);
gShareIntBuf := segptr;
if new then
gShareIntBuf^[0] := 1
else
gShareIntBuf^[0] :=gShareIntBuf^[0] + 1;
result := gShareIntBuf^[0];
end;
function NInstances: integer;
begin
result := gShareIntBuf^[0];
end;
function CloseSharedMem: integer;
//returns number of instances after this application quits
begin
gShareIntBuf^[0] := gShareIntBuf^[0] -1;
result := gShareIntBuf^[0];
if Assigned (segptr) then
shmdt (segptr);
if result < 1 then begin //last running instance - close shared memory
if shmctl (FShmId, IPC_RMID, nil) = -1 then
Showmessage('unable to release shared memory');
end;
end;
end.
Hi all,
I was using this code and I found the problem descripted (e.g when you press crtl+c --> because I am trying to apply it over a console soft), after that you have 2 options
1)Reboot your PC.
2) recompile it with another name
InstanceRunning('routingtaskprocessor')
Please, do you have any news about this little bug ?
I Hope you can see this message, because i couldnt find another good option.
I've downloaded your source from SVN. But I think there is not new updates available.
Best Regards,
Nicolas
Just wanted to say, thank you for this component.
Good that CodeTyphon has it preinstalled.
ideally this logic should happen BEFORE the main form is created and resources are loaded/streamed into memory, so perhaps a simple function call as the first line of the project source would be more appropriate?
Post a Comment