Merge branch 'develop'

Quick.Json.Serializer.pas

@@ -74,11 +74,12 @@ type
   TJsonSerializer = class(TInterfacedObject,IJsonSerializer)
   strict private
     function GetValue(aAddr: Pointer; aType: TRTTIType): TValue;
+    function IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
     procedure DeserializeDynArray(aProperty : TRttiProperty; aObject : TObject; const aJsonArray: TJSONArray);
     function DeserializeRecord(aRecord : TValue; aObject : TObject; const aJson : TJSONObject) : TValue;
     function DeserializeClass(aType : TClass; const aJson : TJSONObject) : TObject;
     function DeserializeObject(aObject : TObject; const aJson : TJSONObject) : TObject; overload;
-    function DeserializeObject(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject; overload;
+    function DeserializeProperty(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject; overload;
     function DeserializeType(aObject : TObject; aType : TTypeKind; aTypeInfo : PTypeInfo; const aValue: string) : TValue;
     function Serialize(const aName : string; aValue : TValue) : TJSONPair; overload;
     function Serialize(aObject : TObject) : TJSONObject; overload;
@@ -111,6 +112,7 @@ var
   rRec : TRttiRecordType;
   json : TJSONObject;
   rDynArray : TRttiDynamicArrayType;
+  propObj : TObject;
 begin
   if GetTypeData(aProperty.PropertyType.Handle).DynArrElType = nil then Exit;
   len := aJsonArray.Count;
@@ -129,8 +131,16 @@ begin
           begin
             if aJsonArray.Items[i] is TJSONObject then
             begin
-              objClass := rType.TypeData.ClassType;
-              rItemValue := DeserializeClass(objClass, TJSONObject(aJsonArray.Items[i]));
+              propObj := GetValue(PPByte(rValue.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
+              if propObj = nil then
+              begin
+                objClass := rType.TypeData.ClassType;
+                rItemValue := DeserializeClass(objClass, TJSONObject(aJsonArray.Items[i]));
+              end
+              else
+              begin
+                DeserializeObject(propObj,TJSONObject(aJsonArray.Items[i]));
+              end;
             end;
           end;
         tkRecord :
@@ -164,39 +174,59 @@ var
   rField : TRttiField;
   rValue : TValue;
   member : TJSONPair;
+  json : TJSONObject;
+  objClass : TClass;
+  propobj : TObject;
 begin
   rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
-  for rField in rRec.GetFields do
-  begin
-    member := TJSONPair(aJson.GetValue(rField.Name));
-    if member <> nil then
-    case rField.FieldType.TypeKind of
-      tkDynArray :
-        begin
-          {jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
-          try
-            DeserializeDynArray(aProp,Result,jArray);
-          finally
-            jArray.Free;
-          end;}
-        end;
-      tkClass :
+  try
+    for rField in rRec.GetFields do
+    begin
+      rValue := nil;
+      member := TJSONPair(aJson.GetValue(rField.Name));
+      if member <> nil then
+      case rField.FieldType.TypeKind of
+        tkDynArray :
+          begin
+            {jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
+            try
+              DeserializeDynArray(aProp,Result,jArray);
+            finally
+              jArray.Free;
+            end;}
+          end;
+        tkClass :
+          begin
+            //if (member.JsonValue is TJSONObject) then
+            begin
+              propobj := rField.GetValue(@aRecord).AsObject;
+              json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
+              try
+                if propobj = nil then
+                begin
+                  objClass := rField.FieldType.Handle^.TypeData.ClassType;// aProperty.PropertyType.Handle^.TypeData.ClassType;
+                  rValue := DeserializeClass(objClass,json);
+                end
+                else
+                begin
+                  DeserializeObject(propobj,json);
+                end;
+              finally
+                json.Free;
+              end;
+            end
+          end;
+      else
         begin
-          //if (member.JsonValue is TJSONObject) then
-          {begin
-            objClass := aProp.PropertyType.Handle^.TypeData.ClassType;
-            rValue := DeserializeClass(objClass, TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject);
-            //aProp.SetValue(Result, rValue);
-          end;}
+          rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.JsonString.ToString);
         end;
-    else
-      begin
-        rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.JsonString.ToString);
       end;
+      if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
     end;
-    if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
+    Result := aRecord;
+  finally
+    ctx.Free;
   end;
-  Result := aRecord;
 end;
 
 function TJsonSerializer.JsonToObject(aObject: TObject; const aJson: string): TObject;
@@ -256,37 +286,26 @@ var
   rProp: TRttiProperty;
   attr: TCustomAttribute;
   rValue: TValue;
-  NotSerializable: Boolean;
   propertyname : string;
 begin
   Result := aObject;
 
   if (aJson.Count = 0) or (Result = nil) then Exit;
-
-  NotSerializable := True;
-
   try
     rType := ctx.GetType(aObject.ClassInfo);
     try
       for rProp in rType.GetProperties do
       begin
-        if (rProp.PropertyType.IsPublicType) and (rProp.Name <> 'RefCount') then
+        if (rProp.PropertyType.IsPublicType) and (rProp.IsWritable) and (IsAllowedProperty(aObject,rProp.Name)) then
         begin
           propertyname := rProp.Name;
           for attr in rProp.GetAttributes do if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
-
-          rValue := DeserializeObject(Result, propertyname, rProp, aJson);
+          Result := DeserializeProperty(Result, propertyname, rProp, aJson);
         end;
-        NotSerializable := False;
       end;
     finally
       ctx.Free;
     end;
-
-    if NotSerializable then
-    begin
-      raise EJsonSerializeError.Create(cNotSerializable);
-    end;
   except
     Result.Free;
     raise;
@@ -294,7 +313,7 @@ begin
 end;
 
 
-function TJsonSerializer.DeserializeObject(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject;
+function TJsonSerializer.DeserializeProperty(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject;
 var
   rType : PTypeInfo;
   ctx : TRttiContext;
@@ -325,8 +344,21 @@ begin
           begin
             //if (member.JsonValue is TJSONObject) then
             begin
-              objClass := aProperty.PropertyType.Handle^.TypeData.ClassType;
-              rValue := DeserializeClass(objClass, TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject);
+              json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
+              try
+                if aProperty.GetValue(aObject).AsObject = nil then
+                begin
+                  objClass := aProperty.PropertyType.Handle^.TypeData.ClassType;
+                  rValue := DeserializeClass(objClass,json)
+                end
+                else
+                begin
+                  rValue := DeserializeObject(aProperty.GetValue(aObject).AsObject,json);
+                  Exit;
+                end;
+              finally
+                json.Free;
+              end;
             end
           end;
         tkRecord :
@@ -412,13 +444,26 @@ begin
   end;
 end;
 
+function TJsonSerializer.IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
+var
+  propname : string;
+begin
+  Result := True;
+  propname := aPropertyName.ToLower;
+
+  if (aObject.ClassName.StartsWith('TObjectList')) then
+  begin
+    if (propname = 'capacity') or (propname = 'count') or (propname = 'ownsobjects') then Result := False;
+  end
+  else if (propname = 'refcount') then Result := False;
+end;
+
 function TJsonSerializer.Serialize(aObject: TObject): TJSONObject;
 var
   ctx: TRttiContext;
   attr : TCustomAttribute;
   rType: TRttiType;
   rProp: TRttiProperty;
-  NotSerializable: Boolean;
   jpair : TJSONPair;
   ExcludeSerialize : Boolean;
   comment : string;
@@ -430,8 +475,6 @@ begin
     Exit;
   end;
 
-  NotSerializable := True;
-
   Result := TJSONObject.Create;
   try
     rType := ctx.GetType(aObject.ClassInfo);
@@ -448,8 +491,7 @@ begin
           else if attr is TCommentProperty then comment := TCommentProperty(attr).Comment
           else if  attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
         end;
-
-        if (rProp.PropertyType.IsPublicType) and (rProp.Name <> 'RefCount') and (not ExcludeSerialize) then
+        if (rProp.PropertyType.IsPublicType) and (IsAllowedProperty(aObject,propertyname)) and (not ExcludeSerialize) then
         begin
           //add comment as pair
           if comment <> '' then Result.AddPair(TJSONPair.Create('#Comment#->'+propertyname,Comment));
@@ -461,16 +503,10 @@ begin
           //Result.AddPair(Serialize(rProp.Name,rProp.GetValue(aObject)));
           //s := Result.ToJSON;
         end;
-        NotSerializable := False;
       end;
     finally
       ctx.Free;
     end;
-
-    if NotSerializable then
-    begin
-      raise EJsonSerializeError.Create(cNotSerializable);
-    end;
   except
     Result.Free;
     raise;
@@ -620,3 +656,4 @@ end;
 
 end.
 
+

Quick.SMTP.pas

@@ -5,9 +5,9 @@
   Unit        : Quick.SMTP
   Description : Send Emails
   Author      : Kike Pérez
-  Version     : 1.2
+  Version     : 1.4
   Created     : 12/10/2017
-  Modified    : 07/04/2018
+  Modified    : 19/06/2018
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -88,7 +88,8 @@ type
     property UseSSL: Boolean read fUseSSL write fUseSSL;
     property Mail : TMailMessage read fMail write fMail;
     function SendMail: Boolean; overload;
-    function SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean; overload;
+    function SendMail(aMail : TMailMessage) : Boolean; overload;
+    function SendEmail(const aFromName,aSubject,aTo,aCC,aBC,aBody : string) : Boolean; overload;
   end;
 
 implementation
@@ -147,18 +148,31 @@ begin
   inherited;
 end;
 
-function TSMTP.SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean;
+function TSMTP.SendEmail(const aFromName,aSubject,aTo,aCC,aBC,aBody : string) : Boolean;
+var
+  mail : TMailMessage;
 begin
-  fMail.From := cFrom;
-  fMail.Subject := cSubject;
-  fMail.Body := cBody;
-  fMail.Recipient := cTo;
-  fMail.CC := '';
-  fMail.BCC := '';
-  Result := Self.SendMail;
+  mail := TMailMessage.Create;
+  try
+    Mail.From := fMail.fFrom;
+    Mail.SenderName := aFromName;
+    Mail.Subject := aSubject;
+    Mail.Body := aBody;
+    Mail.Recipient := aTo;
+    Mail.CC := aCC;
+    Mail.BCC := aBC;
+    Result := Self.SendMail(mail);
+  finally
+    mail.Free;
+  end;
 end;
 
 function TSMTP.SendMail: Boolean;
+begin
+  Result := SendMail(fMail);
+end;
+
+function TSMTP.SendMail(aMail : TMailMessage) : Boolean;
 var
   msg : TIdMessage;
   SSLHandler : TIdSSLIOHandlerSocketOpenSSL;
@@ -175,26 +189,26 @@ begin
       //create mail msg
       idattach := nil;
       mBody := nil;
-      msg.From.Address := fMail.From;
-      if fMail.SenderName <> '' then msg.From.Name := fMail.SenderName;
-      msg.Subject := fMail.Subject;
-      for email in fMail.Recipient.Split([',']) do msg.Recipients.Add.Address := email;
-      for email in fMail.CC.Split([',']) do msg.CCList.Add.Address := email;
-      for email in fMail.BCC.Split([',']) do msg.BCCList.Add.Address := email;
-      if fMail.fBodyFromFile then
+      msg.From.Address := aMail.From;
+      if aMail.SenderName <> '' then msg.From.Name := aMail.SenderName;
+      msg.Subject := aMail.Subject;
+      for email in aMail.Recipient.Split([',']) do msg.Recipients.Add.Address := email;
+      for email in aMail.CC.Split([',']) do msg.CCList.Add.Address := email;
+      for email in aMail.BCC.Split([',']) do msg.BCCList.Add.Address := email;
+      if aMail.fBodyFromFile then
       begin
-        msg.Body.LoadFromFile(fMail.Body);
+        msg.Body.LoadFromFile(aMail.Body);
       end
       else
       begin
         mBody := TIdText.Create(msg.MessageParts);
         mBody.ContentType := 'text/html';
-        mBody.Body.Text := fMail.Body;
+        mBody.Body.Text := aMail.Body;
       end;
       //add attachements if exists
-      if fMail.Attachments.Count > 0 then
+      if aMail.Attachments.Count > 0 then
       begin
-        for filename in fMail.Attachments do
+        for filename in aMail.Attachments do
         begin
           idattach := TIdAttachmentFile.Create(msg.MessageParts,filename);
         end;