Merge branch 'develop'

Quick.HttpClient.pas

@@ -104,6 +104,7 @@ type
     function Get(const aURL : string) : IHttpRequestResponse;
     function Post(const aURL, aInContent : string) : IHttpRequestResponse; overload;
     function Post(const aURL : string; aJsonContent : TJsonObject) : IHttpRequestResponse; overload;
+    function Put(const aURL, aInContent : string) : IHttpRequestResponse;
   end;
 
 implementation
@@ -219,6 +220,48 @@ begin
   {$ENDIF}
 end;
 
+function TJsonHttpClient.Put(const aURL, aInContent : string) : IHttpRequestResponse;
+var
+  {$IFDEF DELPHIXE8_UP}
+  resp : IHTTPResponse;
+  {$ELSE}
+  resp : TIdHTTPResponse;
+  {$ENDIF}
+  responsecontent : TStringStream;
+  postcontent : TStringStream;
+begin
+  postcontent := TStringStream.Create(Utf8Encode(aInContent));
+  try
+    //postcontent.WriteString(aInContent);
+    responsecontent := TStringStream.Create;
+    try
+      {$IFDEF DELPHIXE8_UP}
+      resp := fHTTPClient.Put(aURL,postcontent,responsecontent);
+      {$ELSE}
+        {$IFDEF FPC}
+        try
+           fHTTPClient.Put(aURL,postcontent,responsecontent);
+           fHTTPClient.Disconnect(False);
+        except
+          on E : Exception do
+          begin
+            if e.ClassType <> EIdConnClosedGracefully then raise e;
+          end;
+        end;
+        {$ELSE}
+        fHTTPClient.Post(aURL,postcontent,responsecontent);
+        {$ENDIF}
+      resp := fHTTPClient.Response;
+      {$ENDIF}
+      Result := THttpRequestResponse.Create(resp,responsecontent.DataString);
+    finally
+      responsecontent.Free;
+    end;
+  finally
+    postcontent.Free;
+  end;
+end;
+
 procedure TJsonHttpClient.SetConnectionTimeout(const aValue: Integer);
 begin
   fConnectionTimeout := aValue;

Quick.Json.Serializer.pas

@@ -7,7 +7,7 @@
   Author      : Kike Pérez
   Version     : 1.5
   Created     : 21/05/2018
-  Modified    : 12/02/2019
+  Modified    : 22/02/2019
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -98,6 +98,7 @@ type
   private
     fSerializeLevel : TSerializeLevel;
     fUseEnumNames : Boolean;
+    fUseJsonCaseSense : Boolean;
     function GetValue(aAddr: Pointer; aType: TRTTIType): TValue; overload;
     function GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue; overload;
     function IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
@@ -113,6 +114,7 @@ type
   public
     constructor Create(aSerializeLevel : TSerializeLevel; aUseEnumNames : Boolean = True);
     property UseEnumNames : Boolean read fUseEnumNames write fUseEnumNames;
+    property UseJsonCaseSense : Boolean read fUseJsonCaseSense write fUseJsonCaseSense;
     {$IFNDEF FPC}
     function DeserializeDynArray(aTypeInfo : PTypeInfo; aObject : TObject; const aJsonArray: TJSONArray) : TValue;
     function DeserializeRecord(aRecord : TValue; aObject : TObject; const aJson : TJSONObject) : TValue;
@@ -137,20 +139,24 @@ type
     function Serialize(const aName : string; aValue : TValue) : TJSONPair;
     {$ENDIF}
     function Serialize(aObject : TObject) : TJSONObject; overload;
+    function GetJsonPairByName(aJson : TJSONObject; const aName : string) : TJSONPair;
   end;
 
   TJsonSerializer = class(TInterfacedObject,IJsonSerializer)
   strict private
     fSerializeLevel : TSerializeLevel;
     fUseEnumNames : Boolean;
+    fUseJsonCaseSense : Boolean;
     fRTTIJson : TRTTIJson;
   private
     procedure SetUseEnumNames(const Value: Boolean);
+    procedure SetUseJsonCaseSense(const Value: Boolean);
   public
     constructor Create(aSerializeLevel: TSerializeLevel; aUseEnumNames : Boolean = True);
     destructor Destroy; override;
     property SerializeLevel : TSerializeLevel read fSerializeLevel;
     property UseEnumNames : Boolean read fUseEnumNames write SetUseEnumNames;
