Merge branch 'develop'

Quick.Console.pas

@@ -7,7 +7,7 @@
   Author      : Kike Pérez
   Version     : 1.9
   Created     : 10/05/2017
-  Modified    : 29/03/2019
+  Modified    : 22/05/2019
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -213,7 +213,7 @@ type
   {$ENDIF}
   procedure ConsoleWaitForEnterKey;
   {$IFDEF MSWINDOWS}
-  procedure RunConsoleCommand(const aCommand, aParameters : String; CallBack : TOutputProc<PAnsiChar> = nil; OutputLines : TStrings = nil);
+  function RunConsoleCommand(const aCommand, aParameters : String; CallBack : TOutputProc<PAnsiChar> = nil; OutputLines : TStrings = nil) : Cardinal;
   procedure InitConsole;
   {$ENDIF}
 
@@ -566,7 +566,7 @@ begin
   SetConsoleTextAttribute(hStdOut, DefConsoleColor);
   TextAttr := DefConsoleColor;
   {$ELSE}
-  TextColor(DefConsoleColor);
+  TextColor(ccLightGray);
   TextBackground(ccBlack);
   {$ENDIF}
 end;
@@ -795,7 +795,7 @@ end;
 {$ENDIF}
 
 {$IFDEF MSWINDOWS}
-procedure RunConsoleCommand(const aCommand, aParameters : String; CallBack : TOutputProc<PAnsiChar> = nil; OutputLines : TStrings = nil);
+function RunConsoleCommand(const aCommand, aParameters : String; CallBack : TOutputProc<PAnsiChar> = nil; OutputLines : TStrings = nil) : Cardinal;
 const
   CReadBuffer = 2400;
 var
@@ -810,6 +810,7 @@ var
   dRunning: DWORD;
   dAvailable: DWORD;
 begin
+  Result := 0;
   saSecurity.nLength := SizeOf(Windows.TSecurityAttributes);
   saSecurity.bInheritHandle := true;
   saSecurity.lpSecurityDescriptor := nil;
@@ -855,6 +856,7 @@ begin
           CloseHandle(piProcess.hThread);
         end;
       end;
+      GetExitCodeProcess(piProcess.hProcess,Result);
     finally
       CloseHandle(hRead);
       CloseHandle(hWrite);

Quick.Files.pas

@@ -7,7 +7,7 @@
   Author      : Kike Pérez
   Version     : 1.5
   Created     : 09/03/2018
-  Modified    : 16/02/2019
+  Modified    : 23/05/2019
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -125,11 +125,14 @@ type
     class function GetExtension(const Path : string) : string;
     class function ChangeExtension(const Path, NewExtension : string) : string;
     class function GetFileName(const aPath : string) : string;
+    class function EndsWithDelimiter(const aPath : string) : Boolean;
+    class function Combine(const aPath1, aPath2 : string) : string;
   end;
 
   TDirectory = class
   public
     class function Exists(const Path: string; FollowLink: Boolean = True): Boolean;
+    class function GetDirectories(const Path : string) : TArray<string>;
   end;
 
   TFile = class
@@ -355,6 +358,42 @@ begin
   Result := ExtractFileExt(Path);
 end;
 
