 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2004, <kouriakine@mail.ru>
 Check, if only one instance of program running.
 ****************************************************************************
 }

unit _OneInst;

{$I _sysdef}

interface

uses sysutils, windows, messages, Forms, _alloc, _str, _fio, _sharm;

 {
 OneInstance uses to prevent multiple program instance running.
 Usage like this one:
   program Example;
   uses _OneInst;
   begin
    if not OneInstance.FirstInstance then exit;
    Application.Initialize;
    Application.Run;
   end;
 Note, that:
 1) The same program looks like another application, if it located
    in another directory. So you can run multiple program instance,
    each instance in own directory. But you could not run more then
    one instance in the same directory. Why? Usually programs use home
    directory, where program located, for temporary data files.
    Multiple instances may cause problems because try to use same resources.
    But if programs located in different directories, no problem.
 2) UniqueAppMessage is unique Windows message corresponded to running executable file.
    It denends on FULL executable file path.
 3) UniqueAppCaption may be used as short unique name for program.
    It denends on FULL executable file path.
 4) If ShowOnNewInstance, first instance will be shown when new instance started.
 5) If UsesBroadcasting, send broadcast (MsgId,0,0) to all applications.
    Only our application will handle this message, because it unique.
    If not UsesBroadcasting, change application title and use FindWindow + PostMessage.
    I don't know which way is better.
 6) If Msg<>'', show message box.
 7) If Notify field assigned, this callback event will occured on new instance
    activation.
 8) Sharm.Data contains command line of last activated instance.   
 }
type
 TOneInstance=class;
 TOneInstanceNotifyEvent=procedure(aOneInst:TOneInstance; const aCmdLine:LongString);
 TOneInstance=class(TMasterObject)
 private
  myMsgId  : Cardinal;
  myTitle  : LongString;
  mySharm  : TSharedMemory;
  myHook   : Boolean;
  myNotify : TOneInstanceNotifyEvent;
  function  AppWindowHook(var M:TMessage):Boolean;
  function  GetUniqueAppMessage:Cardinal;
  function  GetUniqueAppCaption:LongString;
  procedure SetNotify(aNotify:TOneInstanceNotifyEvent);
  function  GetSharm:TSharedMemory;
 public
  constructor Create;
  destructor  Destroy; override;
  function    FirstInstance(ShowOnNewInstance : Boolean    = True;
                            UsesBroadcasting  : Boolean    = True;
                            const Msg         : LongString = ''
                                            ) : Boolean;
  procedure   RestoreApplication(Hidden:Boolean=false);
 public
  property    UniqueAppMessage : Cardinal                read  GetUniqueAppMessage;
  property    UniqueAppCaption : LongString              read  GetUniqueAppCaption;
  property    Notify           : TOneInstanceNotifyEvent write SetNotify;
  property    Sharm            : TSharedMemory           read  GetSharm;
 end;

function OneInstance:TOneInstance;

implementation

uses _SysTray;

constructor TOneInstance.Create;
begin
 inherited Create;
 myTitle:=ProgName;
 myMsgId:=RegisterWindowMessage(PChar(myTitle));
 myTitle:=Format('%s - $%4.4x',[ExtractFileName(ProgName),myMsgId]);
 mySharm:=nil;
 myHook:=false;
 myNotify:=nil;
end;

destructor  TOneInstance.Destroy;
begin
 myMsgId:=0;
 myTitle:='';
 Kill(mySharm);
 if myHook then begin
  Application.UnhookMainWindow(AppWindowHook);
  myHook:=false;
 end;
 inherited Destroy;
end;

function TOneInstance.AppWindowHook(var M: TMessage): Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  if (M.Msg=myMsgId) and (M.WParam=0) and (M.LParam=0) then begin
   if Assigned(myNotify) and (Sharm.Data<>nil)
   then myNotify(Self,Format('%s',[PChar(Sharm.Data)]))
   else RestoreApplication(SysTray.TrayIcon);
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TOneInstance.RestoreApplication(Hidden:Boolean);
begin
 try
  Application.Restore;
  Application.BringToFront;
  if Hidden then ShowWindow(Application.Handle,SW_HIDE);
  if Assigned(Application.MainForm) then Application.MainForm.Show;
  if Assigned(Screen.ActiveForm) then
  if Screen.ActiveForm.FormStyle<>fsMdiForm then
  if Screen.ActiveForm.FormStyle<>fsMdiChild then begin
   Screen.ActiveForm.Show;
   Screen.ActiveForm.BringToFront;
   Screen.ActiveForm.WindowState:=wsNormal;
  end;
  if IsWindow(Application.Handle) then SetForegroundWindow(Application.Handle);
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TOneInstance.GetUniqueAppMessage:Cardinal;
begin
 if Assigned(Self) then Result:=myMsgId else Result:=0;
end;

function TOneInstance.GetUniqueAppCaption:LongString;
begin
 if Assigned(Self) then Result:=myTitle else Result:='';
end;

procedure TOneInstance.SetNotify(aNotify:TOneInstanceNotifyEvent);
begin
 if Assigned(Self) then myNotify:=aNotify;
end;

function TOneInstance.GetSharm:TSharedMemory;
begin
 if Assigned(Self) then Result:=mySharm else Result:=nil;
end;

function TOneInstance.FirstInstance(ShowOnNewInstance : Boolean    = True;
                                    UsesBroadcasting  : Boolean    = True;
                                    const Msg         : LongString = ''
                                                    ) : Boolean;
var
 hWin : hWnd;
 BSMR : DWORD;
begin
 Result:=true;
 if Assigned(Self) then
 try
  if not Assigned(mySharm) then begin
   mySharm:=NewSharedMemory(Format('%s - Shared Memory For Command Line',[myTitle]),1024*4);
   if mySharm.Ok then mySharm.Master:=mySharm;
   if mySharm.FileMappingResult = ERROR_ALREADY_EXISTS then begin
    StrLCopy(mySharm.Data,System.CmdLine,mySharm.Size-1);
    if ShowOnNewInstance then begin
     if UsesBroadcasting then begin
      BSMR:=BSM_APPLICATIONS;
      BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMR, myMsgId, 0, 0);
     end else begin
      Application.Title:=myTitle+' - 2';
      hWin:=FindWindow(nil,PChar(myTitle));
      if hWin<>0 then PostMessage(hWin,myMsgId,0,0);
     end;
    end;
    if not IsEmptyStr(Msg) then Application.MessageBox(PChar(Msg),'Warning',IDOK);
    Result:=false;
   end else begin
    if ShowOnNewInstance then begin
     if not UsesBroadcasting then Application.Title:=myTitle;
     Application.HookMainWindow(AppWindowHook);
     myHook:=true;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

const
 TheOneInstance : TOneInstance = nil;

function OneInstance:TOneInstance;
begin
 if not Assigned(TheOneInstance) then
 try
  TheOneInstance:=TOneInstance.Create;
  TheOneInstance.Master:=TheOneInstance;
 except
  on E:Exception do BugReport(E);
 end;
 Result:=TheOneInstance;
end;

initialization

finalization

 Kill(TObject(TheOneInstance));

end.
