In the TI documents provided by Borland/Inprise, an example is given on how
to get an application to stop a second instance of itself being executed.

This example doesn't seem to work in Delphi 4. Is there any other way of
doing this. (It must work on NT also).

Thanks!

I don't know anything about TI documents, but why don't U try this:

work with registry:
when it starts, check if key "app_started" = true. if it is, start the app,
else exit.
then write true to key"app_started".
when finishing the app make sure that U write false to key"app_starts".

program
...
function AppAlreadyStarted: boolean
var Reg: TRegIniFile
begin
    Result:=false;
    Reg:=TRegIniFile.Create;
    try
        Reg.RootKey:=HKey_Local_Machine;
        if Reg.OpenKey("myapp",False) then begin
            Reg.ReadBool("myapp\app_started", Result);
    finally
        Reg.Free;
end;
procedure SetApp (b: boolean);
begin
    Reg:=TRegIniFile.Create;
    try
        Reg.RootKey:=HKey_Local_Machine;
        if not Reg.OpenKey("myapp",False) then
            Reg.CreateKey("muapp");
        Reg.WriteBool('app_started',b);
    finally
        Reg.Free;
end;
...
begin
    if AppAlreadyExist then Exit
        else SetApp (true);
    ...
    ...
    SetApp (false);
end;

only bad thing that could happen here is power failure, which would dissable
any future using of program until key "app_started" is reset.
solution for this would be usage of a global variable (windows based).
something like "SET var_name = var_value" in DOS;
that variable would be stored in memory (not on disk as it would be if using
registry), and it would be power depended.
if anybody knows something of this sort, please tell me.

p.s. this code isn't tested.

Igor Popov wrote in
<7439ACA52032D311A96200400537EC0FAF6...@ns1.tehnicom.net> ...

This is not only - this is very bad thing. Any abnormal termination and no
more nice apps. Even if anyone would choose this mechanism, I do not think
using registry for doing this is a good idea - there are lots of more
convenient ways = for example global atoms etc.

So, DON'T work with registry. I've posted mutex example - it works and it's
really nice.

Bye.
/lexi

On Wed, 2 Feb 2000 22:49:00 +0200, "Don Schoeman" <dpds...@mweb.co.za>
wrote:

Hello Don,
From my carefully hoarded help file:
To stop your program from being run more than once: Declare a global
variable to your unit:
var atom : word;
on you mainforms OnCreate Event put this.....
procedure TForm1.OnCreate(sender : Tobject);
begin
   if GlobalFindAtom('PROGRAM_RUNNING) = 0 then begin  {Search the
global
   atom table for the program thats running}
   atom := GlobalAddAtom('PROGRAM_RUNNING');    {add it to the table
if its not found}
end
else
  begin
      MessageDlg('Program is already Running!',mtWarning,[mbOK],0);
{if its found, show a
      message}
      Halt;    {and halt the running of another instance of the
program}
   end;
end;
 And on the programs on destroy event
 procedure TForm1.OnDestroy(Sender : TObject);
 begin
    GlobalDeleteAtom(atom);  {remove it from the global atom table}
 end;

(Ek gebruik dit in Win95, maar ek weet nie of die global atom list in
NT ens bestaan nie)

function IsPrevInst: Boolean;
var
  semName,
  appClass: PChar;
  hSem    : THandle;
  hWndMe  : HWnd;
  appTitle: Array[0..MAX_PATH] of Char;
begin
  // Initializations
  Result := FALSE;
  GetMem(semName,15);
  GetMem(appClass,15);
  StrPCopy(semName,'SemaphoreName');
  StrPCopy(appClass,'TApplication');
  StrPCopy(appTitle,ExtractFileName(Application.Title));
  // Lets create a semaphore. If this is the first instance, hSem will
contain 0.
  hSem := CreateSemaphore(nil,0,1,semName);
  // Does the semaphore already exist ? Yes : second instance.
  if (hSem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      CloseHandle(hSem);
      // Lets change our main window title in order to find the first
instance's one.
      hWndMe := FindWindow(appClass,appTitle);
      SetWindowText(hWndMe,'ZZZZZZZ');

      // Then we find the preceeding instance's main window,
reactivate it and
      // bring it on front. It isfound by looking for the
application's class and title.
      hWndMe := FindWindow(appClass,appTitle);
      if (hWndMe <> 0) then
        begin
          BringWindowToTop(hWndMe);
          ShowWindow(hWndMe,SW_SHOWNORMAL);
        end;
      Result := TRUE;
    end;
  // Deallocate used Data
  FreeMem(semName,15);
  FreeMem(appClass,15);
end;

The easiest way is to use a mutex.  Put the following code at the end
of one of your units.
var
  MyMutex : integer;
initialization
  MyMutex := OpenMutex (MUTEX_ALL_ACCESS, false, 'MYAPPNAME');
  if MyMutex = 0 then
  begin
    { This is the first instance - create a mutex }
    MyMutex := CreateMutex (0, true, 'MYAPPNAME');
  end
  else Application.Terminate;
finalization
  if MyMutex <> 0 then
    ReleaseMutex (MyMutex);
end.

Kies enigeen.
Groete
Johan Smit

news:7439ACA52032D311A96200400537EC0FAF6555@ns1.tehnicom.net...

TI (technical information) documents can be found at the Borland web site.
There are TIs that answer a large variety of questions. I highly recommend
scanning through the list periodically.

Will the mutex code prevent two users on separate computers from
starting the same program from a network drive?

In article <0dgo9sor81k47ng4f4398idjm9t84dq...@4ax.com>, Mark Shapiro

No. The program will execute on the users computer, not the server.
HTH
Bob