+class function TPath.EndsWithDelimiter(const aPath : string) : Boolean;
+var
+  c : Char;
+begin
+  if aPath = '' then Exit(False);
+  c := aPath[High(aPath)];
+  Result := (c = '\') or (c = '/');
+end;
+
+class function TPath.Combine(const aPath1, aPath2 : string) : string;
+var
+  delim : string;
+begin
+  delim := '';
+  if aPath1.Contains('/') then delim := '/'
+     else if aPath1.Contains('\') then delim := '\';
+  if delim = '' then
+  begin
+    {$IFDEF LINUX}
+    delim := '/';
+    {$ELSE}
+    delim := '\';
+    {$ENDIF}
+  end;
+  if EndsWithDelimiter(aPath1) then
+  begin
+    if EndsWithDelimiter(aPath2) then Result := aPath1 + Copy(aPath2,2,aPath2.Length)
+      else Result := aPath1 + aPath2;
+  end
+  else
+  begin
+    if EndsWithDelimiter(aPath2) then Result := aPath1 + aPath2
+      else Result := aPath1 + delim + aPath2;
+  end;
+end;
+
 { TDirectory }
 
 class function TDirectory.Exists(const Path: string; FollowLink: Boolean = True): Boolean;
@@ -362,6 +401,20 @@ begin
   Result := DirectoryExists(Path);
 end;
 
+class function TDirectory.GetDirectories(const Path : string) : TArray<string>;
+var
+  rec : TSearchRec;
+begin
+  if FindFirst(TPath.Combine(Path,'*'),faAnyFile and faDirectory,rec) = 0 then
+  repeat
+    if ((rec.Attr and faDirectory) = faDirectory) and (rec.Name <> '.') and (rec.Name <> '..') then
+    begin
+      Result := Result + [rec.Name];
+    end;
+  until FindNext(rec) <> 0;
+  SysUtils.FindClose(rec);
+end;
+
 { TFile }
 
 class function TFile.Exists(const Path : string) : Boolean;

Quick.JSON.Helper.pas

@@ -35,7 +35,7 @@ interface
 
 uses
   Classes,
-  System.SysUtils,
+  SysUtils,
   {$IFDEF DELPHIRX102_UP}
     JSON.Types,
     REST.Json,

Quick.RTTI.Utils.pas

@@ -7,7 +7,7 @@
   Author      : Kike Pérez
   Version     : 1.4
   Created     : 09/03/2018
-  Modified    : 10/05/2019
+  Modified    : 21/05/2019
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -36,6 +36,9 @@ interface
 uses
   SysUtils,
   Quick.Commons,
+  {$IFDEF FPC}
+  TypInfo,
+  {$ENDIF}
   Rtti;
 
 type
@@ -255,7 +258,6 @@ var
   rfield : TRttiField;
   {$ENDIF}
   lastsegment : Boolean;
-  obj : TObject;
 begin
   Result := nil;
   if not Assigned(aInstance) then Exit;
@@ -263,6 +265,9 @@ begin
   lastsegment := False;
   proppath := aPropertyPath;
   rtype := fCtx.GetType(aInstance.ClassType);
+  {$IFDEF FPC}
+  value := aInstance;
+  {$ENDIF}
   repeat
     i := proppath.IndexOf('.');
     if i > -1 then
@@ -289,7 +294,15 @@ begin
     begin
       rprop := rtype.GetProperty(propname);
       if rprop = nil then raise ERTTIError.CreateFmt('Property "%s" not found in object',[propname])
+        {$IFNDEF FPC}
         else value := rprop.GetValue(aInstance);
+        {$ELSE}
+        else
+        begin
+          if rprop.PropertyType.IsInstance then value := GetObjectProp(value.AsObject,propname)
+             else value := rprop.GetValue(value.AsObject);
+        end;
+        {$ENDIF}
     end;
     if not lastsegment then
     begin
@@ -366,7 +379,15 @@ var
   rprop : TRttiProperty;
 begin
   rprop := GetProperty(aInstance,aPropertyName);
-  if rprop <> nil then Result := rprop.GetValue(aInstance);
+  if rprop <> nil then
+  begin
+    {$IFNDEF FPC}
+    Result := rprop.GetValue(aInstance);
+    {$ELSE}
+    if rprop.PropertyType.IsInstance then Result := GetObjectProp(aInstance,aPropertyName)
+      else Result := rprop.GetValue(aInstance);
+    {$ENDIF}
+  end;
 end;
 
 class function TRTTI.GetPropertyValue(aTypeInfo: Pointer; const aPropertyName: string): TValue;
@@ -374,7 +395,15 @@ var
   rprop : TRttiProperty;
 begin
   rprop := GetProperty(aTypeInfo,aPropertyName);
-  if rprop <> nil then Result := rprop.GetValue(aTypeInfo);
+  if rprop <> nil then
+  begin
+    {$IFNDEF FPC}
+    Result := rprop.GetValue(aTypeInfo);
+    {$ELSE}
+    if rprop.PropertyType.IsInstance then Result := GetObjectProp(aTypeInfo,aPropertyName)
+      else Result := rprop.GetValue(aTypeInfo);
+    {$ENDIF}
+  end;
 end;
 
 class function TRTTI.GetType(aTypeInfo: Pointer): TRttiType;

Quick.YAML.Serializer.pas

@@ -271,7 +271,8 @@ begin
               propObj := GetValue(PPByte(rValue.GetReferenceToRawData)^ +GetTypeData(aTypeInfo).elSize * i, GetTypeData(aTypeInfo).ElType2).AsObject;
               if propObj = nil then
               begin
-                objClass := GetTypeData(aTypeInfo).ClassType;
+                //objClass := GetTypeData(aTypeInfo).ClassType;
+                objClass := GetTypeData(GetTypeData(aTypeInfo).ElType2).ClassType;
                 rItemValue := DeserializeClass(objClass,yaml);
               end
               else
@@ -404,8 +405,8 @@ begin
   Result := nil;
   if (aYaml = nil) or ((aYaml as TYamlValue) is TYamlNull) or (aYaml.Count = 0) then Exit;
 
-  Result := aType.Create;
   try
+    Result := aType.Create;
     Result := DeserializeObject(Result,aYaml);
   except
     on E : Exception do

Quick.YAML.pas

@@ -496,7 +496,11 @@ begin
   yaml := TList<string>.Create;
   try
     vIndex := 0;
+    {$IFNDEF LINUX}
     for line in aData.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
+    {$ELSE}
+    for line in aData.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
+    {$ENDIF}
     while yaml.Count > vIndex do
     begin
       yamlvalue := ParseValue(yaml,vIndex);
@@ -518,7 +522,11 @@ begin
   yaml := TList<string>.Create;
   try
     vIndex := 0;
+    {$IFNDEF LINUX}
     for line in aData.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
+    {$ELSE}
+    for line in aData.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
+    {$ENDIF}
     if yaml[0].TrimLeft.StartsWith('- ') then Result := TYamlArray.Create
       else Result := TYamlObject.Create;
     while yaml.Count > vIndex do
@@ -572,6 +580,8 @@ begin
     indent := StringOfChar(' ',aIndent);
     for member in fMembers do
     begin
+      if member = nil then continue;
+
       yvalue := member.Value;
       if yvalue.IsScalar then
       begin

samples/fpc/QuickConfig/ConfigToYAML/lib/i386-win32/umain.lfm

@@ -37,4 +37,13 @@ object Form1: TForm1
     ScrollBars = ssAutoBoth
     TabOrder = 2
   end
+  object Button1: TButton
+    Left = 96
+    Height = 25
+    Top = 424
+    Width = 75
+    Caption = 'Button1'
+    OnClick = Button1Click
+    TabOrder = 3
+  end
 end

samples/fpc/QuickConfig/ConfigToYAML/lib/x86_64-linux/umain.lfm

@@ -0,0 +1,40 @@
+object Form1: TForm1
+  Left = 379
+  Height = 457
+  Top = 208
+  Width = 592
+  Caption = 'Form1'
+  ClientHeight = 457
+  ClientWidth = 592
+  OnClose = FormClose
+  OnCreate = FormCreate
+  LCLVersion = '1.9.0.0'
+  object btnSaveYaml: TButton
+    Left = 448
+    Height = 25
+    Top = 424
+    Width = 120
+    Caption = 'Save to Yaml'
+    OnClick = btnSaveYamlClick
+    TabOrder = 0
+  end
+  object btnLoadYaml: TButton
+    Left = 312
+    Height = 25
+    Top = 424
+    Width = 123
+    Cancel = True
+    Caption = 'Load From Yaml'
+    OnClick = btnLoadYamlClick
+    TabOrder = 1
+  end
+  object meInfo: TMemo
+    Left = 19
+    Height = 407
+    Top = 9
+    Width = 549
+    ReadOnly = True
+    ScrollBars = ssAutoBoth
+    TabOrder = 2
+  end
+end

samples/fpc/QuickConfig/ConfigToYAML/umain.lfm

@@ -37,4 +37,13 @@ object Form1: TForm1
     ScrollBars = ssAutoBoth
     TabOrder = 2
   end
+  object Button1: TButton
+    Left = 96
+    Height = 25
+    Top = 424
+    Width = 75
+    Caption = 'Button1'
+    OnClick = Button1Click
+    TabOrder = 3
+  end
 end

samples/fpc/QuickConfig/ConfigToYAML/umain.pas

@@ -10,6 +10,7 @@ uses
   registry,
   {$ENDIF}
   Quick.Config.Yaml,
+  Quick.Yaml,
   Generics.Collections;
 
 type
@@ -68,7 +69,7 @@ type
     fModifyDate : TDateTime;
     //fWorkList : TObjectList<TWorker>;
   public
-    procedure Init;
+    procedure Init; override;
     destructor Destroy; override;
     procedure DefaultValues; override;
     property Hidden : Boolean read fHidden write fHidden;
@@ -89,9 +90,11 @@ type
   TForm1 = class(TForm)
     btnSaveYaml: TButton;
     btnLoadYaml: TButton;
+    Button1: TButton;
     meInfo: TMemo;
     procedure btnLoadYamlClick(Sender: TObject);
     procedure btnSaveYamlClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure OnConfigFileModified;
@@ -126,6 +129,22 @@ begin
   meInfo.Lines.Add('Saved Config in Yaml at ' + DateTimeToStr(ConfigYaml.LastSaved));
 end;
 
+procedure TForm1.Button1Click(Sender: TObject);
+var
+  yaml : TYamlObject;
+  sl : TStringList;
+begin
+  sl := TStringList.Create;
+  try
+    sl.LoadFromFile('.\Config.yml');
+    yaml := TYamlObject.Create;
+    yaml.ParseYaml(sl.Text);
+    meInfo.Lines.Add(yaml.ToYaml);
+  finally
+    sl.Free;
+  end;
+end;
+
 procedure TForm1.btnLoadYamlClick(Sender: TObject);
 begin
   meInfo.Lines.Add('Load ConfigYaml');