Skip to content

Commit fbb37ea

Browse files
committed
Merge branch 'exilon.master' into jkour.master
2 parents b292148 + 78f1bec commit fbb37ea

File tree

9 files changed

+108
-48
lines changed

9 files changed

+108
-48
lines changed

Delphinus.Info.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,9 @@
66
"license_file": "LICENSE.txt",
77
"platforms": "Win32;Win64;OSX32;Android;IOSDevice32;IOSDevice64;Linux64",
88
"package_compiler_min": 22,
9-
"package_compiler_max": 35,
9+
"package_compiler_max": 36,
1010
"compiler_min": 22,
11-
"compiler_max": 35,
11+
"compiler_max": 36,
1212
"first_version": "1.0",
1313
"report_url": "",
1414
"dependencies":

Quick.AppService.pas

Lines changed: 35 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -96,15 +96,18 @@ TAppService = class
9696
fOnStop : TSvcAnonMethod;
9797
fOnExecute : TSvcAnonMethod;
9898
fAfterRemove : TSvcRemoveEvent;
99+
fServiceDescription : string;
99100
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
100101
procedure Execute;
101102
procedure Help;
102103
procedure DoStop;
104+
procedure SetServiceDescription;
103105
public
104106
constructor Create;
105107
destructor Destroy; override;
106108
property ServiceName : string read fServiceName write fServiceName;
107109
property DisplayName : string read fDisplayName write fDisplayName;
110+
property ServiceDescription : string read fServiceDescription write fServiceDescription;
108111
property LoadOrderGroup : string read fLoadOrderGroup write fLoadOrderGroup;
109112
property Dependencies : string read fDependencies write fDependencies;
110113
property DesktopInteraction : Boolean read fDesktopInteraction write fDesktopInteraction;
@@ -138,6 +141,11 @@ TAppService = class
138141

139142
implementation
140143

144+
{$IFDEF MSWINDOWS}
145+
uses
146+
Registry;
147+
{$ENDIF}
148+
141149
procedure ServiceCtrlHandler(Control: DWORD); stdcall;
142150
begin
143151
case Control of
@@ -242,6 +250,27 @@ procedure TAppService.ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHin
242250
SetServiceStatus(StatusHandle,ServiceStatus);
243251
end;
244252

253+
procedure TAppService.SetServiceDescription;
254+
{$IFDEF MSWINDOWS}
255+
var
256+
reg: TRegistry;
257+
{$ENDIF}
258+
begin
259+
{$IFDEF MSWINDOWS}
260+
reg := TRegistry.Create(KEY_READ or KEY_WRITE);
261+
try
262+
reg.RootKey := HKEY_LOCAL_MACHINE;
263+
if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + fServiceName, False) then
264+
begin
265+
reg.WriteString('Description', fServiceDescription);
266+
reg.CloseKey;
267+
end;
268+
finally
269+
reg.Free;
270+
end;
271+
{$ENDIF}
272+
end;
273+
245274
procedure TAppService.Execute;
246275
begin
247276
//we have to do something or service will stop
@@ -320,7 +349,7 @@ procedure TAppService.Install;
320349
end;
321350
//service interacts with desktop
322351
if fDesktopInteraction then servicetype := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS
323-
else servicetype := SERVICE_WIN32_OWN_PROCESS;
352+
else servicetype := SERVICE_WIN32_OWN_PROCESS;
324353
//service load order
325354
if fLoadOrderGroup.IsEmpty then svcloadgroup := nil
326355
else svcloadgroup := PChar(fLoadOrderGroup);
@@ -333,7 +362,7 @@ procedure TAppService.Install;
333362
//service user password
334363
if fUserPass.IsEmpty then svcuserpass := nil
335364
else svcuserpass := PChar(fUserPass);
336-
365+
337366
fSvHandle := CreateService(fSCMHandle,
338367
PChar(fServiceName),
339368
PChar(fDisplayName),
@@ -348,6 +377,9 @@ procedure TAppService.Install;
348377
svcusername, //user
349378
svcuserpass); //password
350379

