Merge branch 'exilon.master' into jkour.master

Author: jkour

Delphinus.Info.json

@@ -6,9 +6,9 @@
     "license_file": "LICENSE.txt",
     "platforms": "Win32;Win64;OSX32;Android;IOSDevice32;IOSDevice64;Linux64",
     "package_compiler_min": 22,
-    "package_compiler_max": 35,
+    "package_compiler_max": 36,
     "compiler_min": 22,
-    "compiler_max": 35,
+    "compiler_max": 36,
     "first_version": "1.0",
     "report_url": "",
     "dependencies":

Quick.AppService.pas

@@ -96,15 +96,18 @@   TAppService = class
     fOnStop : TSvcAnonMethod;
     fOnExecute : TSvcAnonMethod;
     fAfterRemove : TSvcRemoveEvent;
+    fServiceDescription : string;
     procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
     procedure Execute;
     procedure Help;
     procedure DoStop;
+    procedure SetServiceDescription;
   public
     constructor Create;
     destructor Destroy; override;
     property ServiceName : string read fServiceName write fServiceName;
     property DisplayName : string read fDisplayName write fDisplayName;
+    property ServiceDescription : string read fServiceDescription write fServiceDescription;
     property LoadOrderGroup : string read fLoadOrderGroup write fLoadOrderGroup;
     property Dependencies : string read fDependencies write fDependencies;
     property DesktopInteraction : Boolean read fDesktopInteraction write fDesktopInteraction;
@@ -138,6 +141,11 @@   TAppService = class
 
 implementation
 
+{$IFDEF MSWINDOWS}
+uses
+  Registry;
+{$ENDIF}
+
 procedure ServiceCtrlHandler(Control: DWORD); stdcall;
 begin
   case Control of
@@ -242,6 +250,27 @@ procedure TAppService.ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHin
   SetServiceStatus(StatusHandle,ServiceStatus);
 end;
 
+procedure TAppService.SetServiceDescription;
+{$IFDEF MSWINDOWS}
+var
+  reg: TRegistry;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+  reg := TRegistry.Create(KEY_READ or KEY_WRITE);
+  try
+    reg.RootKey := HKEY_LOCAL_MACHINE;
+    if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + fServiceName, False) then
+    begin
+      reg.WriteString('Description', fServiceDescription);
+      reg.CloseKey;
+    end;
+  finally
+    reg.Free;
+  end;
+{$ENDIF}
+end;
+
 procedure TAppService.Execute;
 begin
   //we have to do something or service will stop
@@ -320,7 +349,7 @@ procedure TAppService.Install;
   end;
   //service interacts with desktop
   if fDesktopInteraction then servicetype := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS
-    else servicetype := SERVICE_WIN32_OWN_PROCESS; 
+    else servicetype := SERVICE_WIN32_OWN_PROCESS;
   //service load order
   if fLoadOrderGroup.IsEmpty then svcloadgroup := nil
     else svcloadgroup := PChar(fLoadOrderGroup);
@@ -333,7 +362,7 @@ procedure TAppService.Install;
   //service user password
   if fUserPass.IsEmpty then svcuserpass := nil
     else svcuserpass := PChar(fUserPass);
-    
+
   fSvHandle := CreateService(fSCMHandle,
                               PChar(fServiceName),
                               PChar(fDisplayName),
@@ -348,6 +377,9 @@ procedure TAppService.Install;
                               svcusername, //user
                               svcuserpass); //password
 
+  if Length(fServiceDescription) > 0 then
+    SetServiceDescription;
+
   if fSvHandle <> 0 then
   begin
     if fSilent then Writeln(Format(cInstallMsg,[fServiceName]))
