Skip to content

Commit ed7868e

Browse files
jkourjkour
committed
Merge branch 'exilon.master' into jkour.master
2 parents fbb37ea + 3fb5b84 commit ed7868e

File tree

40 files changed

+4152
-1788
lines changed

40 files changed

+4152
-1788
lines changed

‎Quick.Commons.pas‎

Lines changed: 49 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
{ ***************************************************************************
22
3-
Copyright (c) 2016-2022 Kike P�rez
3+
Copyright (c) 2016-2024 Kike P�rez
44
55
Unit : Quick.Commons
66
Description : Common functions
77
Author : Kike P�rez
88
Version : 2.0
99
Created : 14/07/2017
10-
Modified : 19/01/2022
10+
Modified : 14/03/2024
1111
1212
This file is part of QuickLib: https://github.com/exilon/QuickLib
1313
@@ -419,6 +419,10 @@ EShellError = class(Exception);
419419
function ArrayToString(aArray : TArray<string>) : string; overload;
420420
//returns a string with separator from array of string
421421
function ArrayToString(aArray : TArray<string>; aSeparator : string) : string; overload;
422+
//returns a string CRLF separated from array of Integer
423+
function ArrayToString(aArray : TArray<Integer>) : string; overload;
424+
//returns a string with separator from array of Integer
425+
function ArrayToString(aArray : TArray<Integer>; aSeparator : string) : string; overload;
422426
//converts TStrings to array
423427
function StringsToArray(aStrings : TStrings) : TArray<string>; overload;
424428
//converts string comma or semicolon separated to array
@@ -1788,6 +1792,49 @@ function ArrayToString(aArray : TArray<string>; aSeparator : string) : string;
17881792
end;
17891793
end;
17901794

1795+
function ArrayToString(aArray : TArray<Integer>) : string;
1796+
var
1797+
value : Integer;
1798+
sb : TStringBuilder;
1799+
begin
1800+
Result := '';
1801+
if High(aArray) < 0 then Exit;
1802+
sb := TStringBuilder.Create;
1803+
try
1804+
for value in aArray do
1805+
begin
1806+
sb.Append(value);
1807+
sb.Append(CRLF);
1808+
end;
1809+
Result := sb.ToString;
1810+
finally
1811+
sb.Free;
1812+
end;
1813+
end;
1814+
1815+
function ArrayToString(aArray : TArray<Integer>; aSeparator : string) : string;
1816+
var
1817+
value : Integer;
1818+
sb : TStringBuilder;
1819+
isfirst : Boolean;
1820+
begin
1821+
Result := '';
1822+
if High(aArray) < 0 then Exit;
1823+
isfirst := True;
1824+
sb := TStringBuilder.Create;
1825+
try
1826+
for value in aArray do
1827+
begin
1828+
if isfirst then isfirst := False
1829+
else sb.Append(aSeparator);
1830+
sb.Append(value);
1831+
end;
1832+
Result := sb.ToString;
1833+
finally
1834+
sb.Free;
1835+
end;
1836+
end;
1837+
17911838
function StringsToArray(aStrings : TStrings) : TArray<string>;
17921839
var
17931840
i : Integer;

‎Quick.Console.pas‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -943,7 +943,7 @@ procedure TConsoleMenu.AddMenu(const cMenuCaption: string; const cMenuKey: Word;
943943
{$IFDEF DELPHIXE7_UP}
944944
fConsoleMenu := fConsoleMenu + [conmenu];
945945
{$ELSE}
946-
SetLength(fConsoleMenu,High(fConsoleMenu)+1);
946+
SetLength(fConsoleMenu,Length(fConsoleMenu)+1);
947947
fConsoleMenu[High(fConsoleMenu)] := conmenu;
948948
{$ENDIF}
949949
end;
@@ -953,7 +953,7 @@ procedure TConsoleMenu.AddMenu(MenuOption: TConsoleMenuOption);
953953
{$IFDEF DELPHIXE7_UP}
954954
fConsoleMenu := fConsoleMenu + [MenuOption];
955955
{$ELSE}
956-
SetLength(fConsoleMenu,High(fConsoleMenu)+1);
956+
SetLength(fConsoleMenu,Length(fConsoleMenu)+1);
957957
fConsoleMenu[High(fConsoleMenu)] := MenuOption;
958958
{$ENDIF}
959959
end;

‎Quick.IOC.pas‎

Lines changed: 70 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -100,6 +100,7 @@ TIocRegistration<T> = record
100100
function GetKey(aPInfo : PTypeInfo; const aName : string = ''): string;
101101
function RegisterType(aTypeInfo : PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration;
102102
function RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration;
103+
procedure Unregister(aTypeInfo : PTypeInfo; const aName : string = '');
103104
end;
104105

105106
TIocRegistrator = class(TInterfacedObject,IIocRegistrator)
@@ -120,13 +121,16 @@ TIocRegistrator = class(TInterfacedObject,IIocRegistrator)
120121
function RegisterInstance<T : class>(const aName : string = '') : TIocRegistration<T>; overload;
121122
function RegisterInstance<TInterface : IInterface>(aInstance : TInterface; const aName : string = '') : TIocRegistration; overload;
122123
function RegisterOptions<T : TOptions>(aOptions : T) : TIocRegistration<T>;
124+
procedure Unregister<TInterface: IInterface>(const aName : string = ''); overload;
125+
procedure Unregister(aTypeInfo : PTypeInfo; const aName : string = ''); overload;
123126
end;
124127

125128
IIocContainer = interface
126129
['{6A486E3C-C5E8-4BE5-8382-7B9BCCFC1BC3}']
127130
function RegisterType(aInterface: PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration;
128131
function RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration;
129132
function Resolve(aServiceType: PTypeInfo; const aName : string = ''): TValue;
133+
procedure Unregister(aTypeInfo : PTypeInfo; const aName : string = '');
130134
procedure Build;
131135
end;
132136

@@ -214,6 +218,8 @@ TIocContainer = class(TInterfacedObject,IIocContainer)
214218
function AbstractFactory<T : class, constructor> : T; overload;
215219
function RegisterTypedFactory<TFactoryInterface : IInterface; TFactoryType : class, constructor>(const aName : string = '') : TIocRegistration<TTypedFactory<TFactoryType>>;
216220
function RegisterSimpleFactory<TInterface : IInterface; TImplementation : class, constructor>(const aName : string = '') : TIocRegistration;
221+
procedure Unregister<TInterface: IInterface>(const aName : string = ''); overload;
222+
procedure Unregister(aInterface: PTypeInfo; const aName : string = ''); overload;
217223
procedure Build;
218224
end;
219225

@@ -223,6 +229,14 @@ TIocServiceLocator = class
223229
class function TryToGetService<T: IInterface>(aService : T) : Boolean;
224230
end;
225231

232+
Name = class(TCustomAttribute)
233+
private
234+
fName: string;
235+
public
236+
constructor Create(aName: string);
237+
property Name: String read fName;
238+
end;
239+
226240
EIocRegisterError = class(Exception);
227241
EIocResolverError = class(Exception);
228242
EIocBuildError = class(Exception);
@@ -367,6 +381,17 @@ function TIocContainer.RegisterType(aInterface: PTypeInfo; aImplementation: TCla
367381
Result := fRegistrator.RegisterType(aInterface,aImplementation,aName);
368382
end;
369383

384+
procedure TIocContainer.Unregister<TInterface>(const aName : string = '');
385+
begin
386+
fRegistrator.Unregister<TInterface>(aName);
387+
end;
388+
389+
procedure TIocContainer.Unregister(aInterface: PTypeInfo; const aName : string = '');
390+
begin
391+
fRegistrator.Unregister(aInterface, aName);
392+
end;
393+
394+
370395
function TIocContainer.RegisterInstance<T>(const aName: string): TIocRegistration<T>;
371396
begin
372397
Result := fRegistrator.RegisterInstance<T>(aName);
@@ -593,6 +618,31 @@ function TIocRegistrator.RegisterType(aTypeInfo : PTypeInfo; aImplementation : T
593618
fDependencyOrder.Add(Result);
594619
end;
595620

621+
procedure TIocRegistrator.Unregister<TInterface>(const aName : string);
622+
begin
623+
Unregister(TypeInfo(TInterface), aName);
624+
end;
625+
626+
procedure TIocRegistrator.Unregister(aTypeInfo : PTypeInfo; const aName : string);
627+
var
628+
key: string;
629+
vValue: TIocRegistration;
630+
begin
631+
key := GetKey(aTypeInfo, aName);
632+
633+
if fDependencies.TryGetValue(key,vValue) then
634+
begin
635+
if (vValue.IntfInfo = aTypeInfo) and (vValue.Name = aName) then
636+
begin
637+
if fDependencyOrder.Contains(vValue) then
638+
fDependencyOrder.Remove(vValue);
639+
fDependencies.Remove(key);
640+
vValue.Free;
641+
end;
642+
end;
643+
644+
end;
645+
596646
{ TIocResolver }
597647

598648
constructor TIocResolver.Create(aRegistrator : TIocRegistrator; aInjector : TIocInjector);
@@ -609,6 +659,8 @@ function TIocResolver.CreateInstance(aClass: TClass): TValue;
609659
rParam : TRttiParameter;
610660
value : TValue;
611661
values : TArray<TValue>;
662+
att: TCustomAttribute;
663+
attname: string;
612664
begin
613665
Result := nil;
614666
rtype := ctx.GetType(aClass);
@@ -627,7 +679,17 @@ function TIocResolver.CreateInstance(aClass: TClass): TValue;
627679
begin
628680
for rParam in rmethod.GetParameters do
629681
begin
630-
value := Resolve(rParam.ParamType.Handle);
682+
attname := EmptyStr;
683+
for att in rParam.GetAttributes do
684+
begin
685+
if att is Name then
686+
begin
687+
attname := Name(att).Name;
688+
Break;
689+
end;
690+
end;
691+
692+
value := Resolve(rParam.ParamType.Handle, attname);
631693
values := values + [value];
632694
end;
633695
Result := rmethod.Invoke(TRttiInstanceType(rtype).MetaclassType,values);
@@ -816,4 +878,11 @@ function TSimpleFactory<TInterface, TImplementation>.New: TInterface;
816878
Result := fResolver.CreateInstance(TClass(TImplementation)).AsType<TInterface>;
817879
end;
818880

881+
{ Name }
882+
constructor Name.Create(aName: string);
883+
begin
884+
fName := aName;
885+
end;
886+
887+
819888
end.

‎Quick.Pooling.pas‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -295,22 +295,22 @@ function TPoolItem<T>._AddRef: Integer;
295295

296296
function TPoolItem<T>._Release: Integer;
297297
begin
298-
fLock.Enter;
299298
{$IFDEF DEBUG_OBJPOOL}
300299
TDebugger.Trace(Self,'Released Pool item');
301300
{$ENDIF}
302301
try
303-
Dec(fRefCount);
304-
Result := fRefCount;
302+
result:=AtomicDecrement(fRefCount);
305303
if Result = 0 then
306304
begin
307305
FreeAndNil(fItem);
306+
// The following is take from TInterfacedObject._Release()
307+
// Mark the refcount field so that any refcounting during destruction doesn't infinitely recurse.
308+
__MarkDestroying(Self);
308309
Destroy;
309310
end
310311
else fLastAccess := Now;
311312
finally
312313
if fRefCount = 1 then fSemaphore.Release;
313-
fLock.Leave;
314314
end;
315315
end;
316316

‎Quick.RTTI.Utils.pas‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,7 @@ class function TRTTI.CreateInstance<T>(const Args: array of TValue): T;
8888
rmethod: TRttiMethod;
8989
rinstype: TRttiInstanceType;
9090
begin
91+
Result := Default(T);
9192
rtype := fCtx.GetType(TypeInfo(T));
9293
for rmethod in rtype.GetMethods do
9394
begin

‎Quick.Threads.pas‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -685,7 +685,7 @@ procedure TThreadedQueueCS<T>.Clear;
685685
try
686686
for obj in FQueue do
687687
begin
688-
if TypeInfo(T) = TypeInfo(TObject) then PObject(@obj){$IFNDEF FPC}.DisposeOf;{$ELSE}.Free;{$ENDIF}
688+
if TypeInfo(T) = TypeInfo(TObject) then PObject(@obj){$ifndef FPC}{$IFDEF DELPHIRX12_UP}.Free{$ELSE}.DisposeOf{$ENDIF}{$ELSE}.Free{$ENDIF};
689689
end;
690690

691691
SetLength(FQueue,0);

‎samples/delphi/QuickAppService/ConsoleAndService/MyServiceConsole.dpr‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ type
2929

3030
procedure TMyService.Execute;
3131
begin
32-
//your code
32+
// your code
3333
end;
3434

3535
var
@@ -61,6 +61,7 @@ begin
6161
AppService.ServiceName := 'MyService';
6262
AppService.DisplayName := 'MyServicesvc';
6363
AppService.DesktopInteraction := False;
64+
AppService.CanInstallWithOtherName := True;
6465
{$IFDEF FPC}
6566
AppService.OnStart := TSrvFactory.CreateMyService;
6667
{$ELSE}

‎samples/delphi/QuickAppService/ConsoleAndService/MyServiceConsole.dproj‎

Lines changed: 33 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
<TargetedPlatforms>1025</TargetedPlatforms>
88
<AppType>Console</AppType>
99
<FrameworkType>None</FrameworkType>
10-
<ProjectVersion>19.1</ProjectVersion>
10+
<ProjectVersion>19.2</ProjectVersion>
1111
<Platform Condition="'$(Platform)'==''">Win32</Platform>
1212
</PropertyGroup>
1313
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
@@ -33,6 +33,11 @@
3333
<CfgParent>Base</CfgParent>
3434
<Base>true</Base>
3535
</PropertyGroup>
36+
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Base)'=='true') or '$(Base_OSX64)'!=''">
37+
<Base_OSX64>true</Base_OSX64>
38+
<CfgParent>Base</CfgParent>
39+
<Base>true</Base>
40+
</PropertyGroup>
3641
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
3742
<Base_Win32>true</Base_Win32>
3843
<CfgParent>Base</CfgParent>
@@ -60,6 +65,12 @@
6065
<Cfg_2>true</Cfg_2>
6166
<Base>true</Base>
6267
</PropertyGroup>
68+
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
69+
<Cfg_2_OSX64>true</Cfg_2_OSX64>
70+
<CfgParent>Cfg_2</CfgParent>
71+
<Cfg_2>true</Cfg_2>
72+
<Base>true</Base>
73+
</PropertyGroup>
6374
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
6475
<Cfg_2_Win32>true</Cfg_2_Win32>
6576
<CfgParent>Cfg_2</CfgParent>
@@ -110,6 +121,7 @@
110121
<Android_NotificationIcon48>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png</Android_NotificationIcon48>
111122
<Android_NotificationIcon72>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png</Android_NotificationIcon72>
112123
<Android_NotificationIcon96>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png</Android_NotificationIcon96>
124+
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
113125
</PropertyGroup>
114126
<PropertyGroup Condition="'$(Base_Android64)'!=''">
115127
<VerInfo_Keys>package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=</VerInfo_Keys>
@@ -137,6 +149,7 @@
137149
<AUP_WRITE_EXTERNAL_STORAGE>true</AUP_WRITE_EXTERNAL_STORAGE>
138150
<AUP_READ_PHONE_STATE>true</AUP_READ_PHONE_STATE>
139151
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar</EnabledSysJars>
152+
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
140153
</PropertyGroup>
141154
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
142155
<iOS_AppStore1024>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png</iOS_AppStore1024>
@@ -153,6 +166,10 @@
153166
<iPhone_Notification40>$(BDS)\bin\Artwork\iOS\iPhone\FM_NotificationIcon_40x40.png</iPhone_Notification40>
154167
<iPad_Notification40>$(BDS)\bin\Artwork\iOS\iPad\FM_NotificationIcon_40x40.png</iPad_Notification40>
155168
</PropertyGroup>
169+
<PropertyGroup Condition="'$(Base_OSX64)'!=''">
170+
<VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSCameraUsageDescription=The reason for accessing the camera;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSMotionUsageDescription=The reason for accessing the accelerometer;NSDesktopFolderUsageDescription=The reason for accessing the Desktop folder;NSDocumentsFolderUsageDescription=The reason for accessing the Documents folder;NSDownloadsFolderUsageDescription=The reason for accessing the Downloads folder;NSNetworkVolumesUsageDescription=The reason for accessing files on a network volume;NSRemovableVolumesUsageDescription=The reason for accessing files on a removable volume;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple&apos;s speech recognition servers</VerInfo_Keys>
171+
<BT_BuildType>Debug</BT_BuildType>
172+
</PropertyGroup>
156173
<PropertyGroup Condition="'$(Base_Win32)'!=''">
157174
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
158175
<BT_BuildType>Debug</BT_BuildType>
@@ -179,10 +196,14 @@
179196
<iPhone_Notification40>$(BDS)\bin\Artwork\iOS\iPhone\FM_NotificationIcon_40x40.png</iPhone_Notification40>
180197
<iPad_Notification40>$(BDS)\bin\Artwork\iOS\iPad\FM_NotificationIcon_40x40.png</iPad_Notification40>
181198
</PropertyGroup>
199+
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
200+
<DCC_RemoteDebug>true</DCC_RemoteDebug>
201+
</PropertyGroup>
182202
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
183203
<VerInfo_Locale>1033</VerInfo_Locale>
184204
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
185205
<Manifest_File>(None)</Manifest_File>
206+
<Debugger_RunParams>prueba /install</Debugger_RunParams>
186207
</PropertyGroup>
187208
<ItemGroup>
188209
<DelphiCompile Include="$(MainSource)">
@@ -226,6 +247,7 @@
226247
<Platform value="Android64">False</Platform>
227248
<Platform value="iOSDevice64">True</Platform>
228249
<Platform value="iOSSimulator">False</Platform>
250+
<Platform value="OSX64">False</Platform>
229251
<Platform value="Win32">True</Platform>
230252
<Platform value="Win64">False</Platform>
231253
</Platforms>
@@ -402,6 +424,16 @@
402424
<Operation>1</Operation>
403425
</Platform>
404426
</DeployClass>
427+
<DeployClass Name="Android_LauncherIcon192">
428+
<Platform Name="Android">
429+
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
430+
<Operation>1</Operation>
431+
</Platform>
432+
<Platform Name="Android64">
433+
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
434+
<Operation>1</Operation>
435+
</Platform>
436+
</DeployClass>
405437
<DeployClass Name="Android_LauncherIcon36">
406438
<Platform Name="Android">
407439
<RemoteDir>res\drawable-ldpi</RemoteDir>

‎samples/delphi/QuickAppService/ConsoleAndService/MyServiceConsole.res‎

51.4 KB
Binary file not shown.

0 commit comments

Comments
 (0)