Стартовый пул

UniqueInstance/registeruniqueinstance.pas

@@ -0,0 +1,29 @@
+unit registeruniqueinstance;
+
+{$Mode ObjFpc}
+{$H+}
+
+interface
+
+uses 
+  Classes, SysUtils, LResources, LazarusPackageIntf,uniqueinstance;
+  
+procedure Register;
+
+implementation
+
+procedure RegisterUnitUniqueInstance;
+begin
+  RegisterComponents('System',[TUniqueInstance]);
+end;  
+
+procedure Register;
+
+begin
+  RegisterUnit('uniqueinstance',@RegisterUnitUniqueInstance);
+end; 
+
+initialization
+{$i uniqueicon.lrs}
+ 
+end.

UniqueInstance/testcomponent/fmain.lfm

@@ -0,0 +1,58 @@
+object Form1: TForm1
+  Left = 464
+  Height = 280
+  Top = 339
+  Width = 340
+  HorzScrollBar.Page = 339
+  VertScrollBar.Page = 279
+  ActiveControl = ListBox1
+  BorderStyle = bsDialog
+  Caption = 'Test UniqueInstance'
+  ClientHeight = 280
+  ClientWidth = 340
+  Position = poScreenCenter
+  LCLVersion = '1.7'
+  object Label1: TLabel
+    Left = 8
+    Height = 15
+    Top = 8
+    Width = 145
+    Caption = 'Waiting for new instances...'
+    ParentColor = False
+  end
+  object ListBox1: TListBox
+    Left = 8
+    Height = 216
+    Top = 24
+    Width = 320
+    ItemHeight = 0
+    TabOrder = 0
+  end
+  object CrashAppButton: TButton
+    Left = 8
+    Height = 25
+    Top = 248
+    Width = 136
+    BorderSpacing.InnerBorder = 4
+    Caption = 'Crash Application'
+    OnClick = CrashAppButtonClick
+    TabOrder = 1
+  end
+  object ShowDialogButton: TButton
+    Left = 192
+    Height = 25
+    Top = 248
+    Width = 136
+    Caption = 'Show Dialog'
+    OnClick = ShowDialogButtonClick
+    TabOrder = 2
+  end
+  object UniqueInstance1: TUniqueInstance
+    Enabled = True
+    Identifier = 'test0.1'
+    UpdateInterval = 800
+    OnOtherInstance = UniqueInstance1OtherInstance
+    left = 152
+    top = 104
+  end
+end

UniqueInstance/testcomponent/fmain.pas

@@ -0,0 +1,81 @@
+unit fMain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+  UniqueInstance, StdCtrls, ExtCtrls;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    CrashAppButton: TButton;
+    ShowDialogButton: TButton;
+    Label1: TLabel;
+    ListBox1: TListBox;
+    UniqueInstance1: TUniqueInstance;
+    procedure CrashAppButtonClick(Sender: TObject);
+    procedure ShowDialogButtonClick(Sender: TObject);
+    procedure UniqueInstance1OtherInstance(Sender: TObject; Count: Integer;
+      Parameters: array of String);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{$ifdef unix}
+uses
+  BaseUnix;
+{$endif}
+
+{$ifdef windows}
+uses
+  Windows;
+{$endif}
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject; Count: Integer;
+  Parameters: array of String);
+var
+  i:Integer;
+begin
+  Label1.Caption:=Format('A new instance was created at %s with %d parameter(s):', [TimeToStr(Time), Count]);
+  ListBox1.Clear;
+  for i := 0 to Count - 1 do
+    ListBox1.Items.Add(Parameters[i]);
+  BringToFront;
+  //hack to force app bring to front
+  FormStyle := fsSystemStayOnTop;
+  FormStyle := fsNormal;
+end;
+
+procedure TForm1.CrashAppButtonClick(Sender: TObject);
+begin
+  {$ifdef unix}
+  FpKill(FpGetpid, 9);
+  {$endif}
+  {$ifdef windows}
+  TerminateProcess(GetCurrentProcess, 0);
+  {$endif}
+end;
+
+procedure TForm1.ShowDialogButtonClick(Sender: TObject);
+begin
+  Application.MessageBox('Hi! I am a modal Window!', 'Modal Window Check', MB_ICONINFORMATION);
+end;
+
+end.
+

