From 072b845310d8ae1671f38b8f50855d48b1626174 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Mon, 7 Jun 2004 14:37:41 +0000 Subject: [PATCH] Added: Single Instance unit Added: test application --- Test/Forms/FMain.dfm | 81 ++++++++ Test/Forms/FMain.pas | 70 +++++++ Test/X2UtilsTest.cfg | 37 ++++ Test/X2UtilsTest.dof | 160 +++++++++++++++ Test/X2UtilsTest.dpr | 28 +++ X2UtSingleInstance.pas | 427 +++++++++++++++++++++++++++++++++++++++++ 6 files changed, 803 insertions(+) create mode 100644 Test/Forms/FMain.dfm create mode 100644 Test/Forms/FMain.pas create mode 100644 Test/X2UtilsTest.cfg create mode 100644 Test/X2UtilsTest.dof create mode 100644 Test/X2UtilsTest.dpr create mode 100644 X2UtSingleInstance.pas diff --git a/Test/Forms/FMain.dfm b/Test/Forms/FMain.dfm new file mode 100644 index 0000000..9883555 --- /dev/null +++ b/Test/Forms/FMain.dfm @@ -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 = '' + end + object lblAppVersionValue: TLabel + Left = 112 + Top = 36 + Width = 337 + Height = 13 + AutoSize = False + Caption = '' + end + object lblOSVersionValue: TLabel + Left = 112 + Top = 60 + Width = 337 + Height = 13 + AutoSize = False + Caption = '' + 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 diff --git a/Test/Forms/FMain.pas b/Test/Forms/FMain.pas new file mode 100644 index 0000000..1862834 --- /dev/null +++ b/Test/Forms/FMain.pas @@ -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. diff --git a/Test/X2UtilsTest.cfg b/Test/X2UtilsTest.cfg new file mode 100644 index 0000000..17482c8 --- /dev/null +++ b/Test/X2UtilsTest.cfg @@ -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 diff --git a/Test/X2UtilsTest.dof b/Test/X2UtilsTest.dof new file mode 100644 index 0000000..5b234f0 --- /dev/null +++ b/Test/X2UtilsTest.dof @@ -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 diff --git a/Test/X2UtilsTest.dpr b/Test/X2UtilsTest.dpr new file mode 100644 index 0000000..6128ec0 --- /dev/null +++ b/Test/X2UtilsTest.dpr @@ -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. diff --git a/X2UtSingleInstance.pas b/X2UtSingleInstance.pas new file mode 100644 index 0000000..a05f5a8 --- /dev/null +++ b/X2UtSingleInstance.pas @@ -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.