380+
if Length(fServiceDescription) > 0 then
381+
SetServiceDescription;
382+
351383
if fSvHandle <> 0 then
352384
begin
353385
if fSilent then Writeln(Format(cInstallMsg,[fServiceName]))
@@ -364,7 +396,7 @@ procedure TAppService.Help;
364396
WriteLn(' [/instance:<service name>]'+#9+'Install service with a custom name');
365397
end
366398
else Writeln(Format('%s [/console] [/install] [/remove] [/h] [/help]',[ExtractFileName(ParamStr(0))]));
367-
WriteLn(' [/console]'+#9#9#9+'Force run as a console application (when runned from another service)');
399+
WriteLn(' [/console]'+#9#9#9+'Force run as a console application (when run from another service)');
368400
WriteLn(' [/install]'+#9#9#9+'Install as a service');
369401
WriteLn(' [/remove]'+#9#9#9+'Remove service');
370402
WriteLn(' [/h /help]'+#9#9#9+'This help');

Quick.AutoMapper.pas

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -373,7 +373,6 @@ destructor TAutoMapper<TClass1, TClass2>.Destroy;
373373

374374
function TAutoMapper<TClass1, TClass2>.Map(aSrcObj: TClass1): TClass2;
375375
var
376-
objvalue : TValue;
377376
obj : TObject;
378377
begin
379378
obj := aSrcObj as TObject;

Quick.Console.pas

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
{ ***************************************************************************
22
3-
Copyright (c) 2016-2021 Kike Pérez
3+
Copyright (c) 2016-2024 Kike Pérez
44
55
Unit : Quick.Console
66
Description : Console output with colors and optional file log
77
Author : Kike Pérez
88
Version : 1.9
99
Created : 10/05/2017
10-
Modified : 05/08/2021
10+
Modified : 20/01/2024
1111
1212
This file is part of QuickLib: https://github.com/exilon/QuickLib
1313
@@ -172,7 +172,7 @@ TConsoleMenu = class
172172
procedure coutSL(const cMsg : string; cColor : TConsoleColor);
173173
procedure cout(const cMsg : string; params : array of const; cEventType : TLogEventType); overload;
174174
procedure coutXY(x,y : Integer; const cMsg : string; cEventType : TLogEventType); overload;
175-
procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); overload;
175+
procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor; cClearLineBefore : Boolean = False); overload;
176176
procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cEventType : TLogEventType); overload;
177177
procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cColor : TConsoleColor); overload;
178178
procedure coutTL(const cMsg : string; cEventType : TLogEventType); overload;
@@ -480,7 +480,7 @@ procedure coutXY(x,y : Integer; const cMsg : string; cEventType : TLogEventType)
480480
end;
481481
end;
482482

483-
procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); overload;
483+
procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor; cClearLineBefore : Boolean = False); overload;
484484
var
485485
NewCoord : TCoord;
486486
LastCoord : TCoord;
@@ -496,7 +496,7 @@ procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); ov
496496
{$ENDIF}
497497
NewCoord.X := x;
498498
NewCoord.Y := y;
499-
ClearLine(Y);
499+
if cClearLineBefore then ClearLine(Y);
500500
SetCursorPos(NewCoord);
501501
try
502502
cout(cMsg,cColor);

Quick.HttpClient.pas

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -147,9 +147,9 @@ function TJsonHttpClient.Get(const aURL : string) : IHttpRequestResponse;
147147
bodycontent : TStringStream;
148148
responsecontent : TStringStream;
149149
begin
150-
bodycontent := TStringStream.Create;
150+
bodycontent := TStringStream.Create('',TEncoding.UTF8);
151151
try
152-
responsecontent := TStringStream.Create;
152+
responsecontent := TStringStream.Create('',TEncoding.UTF8);
153153
try
154154
{$IFDEF DELPHIXE8_UP}
155155
resp := fHTTPClient.Get(aURL,responsecontent,nil);
@@ -185,7 +185,7 @@ function TJsonHttpClient.Post(const aURL, aInContent : string; aHeaders : TPairL
185185
postcontent := TStringStream.Create(Utf8Encode(aInContent));
186186
try
187187
//postcontent.WriteString(aInContent);
188-
responsecontent := TStringStream.Create;
188+
responsecontent := TStringStream.Create('',TEncoding.UTF8);
189189
try
190190
{$IFDEF DELPHIXE8_UP}
191191
if aHeaders <> nil then
@@ -238,7 +238,7 @@ function TJsonHttpClient.Post(const aURL : string; aInContent : TStream) : IHttp
238238
responsecontent : TStringStream;
239239
begin
240240
//postcontent.WriteString(aInContent);
241-
responsecontent := TStringStream.Create;
241+
responsecontent := TStringStream.Create('',TEncoding.UTF8);
242242
try
243243
{$IFDEF DELPHIXE8_UP}
244244
resp := fHTTPClient.Post(aURL,aInContent,responsecontent);
@@ -290,7 +290,7 @@ function TJsonHttpClient.Put(const aURL, aInContent : string) : IHttpRequestResp
290290
postcontent := TStringStream.Create(Utf8Encode(aInContent));
291291
try
292292
//postcontent.WriteString(aInContent);
293-
responsecontent := TStringStream.Create;
293+
responsecontent := TStringStream.Create('',TEncoding.UTF8);
294294
try
295295
{$IFDEF DELPHIXE8_UP}
296296
resp := fHTTPClient.Put(aURL,postcontent,responsecontent);

Quick.MemoryCache.pas

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -500,7 +500,6 @@ procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationMil
500500

501501
procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime);
502502
var
503-
serialized : string;
504503
cacheitem : TCacheEntry;
505504
begin
506505
fLock.BeginWrite;

Quick.YAML.Serializer.pas