UniqueInstance/testcomponent/testinstance.lpi

@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="UniqueInstanceTest"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="uniqueinstance_package"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="testinstance.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="fmain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="fMain"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="TestInstance"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="C:\bin\code\fpc302rc1\bin\i386-win32\fpc.exe"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

UniqueInstance/testcomponent/testinstance.lpr

@@ -0,0 +1,21 @@
+program testinstance;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, fMain;
+
+{$R *.res}
+
+begin
+  Application.Title := 'UniqueInstanceTest';
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

UniqueInstance/testraw/project1.lpi

@@ -0,0 +1,82 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="uniqueinstance_package"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="project1"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

UniqueInstance/testraw/project1.lpr

@@ -0,0 +1,21 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, Unit1, UniqueInstanceRaw;
+
+begin
+  if not InstanceRunning('project1ver3') then
+  begin
+    Application.Initialize;
+    Application.CreateForm(TForm1, Form1);
+    Application.Run;
+  end;
+end.
+

UniqueInstance/testraw/unit1.lfm

@@ -0,0 +1,22 @@
+object Form1: TForm1
+  Left = 344
+  Height = 136
+  Top = 152
+  Width = 295
+  HorzScrollBar.Page = 294
+  VertScrollBar.Page = 135
+  Caption = 'Test UniqueInstanceRaw'
+  ClientHeight = 136
+  ClientWidth = 295
+  LCLVersion = '0.9.31'
+  object ButCrashApp: TButton
+    Left = 64
+    Height = 32
+    Top = 48
+    Width = 158
+    BorderSpacing.InnerBorder = 4
+    Caption = 'Crash Application'
+    OnClick = ButCrashAppClick
+    TabOrder = 0
+  end
+end

UniqueInstance/testraw/unit1.pas

