Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 280
  • Last Modified:

How do I stop multiple copies of a delphi appication starting

I've lost some of my old code notes, one of them to stop multiple instances of a delphi application starting

Has anyone got a snip of code I can include for this in my software please.
0
mikelittlewood
Asked:
mikelittlewood
1 Solution
 
Amir AzhdariCommented:
procedure TForm1.FormCreate(Sender: TObject);
var   hMapp : THandle;
begin

     hMapp := CreateFileMapping( THandle( $ffffffff ),
                                   NIL,
                                   PAGE_READONLY,
                                   0,
                                   32,
                                   'MyTest1Map' );
     if Boolean( hMapp ) then
       if GetLastError = ERROR_ALREADY_EXISTS then
          halt;

end;
0
 
mikelittlewoodAuthor Commented:
I tried to use the

  hMutex := CreateMutex(nil, false, 'FSTDERunning');
  if ((GetLastError = ERROR_ALREADY_EXISTS)) then
  begin
    SendMessage(HWND_BROADCAST,RegisterWindowMessage('FSTDERunning'),0,0);
    Messagedlg('FSTDE is already running.',mtError,[mbOK],0);
    Halt(0);
  end;

section of code from another thread but Im not sure what goes in the "USES" section of the dpr
0
 
kretzschmarCommented:
you may also try some free ready to use components at
www.torry.net

more specific

http://www.torry.net/pages.php?id=516

>thread but Im not sure what goes in the "USES" section of the dpr
 it should be the windows-unit

meikl ;-)
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
mikelittlewood....you can use the Hmutex by this way:

uses
windows, system, dialogs;
var
hmutex: Thandle;

HMutex := CreateMutex (nil, False, PChar('FSTDERunning'));
      if WaitForSingleObject (hMutex, 0) = wait_TimeOut then
      begin
                    MessageDlg('FSTDE is already running,mtError,[mbOK],0);
                  Halt(0);
               end;
0
 
shaneholmesCommented:
About.com has a great article on (step By step) creating your own TInstanceControl  
 
Full source code of a Delphi component that can control the behavior of your application's multiple instances: with the option to limit the number of running instances.

"Controlling the number of application instances"
 
http://delphi.about.com/library/weekly/aa110203a.htm

Hope this helps!

Shane
0
 
mikelittlewoodAuthor Commented:
great ... got that bit of code I found working fine now thx
0
 
tadooxCommented:
The MultInst.pas Unit, Which Permits Only One Application Instance


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 proc
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.
0
 
calinutzCommented:
You can also use abfComponents pack (free) they have a nice component called abfOneInstance.
Cheers
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now