Lines changed: 38 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -192,43 +192,52 @@ function TRTTIYaml.DeserializeDynArray(aTypeInfo: PTypeInfo; aObject: TObject; c
192192
TValue.Make(@pArr,aTypeInfo, Result);
193193
rDynArray := ctx.GetType(Result.TypeInfo) as TRTTIDynamicArrayType;
194194

195-
for i := 0 to aYamlArray.Count - 1 do
196-
begin
197-
rItemValue := nil;
198-
case rType.Kind of
199-
tkClass :
200-
begin
201-
if TYamlPair(aYamlArray.Items[i]).Value is TYamlObject then
195+
try
196+
for i := 0 to aYamlArray.Count - 1 do
197+
begin
198+
rItemValue := nil;
199+
case rType.Kind of
200+
tkClass :
202201
begin
203-
Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
204-
propObj := GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
205-
if propObj = nil then
206-
begin
207-
objClass := rType.TypeData.ClassType;
208-
rItemValue := DeserializeClass(objClass,yaml);
209-
end
210-
else
202+
if aYamlArray.Items[i] = nil then raise Exception.Create('Value empty!');
203+
204+
if TYamlPair(aYamlArray.Items[i]).Value is TYamlObject then
211205
begin
212-
DeserializeObject(propObj,yaml);
206+
Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
207+
propObj := GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
208+
if propObj = nil then
209+
begin
210+
objClass := rType.TypeData.ClassType;
211+
rItemValue := DeserializeClass(objClass,yaml);
212+
end
213+
else
214+
begin
215+
DeserializeObject(propObj,yaml);
216+
end;
213217
end;
214218
end;
215-
end;
216-
tkRecord :
219+
tkRecord :
220+
begin
221+
Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
222+
rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
223+
rDynArray.ElementType),aObject,Yaml);
224+
end;
225+
tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
226+
begin
227+
//skip these properties
228+
end
229+
else
217230
begin
218-
Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
219-
rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
220-
rDynArray.ElementType),aObject,Yaml);
231+
rItemValue := DeserializeType(aObject,rType.Kind,rType,aYamlArray.Items[i].Value);
221232
end;
222-
tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
223-
begin
224-
//skip these properties
225-
end
226-
else
227-
begin
228-
rItemValue := DeserializeType(aObject,rType.Kind,rType,aYamlArray.Items[i].Value);
229233
end;
234+
if not rItemValue.IsEmpty then Result.SetArrayElement(i,rItemValue);
235+
end;
236+
except
237+
on E : Exception do
238+
begin
239+
raise Exception.CreateFmt('Array %s item %d error (%s)',[rtype.Name, i, e.Message]);
230240
end;
231-
if not rItemValue.IsEmpty then Result.SetArrayElement(i,rItemValue);
232241
end;
233242
//aProperty.SetValue(aObject,rValue);
234243
finally

QuickLib.inc

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{
22
This file is part of QuickLib: https://github.com/exilon/QuickLib
33
4-
QuickLibs. Copyright (C) 2022 Kike Pérez
4+
QuickLibs. Copyright (C) 2024 Kike Pérez
55
Exilon - https://www.exilon.es
66
77
***************************************************************************
@@ -169,6 +169,26 @@
169169
{$define NEXTGEN} //compatibility with older delphis
170170
{$endif}
171171
{$endif}
172+
{$if CompilerVersion >= 36.0} //Delphi RX12 Athens
173+
{$define DELPHIRX12_UP}
174+
{$define DELPHIATHENS_UP}
175+
{$UNDEF DELPHILINUX}
176+
{$if defined(POSIX)}
177+
{$DEFINE LINUX}
178+
{$if defined(CPUARM)}
179+
{$if defined(MACOS)}
180+
{$ELSE}
181+
{$DEFINE ANDROID}
182+
{$ENDIF}
183+
{$ELSE}
184+
{$DEFINE LINUX}
185+
{$DEFINE DELPHILINUX}
186+
{$ENDIF}
187+
{$ENDIF}
188+
{$if defined(ANDROID) OR defined(IOS)}
189+
{$define NEXTGEN} //compatibility with older delphis
190+
{$endif}
191+
{$endif}
172192
{$else}
173193
//Delphi 5 or older
174194
{$define DELPHI6OROLDER}

README.md

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
![alt text](docs/QuickLib.png "QuickLib")
22

3-
QuickLib is a delphi/Firemonkey(Windows, Linux, Android, OSX & IOS) and fpc(Windows & Linux) library containing interesting and quick to implement functions, created to simplify application development and crossplatform support and improve productivity. Delphi XE8 - Delphi 11 Alexandria supported.
3+
QuickLib is a delphi/Firemonkey(Windows, Linux, Android, OSX & IOS) and fpc(Windows & Linux) library containing interesting and quick to implement functions, created to simplify application development and crossplatform support and improve productivity. Delphi XE8 - Delphi 12 Athens supported.
44

55
## Give it a star
66
Please "star" this project in GitHub! It costs nothing but helps to reference the code.
@@ -74,6 +74,7 @@ If you find this project useful, please consider making a donation.
7474

7575
**Updates:**
7676

77+
* NEW: RAD Studio 12 supported
7778
* NEW: RAD Studio 11 supported
7879
* NEW: Condition checks
7980
* NEW: Commonly used RegEx validations

0 commit comments

Comments
 (0)