Fórum componente ribbon dando dor de cabeca #416236

(* Just include this unit in your project *)
(* ONE Instance APP
Author : Clément Doss
Date : 6 - DEZ - 2000
VErsion : 0.0 - First relaease
*)
(* If you have any suggestions or bug reports please do
email it to suporte@dhs.com.br *)

(* How it works *)
(* I am just trying to keep it simply stupid. I just wanted to add a unit
to my project that will ensure that one and only one instance will be
running.

I never liked to change the Project Source to add stuff there... ThatŽs why
I wrote this unit.
Just Add this unit to your project and only one application (with the same
title) will be allowed to run.
*)

(* A few more details....
I am using the Application.Title property as an application identifier.
If you are using two application with the same Application.Title, then the
second one will not open....

I used the Title because it seems to be adequate to the following rules:
1) No code will be added. Just add the unit!
2) Two applications with the same title seems unlikely to happen.
3) ... Just not figured this one yet...


I am using MUTEXes to check the existance of a second instance of the same
application.

Both CreateMutex and WaitForSingleObjects are available for Win9x and Windows NT.

I have tested it with Windows 2000 pro, and delphi 5 E. But it should work with
earlier versions of delphi.

Enjoy...
*)

unit uDHSOneInstanceApp;

interface

implementation

uses Windows, // THandle defined here
SysUtils, // strPCopy defined here
Forms; // Application defined here

type
TdhsOneInstanceApp = Class(TObject)
private
FMutex : THandle;
FAppTitle : Array[0..$100] of char;

procedure CheckForAnotherInstance;
public
{ Public declarations }
constructor Create;
end;
(* ////////// \\\\\\\\\\ *)
var
OneInstanceApp : TdhsOneInstanceApp;
{ TdhsOnceInstance }
constructor TdhsOneInstanceApp.Create;
begin
strPCopy(FappTitle,Application.Title);
CheckForAnotherInstance;
end;

procedure TdhsOneInstanceApp.CheckForAnotherInstance;
var
hRunningApp : THandle;
begin
// .. This mutex will be freed when the applcation closes!
FMutex := CreateMutex (nil, FALSE, FAppTitle );

if WaitForSingleObject (FMutex, 0) = wait_TimeOut then begin
// Found another instance
SetWindowText(Application.Handle,); // We must not found this one again ;)

// Retrieving handle of the first instance;
hRunningApp := FindWindow(nil,FAppTitle);
if hRunningApp<>0 then begin
if IsIconic(hRunningApp) then
// First instance is minimized.. Restore it
ShowWindow(hRunningApp,SW_RESTORE);

BringWindowToTop(hRunningApp);
SetForegroundWindow(hRunningApp);

end;

// Finish this second instance ...
Application.ShowMainForm := False; // Well... donŽt show the main windows
Application.Terminate;
Halt(2);
end;

end;


initialization
OneInstanceApp := TdhsOneInstanceApp.Create;

finalization
OneInstanceApp.Free;

end.