@@ -0,0 +1,55 @@
+unit Unit1; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    ButCrashApp: TButton;
+    procedure ButCrashAppClick(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{$R *.lfm}
+
+{$ifdef unix}
+uses
+  BaseUnix;
+{$endif}
+
+{$ifdef windows}
+uses
+  Windows;
+{$endif}
+
+{ TForm1 }
+
+procedure TForm1.ButCrashAppClick(Sender: TObject);
+begin
+  {$ifdef unix}
+  FpKill(FpGetpid, 9);
+  {$endif}
+  {$ifdef windows}
+  TerminateProcess(GetCurrentProcess, 0);
+  {$endif}
+end;
+
+initialization
+
+end.
+

UniqueInstance/uniqueinstance.pas

@@ -0,0 +1,159 @@
+unit UniqueInstance;
+
+{
+  UniqueInstance is a component to allow only a instance by program
+
+  Copyright (C) 2006 Luiz Americo Pereira Camara
+  pascalive@bol.com.br
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program 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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+
+{$mode objfpc}{$H+}
+{$if not defined(Windows) or (FPC_FULLVERSION >= 30001)}
+{$define PollIPCMessage}
+{$endif}
+
+interface
+
+uses
+  Forms, Classes, SysUtils, simpleipc, ExtCtrls;
+  
+type
+
+  TOnOtherInstance = procedure (Sender : TObject; ParamCount: Integer; const Parameters: array of String) of object;
+
+  { TUniqueInstance }
+
+  TUniqueInstance = class(TComponent)
+  private
+    FIdentifier: String;
+    FOnOtherInstance: TOnOtherInstance;
+    FUpdateInterval: Cardinal;
+    FEnabled: Boolean;
+    FPriorInstanceRunning: Boolean;
+    procedure ReceiveMessage(Sender: TObject);
+    {$ifdef PollIPCMessage}
+    procedure CheckMessage(Sender: TObject);
+    {$endif}
+  protected
+    procedure Loaded; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property PriorInstanceRunning: Boolean read FPriorInstanceRunning;
+  published
+    property Enabled: Boolean read FEnabled write FEnabled default False;
+    property Identifier: String read FIdentifier write FIdentifier;
+    property UpdateInterval: Cardinal read FUpdateInterval write FUpdateInterval default 1000;
+    property OnOtherInstance: TOnOtherInstance read FOnOtherInstance write FOnOtherInstance;
+  end;
+
+implementation
+
+uses
+  StrUtils, UniqueInstanceBase;
+
+{ TUniqueInstance }
+
+procedure TUniqueInstance.ReceiveMessage(Sender: TObject);
+var
+  ParamsArray: array of String;
+  Params: String;
+  Count, i: Integer;
+begin
+  if Assigned(FOnOtherInstance) then
+  begin
+    //MsgType stores ParamCount
+    Count := FIPCServer.MsgType;
+    SetLength(ParamsArray, Count);
+    Params := FIPCServer.StringMessage;
+    for i := 1 to Count do
+      ParamsArray[i - 1] := ExtractWord(i, Params, [ParamsSeparator]);
+    FOnOtherInstance(Self, Count, ParamsArray);
+  end;
+end;
+
+{$ifdef PollIPCMessage}
+procedure TUniqueInstance.CheckMessage(Sender: TObject);
+begin
+  FIPCServer.PeekMessage(1, True);
+end;
+{$endif}
+
+procedure TUniqueInstance.Loaded;
+var
+  IPCClient: TSimpleIPCClient;
+  {$ifdef PollIPCMessage}
+  Timer: TTimer;
+  {$endif}
+begin
+  if not (csDesigning in ComponentState) and FEnabled then
+  begin
+    IPCClient := TSimpleIPCClient.Create(Self);
+    IPCClient.ServerId := GetServerId(FIdentifier);
+    if not Assigned(FIPCServer) and IPCClient.ServerRunning then
+    begin
+      //A older instance is running.
+      FPriorInstanceRunning := True;
+      //A instance is already running
+      //Send a message and then exit
+      if Assigned(FOnOtherInstance) then
+      begin
+        IPCClient.Active := True;
+        IPCClient.SendStringMessage(ParamCount, GetFormattedParams);
+      end;
+      Application.ShowMainForm := False;
+      Application.Terminate;
+    end
+    else
+    begin
+      if not Assigned(FIPCServer) then
+        InitializeUniqueServer(IPCClient.ServerID);
+      FIPCServer.OnMessage := @ReceiveMessage;
+      //there's no more need for IPCClient
+      IPCClient.Destroy;
+      {$ifdef PollIPCMessage}
+      if Assigned(FOnOtherInstance) then
+      begin
+        Timer := TTimer.Create(Self);
+        Timer.Interval := FUpdateInterval;
+        Timer.OnTimer := @CheckMessage;
+      end;
+      {$endif}
+    end;
+  end;//if
+  inherited;
+end;
+
+constructor TUniqueInstance.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FUpdateInterval := 1000;
+end;
+
+end.
+

UniqueInstance/uniqueinstance_package.lpk

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="uniqueinstance_package"/>
+    <Type Value="RunAndDesignTime"/>
+    <Author Value="Luiz Américo Pereira Câmara"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
+      </SearchPaths>
+      <Parsing>
+        <SyntaxOptions>
+          <UseAnsiStrings Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
+      <CodeGeneration>
+        <Optimizations>
+          <OptimizationLevel Value="2"/>
+        </Optimizations>
+      </CodeGeneration>
+    </CompilerOptions>
+    <Description Value="UniqueInstance provides a component to limits one instance per application"/>
+    <License Value="Modified LGPL"/>
+    <Version Major="1" Minor="1"/>
+    <Files Count="4">
+      <Item1>
+        <Filename Value="uniqueinstance.pas"/>
+        <UnitName Value="UniqueInstance"/>
+      </Item1>
+      <Item2>
+        <Filename Value="uniqueinstanceraw.pas"/>
+        <UnitName Value="UniqueInstanceRaw"/>
+      </Item2>
+      <Item3>
+        <Filename Value="registeruniqueinstance.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="registeruniqueinstance"/>
+      </Item3>
+      <Item4>
+        <Filename Value="uniqueinstancebase.pas"/>
+        <UnitName Value="UniqueInstanceBase"/>
+      </Item4>
+    </Files>
+    <RequiredPkgs Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

UniqueInstance/uniqueinstance_package.pas

@@ -0,0 +1,22 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit uniqueinstance_package;
+
+interface
+
+uses
+  UniqueInstance, UniqueInstanceRaw, registeruniqueinstance, 
+  UniqueInstanceBase, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+  RegisterUnit('registeruniqueinstance', @registeruniqueinstance.Register);
+end;
+
+initialization
+  RegisterPackage('uniqueinstance_package', @Register);
+end.

UniqueInstance/uniqueinstancebase.pas

@@ -0,0 +1,63 @@
+unit UniqueInstanceBase;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, simpleipc;
+
+const
+  ParamsSeparator = #13;
+
+var
+  FIPCServer: TSimpleIPCServer;
+
+procedure InitializeUniqueServer(const ServerId: String);
+
+function GetFormattedParams: String;
+
+function GetServerId(const Identifier: String): String;
+
+implementation
+
+uses
+  LazUTF8;
+
+const
+  BaseServerId = 'tuniqueinstance_';
+
+procedure InitializeUniqueServer(const ServerId: String);
+begin
+  //It's the first instance. Init the server
+  if FIPCServer = nil then
+  begin
+    FIPCServer := TSimpleIPCServer.Create(nil);
+    FIPCServer.ServerID := ServerId;
+    FIPCServer.Global := True;
+    FIPCServer.StartServer;
+  end;
+end;
+
+function GetFormattedParams: String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to ParamCount do
+    Result := Result + ParamStrUTF8(i) + ParamsSeparator;
+end;
+
+function GetServerId(const Identifier: String): String;
+begin
+  if Identifier <> '' then
+    Result := BaseServerId + Identifier
+  else
+    Result := BaseServerId + ExtractFileName(ParamStrUTF8(0));
+end;
+
+finalization
+  FIPCServer.Free;
+
+end.
+

UniqueInstance/uniqueinstanceraw.pas

@@ -0,0 +1,85 @@
+unit UniqueInstanceRaw;
+
+{
+  UniqueInstance is a component to allow only a instance by program
+
+  Copyright (C) 2006 Luiz Americo Pereira Camara
+  pascalive@bol.com.br
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program 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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+  
+  function InstanceRunning(const Identifier: String; SendParameters: Boolean = False; DoInitServer: Boolean = True): Boolean;
+
+  function InstanceRunning: Boolean;
+
+implementation
+
+uses
+  SimpleIpc, UniqueInstanceBase;
+  
+function InstanceRunning(const Identifier: String; SendParameters: Boolean; DoInitServer: Boolean): Boolean;
+  
+var
+  Client: TSimpleIPCClient;
+  
+begin
+  Client := TSimpleIPCClient.Create(nil);
+  with Client do
+  try
+    ServerId := GetServerId(Identifier);
+    Result := Client.ServerRunning;
+    if not Result then
+    begin
+      if DoInitServer then
+        InitializeUniqueServer(ServerID);
+    end
+    else
+      // an instance already exists
+      if SendParameters then
+      begin
+        Active := True;
+        SendStringMessage(ParamCount, GetFormattedParams);
+      end;
+  finally
+    Free;
+  end;
+end;
+
+function InstanceRunning: Boolean;
+begin
+  Result := InstanceRunning('');
+end;
+
+end.
+