+    property UseJsonCaseSense : Boolean read fUseJsonCaseSense write SetUseJsonCaseSense;
     function JsonToObject(aType : TClass; const aJson: string) : TObject; overload;
     function JsonToObject(aObject : TObject; const aJson: string) : TObject; overload;
     function ObjectToJson(aObject : TObject; aIndent : Boolean = False): string;
@@ -315,7 +321,8 @@ begin
     for rField in rRec.GetFields do
     begin
       rValue := nil;
-      member := TJSONPair(aJson.GetValue(rField.Name));
+      //member := TJSONPair(aJson.GetValue(rField.Name));
+      member := GetJsonPairByName(aJson,rField.Name);
       if member <> nil then
       case rField.FieldType.TypeKind of
         tkDynArray :
@@ -387,6 +394,7 @@ constructor TRTTIJson.Create(aSerializeLevel : TSerializeLevel; aUseEnumNames :
 begin
   fSerializeLevel := aSerializeLevel;
   fUseEnumNames := aUseEnumNames;
+  fUseJsonCaseSense := False;
 end;
 
 function TRTTIJson.DeserializeClass(aType: TClass; const aJson: TJSONObject): TObject;
@@ -475,7 +483,8 @@ var
   rProp : TRttiProperty;
 begin
   Result := aObject;
-  member := TJSONPair(aJson.GetValue(aName));
+  member := GetJsonPairByName(aJson,aName);
+  //member := TJSONPair(aJson.GetValue(aName));
 
   rType := ctx.GetType(aObject.ClassInfo);
   try
@@ -538,7 +547,8 @@ begin
     Result := aObject;
     rValue := nil;
     {$IFNDEF FPC}
-     member := TJSONPair(aJson.GetValue(aName));
+     //member := TJSONPair(aJson.GetValue(aName));
+     member := GetJsonPairByName(aJson,aName);
     {$ELSE}
     member := TJsonObject(aJson.Find(aName));
     {$ENDIF}
@@ -806,6 +816,28 @@ begin
   Result := (cname.StartsWith('TObjectList')) or (cname.StartsWith('TList'));
 end;
 
+function TRTTIJson.GetJsonPairByName(aJson: TJSONObject; const aName: string): TJSONPair;
+var
+  candidate : TJSONPair;
+  i : Integer;
+begin
+  if fUseJsonCaseSense then
+  begin
+    Result := TJSONPair(aJson.GetValue(aName));
+    Exit;
+  end
+  else
+  begin
+    for i := 0 to aJson.Count - 1 do
+    begin
+      candidate := aJson.Pairs[I];
+      if CompareText(candidate.JsonString{$IFNDEF FPC}.Value{$ENDIF},aName) = 0 then
+        Exit(TJsonPair(candidate.JsonValue));
+    end;
+  end;
+  Result := nil;
+end;
+
 function TRTTIJson.GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
 var
   pinfo : PPropInfo;
@@ -1396,9 +1428,10 @@ begin
   if aSerializeLevel = TSerializeLevel.slPublicProperty then raise EJsonSerializeError.Create('FreePascal RTTI only supports published properties');
   {$ENDIF}
   fSerializeLevel := aSerializeLevel;
-  fUseEnumNames := True;
+  fUseEnumNames := aUseEnumNames;
+  fUseJsonCaseSense := False;
   fRTTIJson := TRTTIJson.Create(aSerializeLevel,aUseEnumNames);
-  fRTTIJson.UseEnumNames := aUseEnumNames;
+  fRTTIJson.UseJsonCaseSense := fUseJsonCaseSense;
 end;
 
 function TJsonSerializer.JsonToObject(aType: TClass; const aJson: string): TObject;
@@ -1450,6 +1483,12 @@ begin
   if Assigned(fRTTIJson) then fRTTIJson.UseEnumNames := Value;
 end;
 
+procedure TJsonSerializer.SetUseJsonCaseSense(const Value: Boolean);
+begin
+  fUseJsonCaseSense := Value;
+  if Assigned(fRTTIJson) then fRTTIJson.UseJsonCaseSense := Value;
+end;
+
 {$IFNDEF FPC}
 { TCommentProperty }