Results 1 to 11 of 11

Thread: TUniqueInstance en eenmalig "onCreate"

  1. #1

    TUniqueInstance en eenmalig "onCreate"

    Ik heb een appje die door dit component maar eenmalig opstart.

    Met de volgende code laat ie ook het form weer zien wanneer deze naar de tray was gedaan.

    Het probleem is alleen dat "onCreate" ook afvuurt bij de "tweede instance"
    Onder dit event plaats ik normaal gesproken code die maar eenmalig gedaan moet worden. Ik zoek hier dus een oplossing voor.

    Een boolean bFirstInstanceIsRunning gaat dus ook niet werken want deze is ook weer nieuw bij de "tweede instance"

    Code:
    unit Unit1;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
      UniqueInstance;
    
    type
    
      { TForm1 }
    
      TForm1 = class(TForm)
        UniqueInstance1: TUniqueInstance;
        procedure FormCreate(Sender: TObject);
        procedure UniqueInstance1OtherInstance(Sender: TObject;
          ParamCount: Integer; Parameters: array of String);
      private
        { private declarations }
      public
        { public declarations }
      end;
    
    var
      Form1: TForm1;
      bFirstInstanceIsRunning: boolean = false;
    
    implementation
    
    {$R *.lfm}
    
    { TForm1 }
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      if bFirstInstanceIsRunning = true then exit;
    
      showmessage('create');
    
    
      bFirstInstanceIsRunning := true;
    end;
    
    
    
    
    procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
      ParamCount: Integer; Parameters: array of String);
    begin
      showmessage('other instance');
      Form1.WindowState := wsNormal;
      Form1.Show;
    end;

  2. #2
    Als je in je mainform kijkt of je al een instance hebt kan het inderdaad zijn dat je te laat bent. Er zijn betere oplossingen en er zijn gelukkig ook voorbeelden. CreateMutex is de juiste zoekterm.
    Marcel

  3. #3
    Marcel, dat component werkt verder prima. Als er een oplossing is om de "onCreate" code eenmalig te runnen dan heeft dat mijn voorkeur.

    Het lijkt mij dat veel meer mensen hier tegenaan gelopen moeten zijn die dit component gebruiken?!

  4. #4
    Een form moet eerst worden aangemaakt voordat de componenten daarop het werk kunnen doen. Het OnCreate event zal dus over het algemeen worden uitgevoerd voordat je component zijn werk gaat doen.

    Maar misschien heeft het component een IAmTheFirstInstance event o.i.d. en kun je daar de logica neerzetten die je nu in je OnCreate hebt staan. Je kunt ook je OnActivate event gebruiken, maar dan moet je wel in de gaten houden dat een event meerdere keren geactiveerd kan worden.
    Marcel

  5. #5
    Jan
    Join Date
    Oct 2007
    Location
    Mijdrecht
    Posts
    906
    Voorbeeld van een component (beetje outdated) die ik al jaren gebruik :

    Code:
    {***********************************************************************}
    {FileName  : OneInstance.pas                                            }
    {Version*  : 2.3                                                        }
    {Author(s) : Andrew Johnson <AJ_Genius@Hotmail.com>                     }
    {                                                                       }
    {License* LGPL                                                          }
    {Copyright* 2000, 2001, 2002 Andrew Johnson                             }
    {***********************************************************************}
    {Comments  : This File supplies TOneInstance, a component designed to   }
    {   determine if a former instance of a program is still running. By    }
    {   default if one is found then the current instance is terminated,    }
    {   though this behaviour can be changed by toggling the Terminate flag.}
    {   Other proprties which can be set are InformUser, which informs the  }
    {   User that a former instance is still open; RaisePriorInstance which }
    {   tries to bring the former instance to the front of the screen and   }
    {   give it the focus; and ApplicationExists, a Notify-Event to run a   }
    {   specified routine in the event that a prior instance is found.      }
    {   Under Linux there is also an unpublished(for DFM compatibility)     }
    {   property LockFileName, which sets the Lock file(but not dir) name.  }
    {***********************************************************************}
    {Specifics:                                                             }
    {   Windows: a unique Mutex is created by the component, if it cannot   }
    {   be created then a former instance is still open. To raise the former}
    {   instance it attempts to find the Application handle using Windows   }
    {   FindWindow, and post SW_RESTORE and call BringToFront for the last  }
    {   active popup(GetLastActivePopup).                                   }
    {                                                                       }
    {   Linux: a Lock File is created which contains the unique PID of the  }
    {   current instance, if the LockFile still exists and the PID can be   }
    {   posted-to (via Libc.sigqueue), then a former instance is still open.}
    {   To raise the former instance it attempts to post SIGUSR1 to the PID }
    {   of the former instance, which should be handled by SIGUSR1_Handle.  }
    {***********************************************************************}
    {Problems  :                                                            }
    {                                                                       }
    {  1.) Not enough error handling                                        }
    {  2.) Code's still a bit of a mess                                     }
    {  3.) Minor Inconsitencies between Windows and Linux Code              }
    {                                                                       }
    {  Windows Specific:                                                    }
    {  4.) Raising the former instance of an application requires           }
    {      that the Application Title be the same for both, and unique.     }
    {                                                                       }
    {  Linux Specific:                                                      }
    {  5.) The lock file may not be read/write accesible if the             }
    {      program was opened by a different user, aka using SU/SUDO.       }
    {  6.) Raising the former instance does not always work if the program  }
    {      has been manually minimized, aka Application.minimize.           }
    {  7.) Sometimes when raising the former instance the form is focused   }
    {      but not brought to front, or the opposite(unfocused, infront).   }
    {***********************************************************************}
    {*See end of file for history and Copyright/License information         }
    {***********************************************************************}
    unit OneInstance;
    
    interface
    
    {$IfDef Linux}
    uses
      Libc, Sysutils, Classes, QForms, QDialogs;
    {$Else}
      {$IfNDef Windows}
        {$Define Windows}
      {$EndIf}
    uses
      Windows, Sysutils, Classes, Forms, Dialogs;
    {$EndIf}
    
    type
      EOneInstance = Class(Exception);
    
      TOneInstance = class(TComponent)
      private
        FTerminate: Boolean;
        FApplicationExists: TNotifyEvent;
        LockCreated: Boolean;
        {$IfDef Linux}
          FLockFileName : String;
          Directory : String;
          LockFile : String;
        {$EndIf}
        FInformUser,
        FRestorePriorInstance : Boolean;
      protected
        {$IfDef Linux}
          AppHandle: pid_t;
        {$Else}
          AppHandle: hWnd;
          AppTitle  : String;
        {$EndIf}
    
        {Error Handling}
        Procedure RaiseException(theMessage : String);
        Procedure HandleException(Info : String; theException : Exception);
    
        {Creating/Deleting Unique LockFile/Mutex}
        Procedure InitializeLock;
        Procedure FinalizeLock;
    
        {Handling Existance of Prior Instance}
        Procedure DoRaisePriorInstance;
        Function HasPriorInstance : Boolean;
      public
        procedure Loaded; override;
        constructor Create(aOwner: TComponent); override;
        destructor Destroy; override;
        {$IfDef Linux}
          {Name of Unique LockFile to use}
          property LockFileName : String read FLockFileName write FLockFileName;
        {$EndIf}
      published
        {Terminate Current Instance on Discovery of Prior Instance}
        property Terminate: Boolean read FTerminate write FTerminate default True;
    
        {Inform User on Discovery of Prior Instance}
        property InformUser : Boolean read FInformUser write FInformUser;
    
        {Raise Prior Instance to Front if Found}
        property RaisePriorInstance : Boolean read FRestorePriorInstance
          write FRestorePriorInstance;
    
        {Custom Procedure to Run on Discovery of Prior Instance}
        property ApplicationExists: TNotifyEvent read FApplicationExists
          write FApplicationExists;
      end;
    
    procedure Register;
    
    implementation
    
    {$R *.dcr}
    
    {$IfDef Linux}
    procedure SIGUSR1_Handle(SigNum: Integer); cdecl;
    begin
      Application.Restore;
      Application.BringToFront;
    end;
    {$EndIf}
    
    Procedure TOneInstance.RaiseException(theMessage : String);
    begin
      Try
        Raise EOneInstance.Create(theMessage);
      Except on E : Exception do
        Application.HandleException(self);
      end;
    end;
    
    Procedure TOneInstance.HandleException(Info : String;
      theException : Exception);
    begin
      RaiseException(Info + ' An Exception was raised ' +
        'with the message : ' + theException.Message);
    end;
    
    Procedure TOneInstance.InitializeLock;
    {$IfDef Linux}
    var
      F : TextFile;
    {$EndIf}
    begin
      {$IfDef Linux}
        If FileExists(LockFile) then
          DeleteFile(LockFile);
        If not DirectoryExists(Directory) then
          ForceDirectories(Directory);
        FileClose(FileCreate(LockFile,DEFFILEMODE));
        System.Assign(F,LockFile);
        Rewrite(F);
        Writeln(F,intToStr(getpid));
        Close(F);
        signal(SIGUSR1, SIGUSR1_Handle);
      {$Else}
        Try
          AppHandle := CreateMutex(nil, False, PChar(ExtractFileName(
           Application.ExeName)));
        except on E : Exception do
          HandleException('Unable to create Mutex!', E);
        end;
      {$EndIf}
    end;
    
    Procedure TOneInstance.FinalizeLock;
    begin
      {$IfDef Linux}
        Try
          If FileExists(LockFile) then
            DeleteFile(LockFile);
        except on E : Exception do
          HandleException('Unable to delete lock file!', E);
        end;
      {$Else}
        Try
          CloseHandle(AppHandle)
        except on E : Exception do
          HandleException('Unable to close Mutex!',E);
        end;
      {$EndIf}
    end;
    
    Function TOneInstance.HasPriorInstance : Boolean;
    {$IfDef Linux}
    var
      F : TextFile;
      val : String;
      sig : sigval;
    {$EndIf}
    begin
      Result := True;//to be on the safe side, always assume the worst
      {$IfDef Linux}
        AppHandle := -1;
        If FileExists(LockFile) then begin
          Try
            System.Assign(F,LockFile);
            FileMode := 0;
            Reset(F);
            System.Readln(F,Val);
            Close(F);
          except on E : Exception do
            begin
              HandleException('Unable to read existing lock file!',E);
              exit;
            end;
          end;
          Try
            If (sigqueue(StrToInt(Val),0,sig) = 0) or (Errno <> ESRCH) then
              AppHandle := StrToInt(Val);
          except on E : Exception do
            begin
              AppHandle := -1;
              HandleException('Error verifying PID in lock file is ' +
                'Valid!', E);
              exit;  
            end;
          end;
        end;
        If AppHandle > -1 then begin
        //--> something needs to be added here eventualy to check and ensure that
        //--> the AppHandle really is the same program. While the probablity of
        //--> it not being the same is very, very, very slim, still.....
        end;
        Result := AppHandle <> -1;
      {$Else}
        Try
          AppHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(ExtractFileName(
            Application.ExeName)));
        except on E : Exception do
          begin
            HandleException('Unable to verify that Mutex already exists!',E);
            exit;
          end;
        end;
        Result := AppHandle > 0;
        If result then
          CloseHandle(AppHandle);
        AppHandle := 0;
      {$EndIf}
    end;
    
    Procedure TOneInstance.DoRaisePriorInstance;
    var
    {$IfDef Linux}
      sig : sigval;
    {$Else}
      Handle,
      Popup : THandle;
    {$EndIf}
    begin
      If RaisePriorInstance then begin
       {$IfDef Linux}
          sigqueue(AppHandle,SIGUSR1,sig);
       {$Else}
          If AppTitle = '' then
            exit;
          Application.Title := '';
          Handle := FindWindow(nil,PChar(AppTitle));
          If Handle <> 0 Then Begin
            Popup := GetLastActivePopup(Handle);
            If IsIconic(Handle) Then
              ShowWindow(Handle,SW_RESTORE);
            BringWindowToTop(Handle);
            If Popup <> 0 then begin
              If IsIconic(Popup) Then
                ShowWindow(Popup,SW_RESTORE);
              BringWindowToTop(Popup);
              SetForegroundWindow(Popup);
            end;
          end;
       {$EndIf}
      end;
    end;
    
    procedure TOneInstance.Loaded;
    begin
      inherited Loaded;
      If csDesigning in ComponentState then
        exit;
      {$IfDef Windows}
        AppTitle := Application.Title;
      {$EndIf}
      If not HasPriorInstance then begin
        InitializeLock;
        LockCreated := True;
      end else begin
        LockCreated := False;
        If Assigned(FApplicationExists) then
          FApplicationExists(Self);
        If Terminate then begin
          If InformUser then
            RaiseException('Another instance of this application ' +
                'appears to be running. You must ' + #13#10 + 'close any previous '
                + 'instances before continuing. '
              {$IfDef Linux}
                + 'If no other instance is running  '
                + #13#10 + 'try deleting the lock file. ' + #13#10#13#10 +
                'LockFile : ' + LockFile + ''
              {$EndIf});
          Application.Terminate;
        end
        else
          If InformUser then
            MessageDlg('Another instance of this application ' +
              'appears to be running!',mtWarning,[mbok],0);
      end;
    end;
    
    constructor TOneInstance.Create(aOwner: TComponent);
    var
      I : integer;
    begin
      {$IfDef Linux}
        Directory := '/tmp';
        if euidaccess(PChar(Directory), R_OK or W_OK) = 0 then
          Directory := Directory + '/kylixapps/'
        else begin
          Directory := '~';
          if euidaccess(PChar(Directory), R_OK or W_OK) = 0 then
            Directory := Directory + '/kylixapps/'
        else
          begin
            RaiseException('Unable to read/write users home!');
            Exit;
          end;
        end;
        If LockFileName = '' then
          LockFile := Directory +
            ExtractFileName(Application.ExeName) + '.lock'
        else
          LockFile := Directory + LockFileName;
      {$EndIf}
      for I := 0 to AOwner.ComponentCount - 1 do
        if AOwner.Components[I] is TOneInstance then
          raise Exception.Create('OneInstance component duplicated in ' +
            AOwner.Name);
      inherited Create(aOwner);
      FTerminate := True;
    end;
    
    destructor TOneInstance.Destroy;
    begin
      if LockCreated then
        FinalizeLock
      else
        DoRaisePriorInstance;
      inherited Destroy;
    end;
    
    procedure Register;
    begin
      RegisterComponents('Additional', [TOneInstance]);
    end;
    
    {$Warnings Off}
    end.
    {***********************************************************************}
    {                      Copyright/License Information                    }
    {***********************************************************************}
    {  This file falls under the LGPL, or the Library General Public        }
    {  License, aka the Lesser General Public License, thus:                }
    {                                                                       }
    {  This file is distributed in the hope that it will be useful,         }
    {  but WITHOUT ANY WARRANTY; without even the implied warranty of       }
    {  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 }
    {                                                                       }
    {  For More details see:  http://www.gnu.org/copyleft/lgpl.html         }
    {***********************************************************************}
    {  This license was picked so that it could be used in both GPL'd code  }
    {  AND Commercial code. Open source rocks, but I do write commercial.   }
    {***********************************************************************}
    {                            FILE HISTORY                               }
    {***********************************************************************}
    {  History wasn't started until version 2.0, but here's the brief. In   }
    {  2000, I was helping with a Daily-Time program for work, clock in/out }
    {  etc. for the office workers. It was virtually always on, but over and}
    {  over again people would minimize the program, and later re-open, not }
    {  looking to see if it was still open. Thus several instances would be }
    {  opened at a time, so I looked online to find a fix, but while I found}
    {  3 components for allowing only one instance of a program, only one   }
    {  seemed to work, and it didn't allow bringing the former app to front.}
    {  I wrote this component from scratch to try and resolve this problem  }
    {  myself. All worked well for up until last year, when I made changes  }
    {  in the way it raised the app to use FindWindow, to find the handle,  }
    {  at which point it didn't work properly all the time. I got Kylix, and}
    {  again looked online, and nothing, nada, zip... not even  tutorial on }
    {  how!! So I started porting this component over, obviously starting   }
    {  from scratch again, only really using the minimal framework I had    }
    {  already, and then started trying to fix the Windows code I broke.    }
    {***********************************************************************}
    {Version 2.3 (Frank Ingermann, 9/20/2002)                               }
    {                                                                       }
    {  1.)Minor fix to make sure component isn't run in ide (csDesigning)   }
    {***********************************************************************}
    {Version 2.2 (Andrew Johnson, 5/6-7/2002)                               }
    {                                                                       }
    {  Andrew Johnson, 5/6/2002                                             }
    {  1.)Re-added Ifdef Windows in loaded, this fixed compiling in Linux   }
    {  2.)Changed default tab to Additional, j.i.c. other people use it ;-) }
    {  3.)Added a Delphi/Kylix .dcr file, with a unique component icon..    }
    {  4.)Added FinalizeLock routine                                        }
    {  5.)Changed RaiseFormerInstance to DoRaisePriorInstance               }
    {  6.)Merged ReadAndVerifyPid with to HasFormerInstance                 }
    {  7.)Changed OnNewInstance to InitializeLock                           }
    {  8.)Merged CreateLockFile with InitializeLock                         }
    {  9.)Merged LockDirectory with Create                                  }
    { 10.)Changed Windows to use OpenMutex to check for prev. Instance      }
    { 11.)Cleanup, Cleanup, everywhere!                                     }
    { 12.)Made sure to define Windows for Delphi 4/5                        }
    {                                                                       }
    {  Andrew Johnson, 5/7/2002                                             }
    {  1.)Added more Error Handling, and a bit of basic source documentation}
    {***********************************************************************}
    {Version 2.1 (Andrew Johnson, 4/28-29/2002)                             }
    {                                                                       }
    {  Andrew Johnson, 4/28/2002                                            }
    {  1.)Revised Linux Support, adding SIGUSR1 code for RaisePriorInstance }
    {  2.)Cleaned up and merged Windows/Linux routines using $IFDef's       }
    {  3.)Created EOneInstance Error and used throughout                    }
    {  4.)Added InformUser Code, and fixed destory code under Linux         }
    {                                                                       }
    {  Andrew Johnson, 4/29/2002                                            }
    {  1.)More clean up and merging Windows/Linux routines                  }
    {  2.)Changed Windows Version, AppSwitch to use Application's Title,    }
    {     instead of Application.MainForm's                                 }
    {  3.)Merged AppSwitch code into RaisePriorInstance                     }
    {  4.)Changed Windows Version of RaisePriorInstance, to raise App first }
    {     then popup(if valid), then set popup as foreground windows. This  }
    {     ensures that if the entire app(not just the popup) is minimized   }
    {     all forms are restored, in proper order, THEN popup is shown,     }
    {     focused and brought to front. This apears to have have fixed all  }
    {     major problems with RaisePriorInstance code for Windows.          }
    {***********************************************************************}
    {Version 2.0 (Andrew Johnson, 4/26/2002)                                }
    {                                                                       }
    {  1.)Added Initial Linux Support, using LockFile                       }
    {  2.)Added License,and Version History                                 }
    {  3.)Updated Copyright Date's                                          }
    {***********************************************************************}

  6. #6
    Ik zal vanavond eens kijken of de "raw" mode ook werkt

    http://wiki.freepascal.org/UniqueIns..._Use_.28Raw.29

  7. #7
    aha, opgelost.

    deze aan de uses toevoegen: "uniqueinstanceraw"

    ik kan nu in de "onCreate" het volgende doen:
    Code:
    if InstanceRunning = true then Exit;

  8. #8
    Senior Member Thaddy's Avatar
    Join Date
    Dec 2004
    Location
    Amsterdam
    Posts
    2,211
    Ik dacht dat het tegenwoordig zo kan?:

    Code:
    program singleton;
    {$APPTYPE CONSOLE}
    
    type
      TBaseSingleton = class
      private
        class var MyInstance:TBaseSingleton;
      public
        constructor create;virtual;
      end;
    
    { TBaseSingleton }
    
    constructor TBaseSingleton.create;
    begin
      if MyInstance = nil then
      begin
        inherited create;
        MyInstance := Self;
      end
      else
        Self := MyInstance;
    end;
    
    var
      a, b: TBaseSingleton;
    begin
     writeln('Do I exist on first attempt?: ',Boolean(TBaseSingleton.Myinstance));
     readln;
     a:= TBaseSingleton.create;
     b:= TBaseSingleton.create;
     if a.MyInstance = b.MyInstance  then
       writeln('I am a singleton')
     else
       writeln('I am not a singleton');
     readln;
    
    end.
    Last edited by Thaddy; 05-Feb-13 at 18:54.
    Werken aan Ansi support voor Windows is verspilde tijd, behalve voor historici.

  9. #9
    Dat is leuk als je maar één instantie van een class wilt hebben, maar in dit geval ging het niet om classes maar om applicaties.
    1+1=b

  10. #10
    Senior Member Thaddy's Avatar
    Join Date
    Dec 2004
    Location
    Amsterdam
    Posts
    2,211
    Dan kan het voor windows in ieder geval heel kort:
    Code:
    program Singleton2;
    uses
      Windows,
      Forms,
      USingleton in 'USingleton.pas' {Form1}; // verder leeg.
    {$R *.res}
    const
      MyApp:Pchar ='ThisApplication';
    var
      App: Atom;
    begin
      if GlobalFindAtom(MyApp) = 0 then
      begin
      try
         App:= GlobalAddAtom(MyApp);
         Application.Initialize;
         Application.CreateForm(TForm1, Form1);
         Application.Run;
      finally
         GlobalDeleteAtom(App);
      end 
    end else
        Messagebox(0, PChar(MyApp + ' is already running.'), MyApp,MB_OK);
    end.
    Volgens mij heb ik ook een vrij korte voor nixen, even zoeken.
    Werken aan Ansi support voor Windows is verspilde tijd, behalve voor historici.

  11. #11
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Jouw "otherinstance" maakt geen instance, maar showed het form. Misschien een woording probleem in je vraag dat je niet echt meerdere form class instanties wilt voorkomen, maar meerdere form.shows van dezelfde referentie of zo?

    Ik gebruik overigens:

    delphi Code:
    1. procedure SingleInstance(MutexName: String);
    2. var
    3.   MutexHandle : THandle;
    4. begin
    5.   MutexHandle := CreateMutex(nil, True, pchar(MutexName));
    6.   if MutexHandle <> 0 then
    7.   begin
    8.     if GetLastError = ERROR_ALREADY_EXISTS then
    9.     begin
    10.       CloseHandle(MutexHandle);
    11.       Halt;
    12.     end;
    13.   end;
    14. end;

    En dan simpelweg singleinstance('unieke naam'); als eerste regel in de .dpr

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •