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