@@ -364,7 +396,7 @@ procedure TAppService.Help;
     WriteLn(' [/instance:<service name>]'+#9+'Install service with a custom name');
   end
   else Writeln(Format('%s [/console] [/install] [/remove] [/h] [/help]',[ExtractFileName(ParamStr(0))]));
-  WriteLn(' [/console]'+#9#9#9+'Force run as a console application (when runned from another service)');
+  WriteLn(' [/console]'+#9#9#9+'Force run as a console application (when run from another service)');
   WriteLn(' [/install]'+#9#9#9+'Install as a service');
   WriteLn(' [/remove]'+#9#9#9+'Remove service');
   WriteLn(' [/h /help]'+#9#9#9+'This help');

Quick.AutoMapper.pas

@@ -373,7 +373,6 @@ destructor TAutoMapper<TClass1, TClass2>.Destroy;
 
 function TAutoMapper<TClass1, TClass2>.Map(aSrcObj: TClass1): TClass2;
 var
-  objvalue : TValue;
   obj : TObject;
 begin
   obj := aSrcObj as TObject;

Quick.Console.pas

@@ -1,13 +1,13 @@
 { ***************************************************************************
 
-  Copyright (c) 2016-2021 Kike Pérez
+  Copyright (c) 2016-2024 Kike Pérez
 
   Unit        : Quick.Console
   Description : Console output with colors and optional file log
   Author      : Kike Pérez
   Version     : 1.9
   Created     : 10/05/2017
-  Modified    : 05/08/2021
+  Modified    : 20/01/2024
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -172,7 +172,7 @@   TConsoleMenu = class
   procedure coutSL(const cMsg : string; cColor : TConsoleColor);
   procedure cout(const cMsg : string; params : array of const; cEventType : TLogEventType); overload;
   procedure coutXY(x,y : Integer; const cMsg : string; cEventType : TLogEventType); overload;
-  procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); overload;
+  procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor; cClearLineBefore : Boolean = False); overload;
   procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cEventType : TLogEventType); overload;
   procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cColor : TConsoleColor); overload;
   procedure coutTL(const cMsg : string; cEventType : TLogEventType); overload;
@@ -480,7 +480,7 @@ procedure coutXY(x,y : Integer; const cMsg : string; cEventType : TLogEventType)
   end;
 end;
 
-procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); overload;
+procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor; cClearLineBefore : Boolean = False); overload;
 var
  NewCoord : TCoord;
  LastCoord : TCoord;
@@ -496,7 +496,7 @@ procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); ov
   {$ENDIF}
   NewCoord.X := x;
   NewCoord.Y := y;
-  ClearLine(Y);
+  if cClearLineBefore then ClearLine(Y);
   SetCursorPos(NewCoord);
   try
     cout(cMsg,cColor);

Quick.HttpClient.pas

@@ -147,9 +147,9 @@ function TJsonHttpClient.Get(const aURL : string) : IHttpRequestResponse;
   bodycontent : TStringStream;
   responsecontent : TStringStream;
 begin
-  bodycontent := TStringStream.Create;
+  bodycontent := TStringStream.Create('',TEncoding.UTF8);
   try
-    responsecontent := TStringStream.Create;
+    responsecontent := TStringStream.Create('',TEncoding.UTF8);
     try
       {$IFDEF DELPHIXE8_UP}
       resp := fHTTPClient.Get(aURL,responsecontent,nil);
@@ -185,7 +185,7 @@ function TJsonHttpClient.Post(const aURL, aInContent : string; aHeaders : TPairL
   postcontent := TStringStream.Create(Utf8Encode(aInContent));
   try
     //postcontent.WriteString(aInContent);
-    responsecontent := TStringStream.Create;
+    responsecontent := TStringStream.Create('',TEncoding.UTF8);
     try
       {$IFDEF DELPHIXE8_UP}
       if aHeaders <> nil then
@@ -238,7 +238,7 @@ function TJsonHttpClient.Post(const aURL : string; aInContent : TStream) : IHttp
   responsecontent : TStringStream;
 begin
   //postcontent.WriteString(aInContent);
-  responsecontent := TStringStream.Create;
+  responsecontent := TStringStream.Create('',TEncoding.UTF8);
   try
     {$IFDEF DELPHIXE8_UP}
     resp := fHTTPClient.Post(aURL,aInContent,responsecontent);
@@ -290,7 +290,7 @@ function TJsonHttpClient.Put(const aURL, aInContent : string) : IHttpRequestResp
   postcontent := TStringStream.Create(Utf8Encode(aInContent));
   try
     //postcontent.WriteString(aInContent);
-    responsecontent := TStringStream.Create;
+    responsecontent := TStringStream.Create('',TEncoding.UTF8);
     try
       {$IFDEF DELPHIXE8_UP}
       resp := fHTTPClient.Put(aURL,postcontent,responsecontent);

Quick.MemoryCache.pas

@@ -500,7 +500,6 @@ procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationMil
 
 procedure TMemoryCache<T>.SetValue(const aKey: string; aValue: T; aExpirationMilliseconds : Integer; aExpirationDate : TDateTime);
 var
-  serialized : string;
   cacheitem : TCacheEntry;
 begin
   fLock.BeginWrite;

Quick.YAML.Serializer.pas

@@ -192,43 +192,52 @@ function TRTTIYaml.DeserializeDynArray(aTypeInfo: PTypeInfo; aObject: TObject; c
     TValue.Make(@pArr,aTypeInfo, Result);
     rDynArray := ctx.GetType(Result.TypeInfo) as TRTTIDynamicArrayType;
 
-    for i := 0 to aYamlArray.Count - 1 do
-    begin
-      rItemValue := nil;
-      case rType.Kind of
-        tkClass :
-          begin
-            if TYamlPair(aYamlArray.Items[i]).Value is TYamlObject then
+    try
+      for i := 0 to aYamlArray.Count - 1 do
+      begin
+        rItemValue := nil;
+        case rType.Kind of
+          tkClass :
             begin
-              Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
-              propObj := GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
-              if propObj = nil then
-              begin
-                objClass := rType.TypeData.ClassType;
-                rItemValue := DeserializeClass(objClass,yaml);
-              end
-              else
+              if aYamlArray.Items[i] = nil then raise Exception.Create('Value empty!');
+
+              if TYamlPair(aYamlArray.Items[i]).Value is TYamlObject then
               begin
-                DeserializeObject(propObj,yaml);
+                Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
+                propObj := GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
+                if propObj = nil then
+                begin
+                  objClass := rType.TypeData.ClassType;
+                  rItemValue := DeserializeClass(objClass,yaml);
+                end
+                else
+                begin
+                  DeserializeObject(propObj,yaml);
+                end;
               end;
             end;
-          end;
-        tkRecord :
+          tkRecord :
+            begin
+              Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
+              rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
+                                              rDynArray.ElementType),aObject,Yaml);
+            end;
+          tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
+            begin
+              //skip these properties
+            end
+        else
           begin
