Added: Single Instance unit
Added: test application
This commit is contained in:
parent
7a3cb19ccc
commit
072b845310
81
Test/Forms/FMain.dfm
Normal file
81
Test/Forms/FMain.dfm
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
object frmMain: TfrmMain
|
||||||
|
Left = 199
|
||||||
|
Top = 107
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'X'#178'Utils Test'
|
||||||
|
ClientHeight = 157
|
||||||
|
ClientWidth = 455
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'MS Sans Serif'
|
||||||
|
Font.Style = []
|
||||||
|
OldCreateOrder = False
|
||||||
|
Position = poScreenCenter
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object lblAppPath: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 12
|
||||||
|
Width = 79
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Application path:'
|
||||||
|
end
|
||||||
|
object lblAppVersion: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 36
|
||||||
|
Width = 92
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Application version:'
|
||||||
|
end
|
||||||
|
object lblOSVersion: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 60
|
||||||
|
Width = 55
|
||||||
|
Height = 13
|
||||||
|
Caption = 'OS version:'
|
||||||
|
end
|
||||||
|
object lblAppPathValue: TLabel
|
||||||
|
Left = 112
|
||||||
|
Top = 12
|
||||||
|
Width = 337
|
||||||
|
Height = 13
|
||||||
|
AutoSize = False
|
||||||
|
Caption = '<unknown>'
|
||||||
|
end
|
||||||
|
object lblAppVersionValue: TLabel
|
||||||
|
Left = 112
|
||||||
|
Top = 36
|
||||||
|
Width = 337
|
||||||
|
Height = 13
|
||||||
|
AutoSize = False
|
||||||
|
Caption = '<unknown>'
|
||||||
|
end
|
||||||
|
object lblOSVersionValue: TLabel
|
||||||
|
Left = 112
|
||||||
|
Top = 60
|
||||||
|
Width = 337
|
||||||
|
Height = 13
|
||||||
|
AutoSize = False
|
||||||
|
Caption = '<unknown>'
|
||||||
|
end
|
||||||
|
object lblInstances: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 84
|
||||||
|
Width = 49
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Instances:'
|
||||||
|
end
|
||||||
|
object lstInstances: TListBox
|
||||||
|
Left = 112
|
||||||
|
Top = 84
|
||||||
|
Width = 337
|
||||||
|
Height = 65
|
||||||
|
ItemHeight = 13
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
70
Test/Forms/FMain.pas
Normal file
70
Test/Forms/FMain.pas
Normal file
@ -0,0 +1,70 @@
|
|||||||
|
unit FMain;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
Controls,
|
||||||
|
Forms,
|
||||||
|
StdCtrls,
|
||||||
|
X2UtSingleInstance;
|
||||||
|
|
||||||
|
type
|
||||||
|
TfrmMain = class(TForm, IX2InstanceNotifier)
|
||||||
|
lblAppPath: TLabel;
|
||||||
|
lblAppPathValue: TLabel;
|
||||||
|
lblAppVersion: TLabel;
|
||||||
|
lblAppVersionValue: TLabel;
|
||||||
|
lblInstances: TLabel;
|
||||||
|
lblOSVersion: TLabel;
|
||||||
|
lblOSVersionValue: TLabel;
|
||||||
|
lstInstances: TListBox;
|
||||||
|
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
protected
|
||||||
|
// IX2InstanceNotifier implementation
|
||||||
|
procedure OnInstance(const ACmdLine: String);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
X2UtApp,
|
||||||
|
X2UtOS;
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
{=============================== TfrmMain
|
||||||
|
Initialization
|
||||||
|
========================================}
|
||||||
|
procedure TfrmMain.FormCreate;
|
||||||
|
begin
|
||||||
|
lblAppPathValue.Caption := App.Path;
|
||||||
|
lblAppVersionValue.Caption := App.FormatVersion();
|
||||||
|
lblOSVersionValue.Caption := OS.FormatVersion();
|
||||||
|
|
||||||
|
RegisterInstance(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.FormDestroy;
|
||||||
|
begin
|
||||||
|
UnregisterInstance(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{=============================== TfrmMain
|
||||||
|
IX2InstanceNotifier implementation
|
||||||
|
========================================}
|
||||||
|
procedure TfrmMain.OnInstance;
|
||||||
|
var
|
||||||
|
iParam: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
lstInstances.Items.Add('New instance found:');
|
||||||
|
|
||||||
|
for iParam := 0 to ParamCountEx(ACmdLine) do
|
||||||
|
lstInstances.Items.Add(' ' + ParamStrEx(ACmdLine, iParam));
|
||||||
|
|
||||||
|
lstInstances.ItemIndex := lstInstances.Items.Count - 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
37
Test/X2UtilsTest.cfg
Normal file
37
Test/X2UtilsTest.cfg
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
-$A8
|
||||||
|
-$B-
|
||||||
|
-$C+
|
||||||
|
-$D+
|
||||||
|
-$E-
|
||||||
|
-$F-
|
||||||
|
-$G+
|
||||||
|
-$H+
|
||||||
|
-$I+
|
||||||
|
-$J-
|
||||||
|
-$K-
|
||||||
|
-$L+
|
||||||
|
-$M-
|
||||||
|
-$N+
|
||||||
|
-$O+
|
||||||
|
-$P+
|
||||||
|
-$Q-
|
||||||
|
-$R-
|
||||||
|
-$S-
|
||||||
|
-$T-
|
||||||
|
-$U-
|
||||||
|
-$V+
|
||||||
|
-$W-
|
||||||
|
-$X+
|
||||||
|
-$YD
|
||||||
|
-$Z1
|
||||||
|
-GD
|
||||||
|
-cg
|
||||||
|
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||||
|
-H+
|
||||||
|
-W+
|
||||||
|
-M
|
||||||
|
-$M16384,1048576
|
||||||
|
-K$00400000
|
||||||
|
-LE"c:\program files\borland\delphi6\Projects\Bpl"
|
||||||
|
-LN"c:\program files\borland\delphi6\Projects\Bpl"
|
||||||
|
-DmadExcept
|
||||||
160
Test/X2UtilsTest.dof
Normal file
160
Test/X2UtilsTest.dof
Normal file
@ -0,0 +1,160 @@
|
|||||||
|
[FileVersion]
|
||||||
|
Version=6.0
|
||||||
|
[Compiler]
|
||||||
|
A=8
|
||||||
|
B=0
|
||||||
|
C=1
|
||||||
|
D=1
|
||||||
|
E=0
|
||||||
|
F=0
|
||||||
|
G=1
|
||||||
|
H=1
|
||||||
|
I=1
|
||||||
|
J=0
|
||||||
|
K=0
|
||||||
|
L=1
|
||||||
|
M=0
|
||||||
|
N=1
|
||||||
|
O=1
|
||||||
|
P=1
|
||||||
|
Q=0
|
||||||
|
R=0
|
||||||
|
S=0
|
||||||
|
T=0
|
||||||
|
U=0
|
||||||
|
V=1
|
||||||
|
W=0
|
||||||
|
X=1
|
||||||
|
Y=1
|
||||||
|
Z=1
|
||||||
|
ShowHints=1
|
||||||
|
ShowWarnings=1
|
||||||
|
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||||
|
[Linker]
|
||||||
|
MapFile=3
|
||||||
|
OutputObjs=0
|
||||||
|
ConsoleApp=1
|
||||||
|
DebugInfo=0
|
||||||
|
RemoteSymbols=0
|
||||||
|
MinStackSize=16384
|
||||||
|
MaxStackSize=1048576
|
||||||
|
ImageBase=4194304
|
||||||
|
ExeDescription=
|
||||||
|
[Directories]
|
||||||
|
OutputDir=
|
||||||
|
UnitOutputDir=
|
||||||
|
PackageDLLOutputDir=
|
||||||
|
PackageDCPOutputDir=
|
||||||
|
SearchPath=
|
||||||
|
Packages=vcl;rtl;vclx;Indy60;madBasic_;madDisAsm_;dsnap;dbrtl;xmlrtl;inet;soaprtl
|
||||||
|
Conditionals=madExcept
|
||||||
|
DebugSourceDirs=
|
||||||
|
UsePackages=0
|
||||||
|
[Parameters]
|
||||||
|
RunParams=
|
||||||
|
HostApplication=
|
||||||
|
Launcher=
|
||||||
|
UseLauncher=0
|
||||||
|
DebugCWD=
|
||||||
|
[Version Info]
|
||||||
|
IncludeVerInfo=1
|
||||||
|
AutoIncBuild=1
|
||||||
|
MajorVer=1
|
||||||
|
MinorVer=0
|
||||||
|
Release=0
|
||||||
|
Build=4
|
||||||
|
Debug=0
|
||||||
|
PreRelease=0
|
||||||
|
Special=0
|
||||||
|
Private=0
|
||||||
|
DLL=0
|
||||||
|
Locale=1043
|
||||||
|
CodePage=1252
|
||||||
|
[Version Info Keys]
|
||||||
|
CompanyName=
|
||||||
|
FileDescription=
|
||||||
|
FileVersion=1.0.0.4
|
||||||
|
InternalName=
|
||||||
|
LegalCopyright=
|
||||||
|
LegalTrademarks=
|
||||||
|
OriginalFilename=
|
||||||
|
ProductName=
|
||||||
|
ProductVersion=
|
||||||
|
Comments=
|
||||||
|
[Excluded Packages]
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview
|
||||||
|
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\JVCL200_D60.bpl=JEDI-VCL Components
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\dclIndy60.bpl=Internet Direct (Indy) for D6 Property and Component Editors
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\BalloonD6.bpl=Balloon 2.0
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\asqlite.bpl=Aducom Software -- SQLite Design Time Components
|
||||||
|
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\aSQLitepkg.bpl=Aducom Software -- SQLite RunTime Components
|
||||||
|
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\GR32_D6.bpl=Graphics32
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\GR32_DSGN_D6.bpl=Graphics32 Design Time Package
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\PNGImage_D6.bpl=PNGImage
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\BMSpinEditD6.bpl=BMSpinEdit
|
||||||
|
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tbx_d6.bpl=Toolbar2000 -- TBX Extensions (Alex Denisov)
|
||||||
|
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2k_d6.bpl=Toolbar2000 Components (Jordan Russell)
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\tbxdsgn_d6.bpl=Toolbar2000 -- TBX Extensions Design Package (Alex Denisov)
|
||||||
|
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2kdsgn_d6.bpl=Toolbar2000 Design Package (Jordan Russell)
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\SynEdit_D6.bpl=SynEdit component suite
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\DelphiX_for5.bpl=DelphiX - DirectX components for Delphi
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\GLScene6.bpl=GLScene - OpenGL 3D library
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\NLDMBD6D.bpl=NLDMessageBox
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\TntUnicodeVcl_D60.bpl=Tnt Unicode Controls
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\PageControlExD6.bpl=PageControlEx
|
||||||
|
c:\program files\borland\delphi6\Bin\dclsmp60.bpl=Borland Sample Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dcl31w60.bpl=Delphi 1.0 Compatibility Components
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\NLDTrayIconD6.bpl=NLDTrayIcon donated by SVG_1986
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\ServerListD6D.bpl=SOF2Manager - Server List Designtime
|
||||||
|
C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component
|
||||||
|
F:\Delphi\Components\madCollection\madBasic\Delphi 6\madHelp_.bpl=madHelp 1.1 · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1a · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.2z · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.0a · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3i · www.madshi.net
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\X2MultiMon_D6D.bpl=X2MultiMon Designtime Package
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\ff2_d60.bpl=TurboPower FlashFiler Designtime Package - VCL60
|
||||||
|
F:\Delphi\Components\ZipForge\Lib\Delphi 6\dclZipForged6.bpl=ZipForge Package
|
||||||
|
c:\program files\borland\delphi6\Bin\dclado60.bpl=Borland ADO DB Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components
|
||||||
|
C:\Program Files\Borland\Delphi6\Bin\dbx60.bpl=Borland SQL Explorer UI Package
|
||||||
|
c:\program files\borland\delphi6\Bin\DCLIB60.bpl=InterBase Data Access Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component
|
||||||
|
C:\Program Files\Borland\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclqrt60.bpl=QuickReport Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dcltee60.bpl=TeeChart Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dcldss60.bpl=Borland Decision Cube Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclclxdb60.bpl=Borland CLX Database Components
|
||||||
|
C:\Program Files\Borland\Delphi6\Bin\dclclxstd60.bpl=Borland CLX Standard Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclmcn60.bpl=Borland DataSnap Connection Components
|
||||||
|
c:\program files\borland\delphi6\Bin\applet60.bpl=Borland Control Panel Applet Package
|
||||||
|
c:\program files\borland\delphi6\Bin\dclemacsedit60.bpl=Borland Editor Emacs Enhancements
|
||||||
|
c:\program files\borland\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors
|
||||||
|
c:\program files\borland\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package
|
||||||
|
c:\program files\borland\delphi6\Bin\DCLNMF60.bpl=NetMasters Fastnet Tools
|
||||||
|
c:\program files\borland\delphi6\Bin\dclwbm60.bpl=Borland InternetExpress Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclie60.bpl=Internet Explorer Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment
|
||||||
|
c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components
|
||||||
|
[Included Packages]
|
||||||
|
C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements
|
||||||
|
F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptIde_.bpl=madExceptIde 1.0b · www.madshi.net
|
||||||
|
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6 · www.madshi.net
|
||||||
|
C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclnet60.bpl=Borland Internet Components
|
||||||
|
c:\program files\borland\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\ColorPickerButtonD6.bpl=ColorPickerButton
|
||||||
|
C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\SysILS.bpl=(untitled)
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\videocap5.bpl=(untitled)
|
||||||
|
c:\program files\borland\delphi6\Projects\Bpl\DragDropD6.bpl=Drag and Drop Component Suite
|
||||||
28
Test/X2UtilsTest.dpr
Normal file
28
Test/X2UtilsTest.dpr
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
program X2UtilsTest;
|
||||||
|
|
||||||
|
uses
|
||||||
|
madExcept,
|
||||||
|
madLinkDisAsm,
|
||||||
|
Forms,
|
||||||
|
X2UtOS in '..\X2UtOS.pas',
|
||||||
|
X2UtApp in '..\X2UtApp.pas',
|
||||||
|
X2UtHandCursor in '..\X2UtHandCursor.pas',
|
||||||
|
X2UtSingleInstance in '..\X2UtSingleInstance.pas',
|
||||||
|
FMain in 'Forms\FMain.pas' {frmMain};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
const
|
||||||
|
CAppID = '{DCAC19C4-1D7D-47C0-AD4E-2A1DA39824E0}';
|
||||||
|
|
||||||
|
var
|
||||||
|
frmMain: TfrmMain;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if not SingleInstance(CAppID) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TfrmMain, frmMain);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
427
X2UtSingleInstance.pas
Normal file
427
X2UtSingleInstance.pas
Normal file
@ -0,0 +1,427 @@
|
|||||||
|
{
|
||||||
|
:: X2UtSingleInstance provides functions to detect previous instances of an
|
||||||
|
:: application and pass it the new command-line parameters.
|
||||||
|
::
|
||||||
|
:: Subversion repository available at:
|
||||||
|
:: $URL$
|
||||||
|
::
|
||||||
|
:: Last changed: $Date$
|
||||||
|
:: Revision: $Rev$
|
||||||
|
:: Author: $LastChangedBy$
|
||||||
|
|
||||||
|
:$
|
||||||
|
:$
|
||||||
|
:$ X2Utils is released under the zlib/libpng OSI-approved license.
|
||||||
|
:$ For more information: http://www.opensource.org/
|
||||||
|
:$ /n/n
|
||||||
|
:$ /n/n
|
||||||
|
:$ Copyright (c) 2003 X2Software
|
||||||
|
:$ /n/n
|
||||||
|
:$ This software is provided 'as-is', without any express or implied warranty.
|
||||||
|
:$ In no event will the authors be held liable for any damages arising from
|
||||||
|
:$ the use of this software.
|
||||||
|
:$ /n/n
|
||||||
|
:$ Permission is granted to anyone to use this software for any purpose,
|
||||||
|
:$ including commercial applications, and to alter it and redistribute it
|
||||||
|
:$ freely, subject to the following restrictions:
|
||||||
|
:$ /n/n
|
||||||
|
:$ 1. The origin of this software must not be misrepresented; you must not
|
||||||
|
:$ claim that you wrote the original software. If you use this software in a
|
||||||
|
:$ product, an acknowledgment in the product documentation would be
|
||||||
|
:$ appreciated but is not required.
|
||||||
|
:$ /n/n
|
||||||
|
:$ 2. Altered source versions must be plainly marked as such, and must not be
|
||||||
|
:$ misrepresented as being the original software.
|
||||||
|
:$ /n/n
|
||||||
|
:$ 3. This notice may not be removed or altered from any source distribution.
|
||||||
|
}
|
||||||
|
unit X2UtSingleInstance;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
{
|
||||||
|
:$ Notifier interface
|
||||||
|
|
||||||
|
:: Applications who want to receive notifications on new instances must
|
||||||
|
:: implements this interface and call RegisterInstance.
|
||||||
|
}
|
||||||
|
IX2InstanceNotifier = interface
|
||||||
|
['{4C435D46-6A7F-4CD7-9400-338E3E8FB5C6}']
|
||||||
|
procedure OnInstance(const ACmdLine: String);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Checks for a previous instance of the application
|
||||||
|
|
||||||
|
:: Returns False if a previous instance was found, True if this is the
|
||||||
|
:: first registered instance. ApplicationID must be unique to prevent
|
||||||
|
:: application conflicts, usage of a generated GUID is recommended.
|
||||||
|
|
||||||
|
:! Set ANotify to False if you're using SingleInstance in a console
|
||||||
|
:! application without a message loop.
|
||||||
|
}
|
||||||
|
function SingleInstance(const AApplicationID: String;
|
||||||
|
const ANotify: Boolean = True): Boolean;
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Registers the instance for notifications
|
||||||
|
|
||||||
|
:: If an application wants to be notified of new instances it must
|
||||||
|
:: implement the IX2InstanceNotifier and register the interface using
|
||||||
|
:: this function.
|
||||||
|
}
|
||||||
|
procedure RegisterInstance(const ANotifier: IX2InstanceNotifier);
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Unregisters a previously registered instance
|
||||||
|
}
|
||||||
|
procedure UnregisterInstance(const ANotifier: IX2InstanceNotifier);
|
||||||
|
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Works like System.ParamCount, but uses the specified string instead
|
||||||
|
:$ of the actual command line
|
||||||
|
}
|
||||||
|
function ParamCountEx(const ACmdLine: String): Integer;
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Works like System.ParamStr, but uses the specified string instead
|
||||||
|
:$ of the actual command line
|
||||||
|
}
|
||||||
|
function ParamStrEx(const ACmdLine: String; AIndex: Integer): String;
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Works like SysUtils.FindCmdLineSwitch, but uses the specified string
|
||||||
|
:$ instead of the actual command line
|
||||||
|
}
|
||||||
|
function FindCmdLineSwitchEx(const ACmdLine, ASwitch: String;
|
||||||
|
const AChars: TSysCharSet;
|
||||||
|
const AIgnoreCase: Boolean): Boolean; overload;
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Works like SysUtils.FindCmdLineSwitch, but uses the specified string
|
||||||
|
:$ instead of the actual command line
|
||||||
|
}
|
||||||
|
function FindCmdLineSwitchEx(const ACmdLine, ASwitch: String): Boolean; overload;
|
||||||
|
|
||||||
|
{
|
||||||
|
:$ Works like SysUtils.FindCmdLineSwitch, but uses the specified string
|
||||||
|
:$ instead of the actual command line
|
||||||
|
}
|
||||||
|
function FindCmdLineSwitchEx(const ACmdLine, ASwitch: String;
|
||||||
|
const AIgnoreCase: Boolean): Boolean; overload;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
Messages,
|
||||||
|
Windows;
|
||||||
|
|
||||||
|
const
|
||||||
|
CWindowClass = 'X2UtInstance.Window';
|
||||||
|
CDataCmdLine = $1010;
|
||||||
|
|
||||||
|
var
|
||||||
|
GNotifiers: TInterfaceList;
|
||||||
|
GFileMapping: THandle;
|
||||||
|
GWindow: THandle;
|
||||||
|
|
||||||
|
|
||||||
|
{$WARN SYMBOL_PLATFORM OFF}
|
||||||
|
|
||||||
|
|
||||||
|
// Copied from System unit because Borland didn't make it public
|
||||||
|
function GetParamStr(P: PChar; var Param: string): PChar;
|
||||||
|
var
|
||||||
|
i, Len: Integer;
|
||||||
|
Start, S, Q: PChar;
|
||||||
|
begin
|
||||||
|
while True do
|
||||||
|
begin
|
||||||
|
while (P[0] <> #0) and (P[0] <= ' ') do
|
||||||
|
P := CharNext(P);
|
||||||
|
if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
|
||||||
|
end;
|
||||||
|
Len := 0;
|
||||||
|
Start := P;
|
||||||
|
while P[0] > ' ' do
|
||||||
|
begin
|
||||||
|
if P[0] = '"' then
|
||||||
|
begin
|
||||||
|
P := CharNext(P);
|
||||||
|
while (P[0] <> #0) and (P[0] <> '"') do
|
||||||
|
begin
|
||||||
|
Q := CharNext(P);
|
||||||
|
Inc(Len, Q - P);
|
||||||
|
P := Q;
|
||||||
|
end;
|
||||||
|
if P[0] <> #0 then
|
||||||
|
P := CharNext(P);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Q := CharNext(P);
|
||||||
|
Inc(Len, Q - P);
|
||||||
|
P := Q;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
SetLength(Param, Len);
|
||||||
|
|
||||||
|
P := Start;
|
||||||
|
S := Pointer(Param);
|
||||||
|
i := 0;
|
||||||
|
while P[0] > ' ' do
|
||||||
|
begin
|
||||||
|
if P[0] = '"' then
|
||||||
|
begin
|
||||||
|
P := CharNext(P);
|
||||||
|
while (P[0] <> #0) and (P[0] <> '"') do
|
||||||
|
begin
|
||||||
|
Q := CharNext(P);
|
||||||
|
while P < Q do
|
||||||
|
begin
|
||||||
|
S[i] := P^;
|
||||||
|
Inc(P);
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if P[0] <> #0 then P := CharNext(P);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Q := CharNext(P);
|
||||||
|
while P < Q do
|
||||||
|
begin
|
||||||
|
S[i] := P^;
|
||||||
|
Inc(P);
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := P;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{========================================
|
||||||
|
Window Procedure
|
||||||
|
========================================}
|
||||||
|
function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
|
||||||
|
var
|
||||||
|
sCmdLine: String;
|
||||||
|
iNotifier: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
|
||||||
|
|
||||||
|
case uMsg of
|
||||||
|
WM_COPYDATA:
|
||||||
|
if PCopyDataStruct(lParam)^.dwData = CDataCmdLine then begin
|
||||||
|
with PCopyDataStruct(lParam)^ do
|
||||||
|
SetString(sCmdLine, PChar(lpData), cbData - 1);
|
||||||
|
|
||||||
|
for iNotifier := GNotifiers.Count - 1 downto 0 do
|
||||||
|
IX2InstanceNotifier(GNotifiers[iNotifier]).OnInstance(sCmdLine);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{========================================
|
||||||
|
Single Instance Check
|
||||||
|
========================================}
|
||||||
|
function SingleInstance;
|
||||||
|
var
|
||||||
|
pData: ^THandle;
|
||||||
|
pCopy: TCopyDataStruct;
|
||||||
|
pCmdLine: PChar;
|
||||||
|
sDummy: String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if GFileMapping <> 0 then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
// Attempt to create shared memory
|
||||||
|
GFileMapping := CreateFileMapping($ffffffff, nil, PAGE_READWRITE, 0,
|
||||||
|
SizeOf(THandle), PChar('X2UtInstance.' +
|
||||||
|
AApplicationID));
|
||||||
|
if GFileMapping = 0 then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
if GetLastError() = ERROR_ALREADY_EXISTS then begin
|
||||||
|
if ANotify then begin
|
||||||
|
pData := MapViewOfFile(GFileMapping, FILE_MAP_READ, 0, 0, 0);
|
||||||
|
if Assigned(pData) then begin
|
||||||
|
// Pass command-line parameters
|
||||||
|
with pCopy do begin
|
||||||
|
pCmdLine := PChar('"' + ParamStr(0) + '" ' + GetParamStr(CmdLine, sDummy));
|
||||||
|
|
||||||
|
dwData := CDataCmdLine;
|
||||||
|
cbData := StrLen(pCmdLine) + 1;
|
||||||
|
|
||||||
|
GetMem(lpData, cbData);
|
||||||
|
StrCopy(lpData, pCmdLine);
|
||||||
|
end;
|
||||||
|
|
||||||
|
SendMessage(pData^, WM_COPYDATA, 0, Integer(@pCopy));
|
||||||
|
UnmapViewOfFile(pData);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CloseHandle(GFileMapping);
|
||||||
|
GFileMapping := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pData := MapViewOfFile(GFileMapping, FILE_MAP_WRITE, 0, 0, 0);
|
||||||
|
if Assigned(pData) then begin
|
||||||
|
// Create window
|
||||||
|
GWindow := CreateWindow(CWindowClass, '', 0, 0, 0, 0, 0, 0, 0,
|
||||||
|
SysInit.HInstance, nil);
|
||||||
|
pData^ := GWindow;
|
||||||
|
end else begin
|
||||||
|
CloseHandle(GFileMapping);
|
||||||
|
GFileMapping := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{========================================
|
||||||
|
Notifier Registration
|
||||||
|
========================================}
|
||||||
|
procedure RegisterInstance;
|
||||||
|
begin
|
||||||
|
if GNotifiers.IndexOf(ANotifier) = -1 then
|
||||||
|
GNotifiers.Add(ANotifier);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure UnregisterInstance;
|
||||||
|
var
|
||||||
|
iIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
iIndex := GNotifiers.IndexOf(ANotifier);
|
||||||
|
if iIndex > -1 then
|
||||||
|
GNotifiers.Delete(iIndex);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{========================================
|
||||||
|
Parameter Functions
|
||||||
|
========================================}
|
||||||
|
function ParamCountEx;
|
||||||
|
var
|
||||||
|
pCmdLine: PChar;
|
||||||
|
sParam: String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
pCmdLine := GetParamStr(PChar(ACmdLine), sParam);
|
||||||
|
|
||||||
|
while True do begin
|
||||||
|
pCmdLine := GetParamStr(pCmdLine, sParam);
|
||||||
|
|
||||||
|
if Length(sParam) = 0 then
|
||||||
|
break;
|
||||||
|
|
||||||
|
Inc(Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ParamStrEx;
|
||||||
|
var
|
||||||
|
pCmdLine: PChar;
|
||||||
|
cBuffer: array[0..260] of Char;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
pCmdLine := PChar(ACmdLine);
|
||||||
|
while True do begin
|
||||||
|
pCmdLine := GetParamStr(pCmdLine, Result);
|
||||||
|
|
||||||
|
if (AIndex = 0) or (Length(Result) = 0) then
|
||||||
|
break;
|
||||||
|
|
||||||
|
Dec(AIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FindCmdLineSwitchEx(const ACmdLine, ASwitch: String;
|
||||||
|
const AChars: TSysCharSet;
|
||||||
|
const AIgnoreCase: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
iParam: Integer;
|
||||||
|
sParam: String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for iParam := 1 to ParamCountEx(ACmdLine) do begin
|
||||||
|
sParam := ParamStrEx(ACmdLine, iParam);
|
||||||
|
|
||||||
|
if (AChars = []) or (sParam[1] in AChars) then
|
||||||
|
if AIgnoreCase then begin
|
||||||
|
if (AnsiCompareText(Copy(sParam, 2, Maxint), ASwitch) = 0) then begin
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if (AnsiCompareStr(Copy(sParam, 2, Maxint), ASwitch) = 0) then begin
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FindCmdLineSwitchEx(const ACmdLine, ASwitch: String): Boolean;
|
||||||
|
begin
|
||||||
|
Result := FindCmdLineSwitchEx(ACmdLine, ASwitch, SwitchChars, True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FindCmdLineSwitchEx(const ACmdLine, ASwitch: String;
|
||||||
|
const AIgnoreCase: Boolean): Boolean;
|
||||||
|
begin
|
||||||
|
Result := FindCmdLineSwitchEx(ACmdLine, ASwitch, SwitchChars, AIgnoreCase);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
wndClass: TWndClass;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
GNotifiers := TInterfaceList.Create();
|
||||||
|
|
||||||
|
// Register window class
|
||||||
|
FillChar(wndClass, SizeOf(wndClass), #0);
|
||||||
|
with wndClass do begin
|
||||||
|
lpfnWndProc := @WndProc;
|
||||||
|
hInstance := SysInit.HInstance;
|
||||||
|
lpszClassName := CWindowClass;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Windows.RegisterClass(wndClass);
|
||||||
|
|
||||||
|
finalization
|
||||||
|
FreeAndNil(GNotifiers);
|
||||||
|
|
||||||
|
if GFileMapping <> 0 then
|
||||||
|
// Free file mapping
|
||||||
|
CloseHandle(GFileMapping);
|
||||||
|
|
||||||
|
if GWindow <> 0 then
|
||||||
|
DestroyWindow(GWindow);
|
||||||
|
|
||||||
|
Windows.UnregisterClass(CWindowClass, SysInit.HInstance);
|
||||||
|
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user