-            Yaml := TYamlObject(TYamlPair(aYamlArray.Items[i]).value);
-            rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
-                                            rDynArray.ElementType),aObject,Yaml);
+            rItemValue := DeserializeType(aObject,rType.Kind,rType,aYamlArray.Items[i].Value);
           end;
-        tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
-          begin
-            //skip these properties
-          end
-      else
-        begin
-          rItemValue := DeserializeType(aObject,rType.Kind,rType,aYamlArray.Items[i].Value);
         end;
+        if not rItemValue.IsEmpty then Result.SetArrayElement(i,rItemValue);
+      end;
+    except
+      on E : Exception do
+      begin
+        raise Exception.CreateFmt('Array %s item %d error (%s)',[rtype.Name, i, e.Message]);
       end;
-      if not rItemValue.IsEmpty then Result.SetArrayElement(i,rItemValue);
     end;
     //aProperty.SetValue(aObject,rValue);
   finally

QuickLib.inc

@@ -1,7 +1,7 @@
 {
     This file is part of QuickLib: https://github.com/exilon/QuickLib
 
-    QuickLibs. Copyright (C) 2022 Kike Pérez
+    QuickLibs. Copyright (C) 2024 Kike Pérez
       Exilon - https://www.exilon.es
 
      ***************************************************************************
@@ -169,6 +169,26 @@
         {$define NEXTGEN} //compatibility with older delphis
       {$endif}
     {$endif}
+    {$if CompilerVersion >= 36.0} //Delphi RX12 Athens
+      {$define DELPHIRX12_UP}
+	    {$define DELPHIATHENS_UP}
+      {$UNDEF DELPHILINUX}
+      {$if defined(POSIX)}
+        {$DEFINE LINUX}
+        {$if defined(CPUARM)}
+          {$if defined(MACOS)}
+          {$ELSE}
+            {$DEFINE ANDROID}
+          {$ENDIF}
+        {$ELSE}
+          {$DEFINE LINUX}
+          {$DEFINE DELPHILINUX}
+        {$ENDIF}
+      {$ENDIF}
+      {$if defined(ANDROID) OR defined(IOS)}
+        {$define NEXTGEN} //compatibility with older delphis
+      {$endif}
+    {$endif}
   {$else}
     //Delphi 5 or older
     {$define DELPHI6OROLDER}

README.md

@@ -1,6 +1,6 @@
 ![alt text](docs/QuickLib.png "QuickLib") 
 
-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.
+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.
 
 ## Give it a star
 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.
 
 **Updates:**
 
+* NEW: RAD Studio 12 supported
 * NEW: RAD Studio 11 supported
 * NEW: Condition checks
 * NEW: Commonly used RegEx validations