Veronique 2 kuukautta sitten
commit
d2bdc03f2b

+ 43 - 0
.gitignore

@@ -0,0 +1,43 @@
+target/
+!.mvn/wrapper/maven-wrapper.jar
+!**/src/main/**/target/
+!**/src/test/**/target/
+
+### IntelliJ IDEA ###
+.idea/modules.xml
+.idea/jarRepositories.xml
+.idea/compiler.xml
+.idea/libraries/
+*.iws
+*.iml
+*.ipr
+.idea/*
+
+### Eclipse ###
+.apt_generated
+.classpath
+.factorypath
+.project
+.settings
+.springBeans
+.sts4-cache
+
+### NetBeans ###
+/nbproject/private/
+/nbbuild/
+/dist/
+/nbdist/
+/.nb-gradle/
+build/
+!**/src/main/**/build/
+!**/src/test/**/build/
+
+### VS Code ###
+.vscode/
+
+### Mac OS ###
+.DS_Store
+
+/logs/
+/erpfiles/
+/Win64/

+ 274 - 0
Neon.Core.Attributes.pas

@@ -0,0 +1,274 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.Attributes;
+
+interface
+
+{$SCOPEDENUMS ON}
+
+uses
+  System.Classes, System.SysUtils, System.Rtti,
+  Neon.Core.Types;
+
+type
+  NeonAttribute = class(TCustomAttribute)
+  end;
+
+  NeonNamedAttribute = class(NeonAttribute)
+  private
+    FValue: string;
+  public
+    constructor Create(const AValue: string);
+    property Value: string read FValue write FValue;
+  end;
+
+  /// <summary>
+  ///   The attribute [NeonProperty] is used to indicate the property name in JSON.
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonPropertyAttribute = class(NeonNamedAttribute);
+
+  /// <summary>
+  ///   The attribute [NeonEnum] is used to indicate the names of an enum
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonEnumNamesAttribute = class(TCustomAttribute)
+  private
+    FNames: TArray<string>;
+  public
+    constructor Create(const ANames: string);
+    property Names: TArray<string> read FNames write FNames;
+  end;
+
+  /// <summary>
+  ///   The Neon attribute [NeonIgnore] is used to tell Neon to ignore a certain property (field)
+  ///   of a Delphi object. The property is ignored both when reading JSON into Delphi objects, and
+  ///   when writing Delphi objects into JSON.
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonIgnoreAttribute = class(NeonAttribute);
+
+  /// <summary>
+  ///   The Neon annotation NeonInclude tells Neon to include the property (or field)
+  ///   based on the value
+  /// </summary>
+  /// <remarks>
+  ///   Write Attribute
+  /// </remarks>
+  IncludeIf = (
+    /// <summary>
+    ///   Include the member if it's not nil
+    /// </summary>
+    NotNull,
+    /// <summary>
+    ///   Include the member if the value it's not empty
+    /// </summary>
+    NotEmpty,
+    /// <summary>
+    ///   Include the member if it's value it's not the default value
+    /// </summary>
+    NotDefault,
+    /// <summary>
+    ///   Include the member always
+    /// </summary>
+    Always,
+    /// <summary>
+    ///   Include the member based on the result of the function specified as string
+    ///   (default function is ShouldInclude)
+    /// </summary>
+    CustomFunction);
+  TIncludeValue = record
+    Present: Boolean;
+    Value: IncludeIf;
+    IncludeFunction: string;
+  end;
+
+  /// <summary>
+  ///   The Neon annotation NeonInclude tells Neon to include the property (or field)
+  ///   based on the value of the enumeration Include
+  /// </summary>
+  NeonIncludeAttribute = class(TCustomAttribute)
+  private
+    FIncludeValue: TIncludeValue;
+  public
+    constructor Create(AIncludeValue: IncludeIf = IncludeIf.Always; const AIncludeFunction: string = 'ShouldInclude');
+
+    property IncludeValue: TIncludeValue read FIncludeValue write FIncludeValue;
+  end;
+
+  /// <summary>
+  ///   The NeonIgnoreProperties Neon annotation is used to specify a list of properties
+  ///   of a class to ignore. The NeonIgnoreProperties annotation is placed above the
+  ///   class declaration instead of above the individual properties (fields) to ignore.
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonIgnorePropertiesAttribute = class(NeonAttribute);
+
+  /// <summary>
+  ///   The NeonIgnoreType Neon annotation is used to mark a whole type (class) to be
+  ///   ignored everywhere that type is used.
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonIgnoreTypeAttribute = class(NeonAttribute);
+
+  /// <summary>
+  ///   The Neon attribute NeonMembers is used to tell Neon to change the Members
+  ///   when reading/writing a specific record/object
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonMembersSetAttribute = class(NeonAttribute)
+  private
+    FValue: TNeonMembersSet;
+  public
+    constructor Create(const AValue: TNeonMembersSet);
+    property Value: TNeonMembersSet read FValue write FValue;
+  end;
+
+  /// <summary>
+  ///   The Neon attribute NeonVisibilityAttribute is used to tell Neon to change the Visibility
+  ///   when reading/writing a specific record/object
+  /// </summary>
+  /// <remarks>
+  ///   Read + Write Attribute
+  /// </remarks>
+  NeonVisibilityAttribute = class(NeonAttribute)
+  private
+    FValue: TNeonVisibility;
+  public
+    constructor Create(const AValue: TNeonVisibility);
+    property Value: TNeonVisibility read FValue write FValue;
+  end;
+
+  /// <summary>
+  ///   The NeonSerialize Neon annotation is used to specify a custom serializer for a
+  ///   field in a Delphi object.
+  /// </summary>
+  NeonSerializeAttribute = class(NeonAttribute)
+  private
+    FClazz: TClass;
+    FName: string;
+  public
+    constructor Create(const AClass: TClass); overload;
+    constructor Create(const AName: string); overload;
+    property Clazz: TClass read FClazz write FClazz;
+    property Name: string read FName write FName;
+  end;
+
+  /// <summary>
+  ///   The Neon annotation NeonDeserialize is used to specify a custom de-serializer
+  ///   class for a given field in a Delphi object.
+  /// </summary>
+  NeonDeserializeAttribute = class(NeonSerializeAttribute);
+
+  /// <summary>
+  ///   The Neon annotation NeonValue tells Neon that Neon should not attempt to
+  ///   serialize the object itself, but rather call a method on the object which
+  ///   serializes the object to a TJSONValue.
+  /// </summary>
+  NeonValueAttribute = class(NeonAttribute);
+  NeonMethodAttribute = class(NeonAttribute);
+  NeonSerializerMethodAttribute = class(NeonAttribute);
+
+  /// <summary>
+  ///   The NeonRawValue annotation tells Neon that this property value should written
+  ///   directly as it is to the JSON output. If the property is a String Neon would
+  ///   normally have enclosed the value in quotation marks, but if annotated with the
+  ///   NeonRawValue property Neon won't do that.
+  /// </summary>
+  NeonRawValueAttribute = class(NeonAttribute);
+
+  {
+  //Read Annotations
+  NeonSetterAttribute = class(NeonAttribute);
+  NeonAnySetterAttribute = class(NeonAttribute);
+  NeonCreatorAttribute = class(NeonAttribute);
+  NeonInjectAttribute = class(NeonAttribute);
+  //Write Annotations
+  NeonGetterAttribute = class(NeonAttribute);
+  NeonAnyGetterAttribute = class(NeonAttribute);
+  }
+
+implementation
+
+uses
+  System.StrUtils, System.DateUtils;
+
+{ NeonNamedAttribute }
+
+constructor NeonNamedAttribute.Create(const AValue: string);
+begin
+  FValue := AValue;
+end;
+
+{ NeonMembersTypeAttribute }
+
+constructor NeonMembersSetAttribute.Create(const AValue: TNeonMembersSet);
+begin
+  FValue := AValue;
+end;
+
+{ NeonVisibilityAttribute }
+
+constructor NeonVisibilityAttribute.Create(const AValue: TNeonVisibility);
+begin
+  FValue := AValue;
+end;
+
+constructor NeonSerializeAttribute.Create(const AClass: TClass);
+begin
+  FClazz := AClass;
+end;
+
+constructor NeonSerializeAttribute.Create(const AName: string);
+begin
+  FName := AName;
+end;
+
+{ NeonIncludeAttribute }
+
+constructor NeonIncludeAttribute.Create(AIncludeValue: IncludeIf; const AIncludeFunction: string);
+begin
+  FIncludeValue.Present := True;
+  FIncludeValue.Value := AIncludeValue;
+  FIncludeValue.IncludeFunction := AIncludeFunction;
+end;
+
+{ NeonEnumNamesAttribute }
+
+constructor NeonEnumNamesAttribute.Create(const ANames: string);
+begin
+  FNames := ANames.Split([',']);
+end;
+
+end.

+ 640 - 0
Neon.Core.DynamicTypes.pas

@@ -0,0 +1,640 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.DynamicTypes;
+
+interface
+
+uses
+  System.Classes, System.SysUtils, System.Rtti, System.TypInfo,
+  System.Generics.Collections;
+
+type
+  IDynamicType = interface
+  ['{DD163E75-134C-4035-809C-D9E1EEEC4225}']
+  end;
+
+  IDynamicStream = interface(IDynamicType)
+  ['{968D03E7-273F-4E94-A3EA-ECB7A73F0715}']
+    procedure LoadFromStream(AStream: TStream);
+    procedure SaveToStream(AStream: TStream);
+  end;
+
+  IDynamicList = interface(IDynamicType)
+  ['{9F4A2D72-078B-4EA2-B86E-068206AD0F16}']
+    function NewItem: TValue;
+    function GetItemType: TRttiType;
+    procedure Add(AItem: TValue);
+    procedure Clear;
+    function Count: Integer;
+    // Enumerator functions
+    function Current: TValue;
+    function MoveNext: Boolean;
+  end;
+
+  IDynamicMap = interface(IDynamicType)
+  ['{89E60A06-C1A9-4D70-83B8-85D9B29510DB}']
+    function NewKey: TValue;
+    function NewValue: TValue;
+    function GetKeyType: TRttiType;
+    function GetValueType: TRttiType;
+    procedure Add(const AKey, AValue: TValue);
+    procedure Clear;
+    function Count: Integer;
+    // Enumerator functions
+    function CurrentKey: TValue;
+    function CurrentValue: TValue;
+    function MoveNext: Boolean;
+    // Key-related functions
+    function KeyIsString: Boolean;
+    function KeyToString(const AKey: TValue): string;
+    procedure KeyFromString(const AKey: TValue; const AStringVal: string);
+  end;
+
+  IDynamicNullable = interface(IDynamicType)
+  ['{B1F7F5F0-223B-4ADF-9845-40278D57F62C}']
+    function HasValue: Boolean;
+    function GetValue: TValue;
+    function GetValueType: PTypeInfo;
+    procedure SetValue(const AValue: TValue);
+  end;
+
+  TDynamicStream = class(TInterfacedObject, IDynamicStream)
+  private
+    FInstance: TObject;
+    FLoadMethod: TRttiMethod;
+    FSaveMethod: TRttiMethod;
+    constructor Create(AInstance: TObject; ALoadMethod, ASaveMethod: TRttiMethod);
+  public
+    class function GuessType(AInstance: TObject): IDynamicStream;
+  public
+    procedure LoadFromStream(AStream: TStream);
+    procedure SaveToStream(AStream: TStream);
+  end;
+
+  TDynamicList = class(TInterfacedObject, IDynamicList)
+  private
+    FInstance: TObject;
+    FEnumInstance: TObject;
+    FItemType: TRttiType;
+    FAddMethod: TRttiMethod;
+    FClearMethod: TRttiMethod;
+    FMoveNextMethod: TRttiMethod;
+    FCurrentProperty: TRttiProperty;
+    FCountProperty: TRttiProperty;
+    constructor Create(AInstance, AEnumInstance: TObject; AItemType: TRttiType;
+      AAddMethod, AClearMethod, AMoveNextMethod: TRttiMethod;
+      ACurrentProperty, ACountProperty: TRttiProperty);
+  public
+    destructor Destroy; override;
+    class function GuessType(AInstance: TObject): IDynamicList;
+  public
+    function NewItem: TValue;
+    function GetItemType: TRttiType;
+    procedure Add(AItem: TValue);
+    procedure Clear;
+    function Count: Integer;
+    // Enumerator functions
+    function Current: TValue;
+    function MoveNext: Boolean;
+  end;
+
+  TDynamicMap = class(TInterfacedObject, IDynamicMap)
+  public type
+    TEnumerator = class
+    private
+      const CURRENT_PROP = 'Current';
+      const MOVENEXT_METH = 'MoveNext';
+    private
+      FInstance: TObject;
+      FMoveNextMethod: TRttiMethod;
+      FCurrentProperty: TRttiProperty;
+    public
+      constructor Create(AMethod: TRttiMethod; AInstance: TObject);
+      destructor Destroy; override;
+    public
+      function Current: TValue;
+      function MoveNext: Boolean;
+    end;
+  private
+    FInstance: TObject;
+    FKeyType: TRttiType;
+    FValueType: TRttiType;
+    FAddMethod: TRttiMethod;
+    FClearMethod: TRttiMethod;
+    FKeyEnum: TDynamicMap.TEnumerator;
+    FValueEnum: TDynamicMap.TEnumerator;
+    FCountProp: TRttiProperty;
+    FToStringMethod: TRttiMethod;
+    FFromStringMethod: TRttiMethod;
+
+    constructor Create(AInstance: TObject; AKeyType, AValueType: TRttiType;
+      AAddMethod, AClearMethod: TRttiMethod; ACountProp: TRttiProperty;
+      AKeyEnum, AValueEnum: TDynamicMap.TEnumerator; AToStringMethod, AFromStringMethod: TRttiMethod);
+  public
+    class function GuessType(AInstance: TObject): IDynamicMap;
+    destructor Destroy; override;
+  public
+    function NewKey: TValue;
+    function NewValue: TValue;
+    function GetKeyType: TRttiType;
+    function GetValueType: TRttiType;
+    procedure Add(const AKey, AValue: TValue);
+    procedure Clear;
+    function Count: Integer;
+    // Enumerator functions
+    function CurrentKey: TValue;
+    function CurrentValue: TValue;
+    function MoveNext: Boolean;
+    // Key-related functions
+    function KeyIsString: Boolean;
+    function KeyToString(const AKey: TValue): string;
+    procedure KeyFromString(const AKey: TValue; const AStringVal: string);
+  end;
+
+  TDynamicNullable = class(TInterfacedObject, IDynamicNullable)
+  private
+    FInstance: TValue;
+    FTypeInfoMethod: TRttiMethod;
+    FHasValueMethod: TRttiMethod;
+    FGetValueMethod: TRttiMethod;
+    FSetValueMethod: TRttiMethod;
+    constructor Create(AInstance: TValue; ATypeInfoMethod, AHasValueMethod, AGetValueMethod, ASetValueMethod: TRttiMethod);
+  public
+    class function GuessType(AInstance: TValue): IDynamicNullable;
+
+    // Interface IDynamicNullable
+    function HasValue: Boolean;
+    function GetValue: TValue;
+    function GetValueType: PTypeInfo;
+    procedure SetValue(const AValue: TValue);
+  end;
+
+
+implementation
+
+uses
+  Neon.Core.Types,
+  Neon.Core.Utils;
+
+{ TDynamicStream }
+
+constructor TDynamicStream.Create(AInstance: TObject; ALoadMethod, ASaveMethod: TRttiMethod);
+begin
+  FInstance := AInstance;
+  FLoadMethod := ALoadMethod;
+  FSaveMethod := ASaveMethod;
+end;
+
+class function TDynamicStream.GuessType(AInstance: TObject): IDynamicStream;
+var
+  LType: TRttiType;
+  LLoadMethod, LSaveMethod: TRttiMethod;
+begin
+  if not Assigned(AInstance) then
+    Exit(nil);
+
+  LType := TRttiUtils.Context.GetType(AInstance.ClassType);
+
+  if not Assigned(LType) then
+    Exit(nil);
+
+  LLoadMethod := LType.GetMethod('LoadFromStream');
+  if not Assigned(LLoadMethod) then
+    Exit(nil);
+
+  LSaveMethod := LType.GetMethod('SaveToStream');
+  if not Assigned(LSaveMethod) then
+    Exit(nil);
+
+  Result := Self.Create(AInstance, LLoadMethod, LSaveMethod);
+end;
+
+procedure TDynamicStream.LoadFromStream(AStream: TStream);
+begin
+  FLoadMethod.Invoke(FInstance, [AStream]);
+end;
+
+procedure TDynamicStream.SaveToStream(AStream: TStream);
+begin
+  FSaveMethod.Invoke(FInstance, [AStream]);
+end;
+
+{ TDynamicList }
+
+procedure TDynamicList.Add(AItem: TValue);
+begin
+  FAddMethod.Invoke(FInstance, [AItem]);
+end;
+
+procedure TDynamicList.Clear;
+begin
+  FClearMethod.Invoke(FInstance, []);
+end;
+
+function TDynamicList.Count: Integer;
+begin
+  Result := FCountProperty.GetValue(FInstance).AsInteger;
+end;
+
+constructor TDynamicList.Create(AInstance, AEnumInstance: TObject; AItemType: TRttiType;
+  AAddMethod, AClearMethod, AMoveNextMethod: TRttiMethod;
+  ACurrentProperty, ACountProperty: TRttiProperty);
+begin
+  FInstance := AInstance;
+  FEnumInstance := AEnumInstance;
+  FItemType := AItemType;
+  FAddMethod := AAddMethod;
+  FClearMethod := AClearMethod;
+  FMoveNextMethod := AMoveNextMethod;
+  FCurrentProperty := ACurrentProperty;
+  FCountProperty := ACountProperty;
+end;
+
+function TDynamicList.Current: TValue;
+begin
+  Result := FCurrentProperty.GetValue(FEnumInstance);
+end;
+
+destructor TDynamicList.Destroy;
+begin
+  FEnumInstance.Free;
+  inherited;
+end;
+
+function TDynamicList.GetItemType: TRttiType;
+begin
+  Result := FItemType;
+end;
+
+class function TDynamicList.GuessType(AInstance: TObject): IDynamicList;
+var
+  LMethodGetEnumerator, LMethodAdd: TRttiMethod;
+  LMethodClear, LMethodMoveNext: TRttiMethod;
+  LEnumInstance: TObject;
+  LListType, LItemType, LEnumType: TRttiType;
+  LCountProp, LCurrentProp: TRttiProperty;
+begin
+  Result := nil;
+
+  if not Assigned(AInstance) then
+    Exit;
+
+  LListType := TRttiUtils.Context.GetType(AInstance.ClassType);
+
+  LMethodGetEnumerator := LListType.GetMethod('GetEnumerator');
+  if not Assigned(LMethodGetEnumerator) or
+     (LMethodGetEnumerator.MethodKind <> mkFunction) or
+     (LMethodGetEnumerator.ReturnType.Handle.Kind <> tkClass)
+  then
+    Exit;
+
+  LMethodClear := LListType.GetMethod('Clear');
+  if not Assigned(LMethodClear) then
+    Exit;
+
+  LMethodAdd := LListType.GetMethod('Add');
+  if not Assigned(LMethodAdd) or (Length(LMethodAdd.GetParameters) <> 1) then
+    Exit;
+
+  LItemType := LMethodAdd.GetParameters[0].ParamType;
+
+  LCountProp := LListType.GetProperty('Count');
+  if not Assigned(LCountProp) then
+    Exit;
+
+  LEnumInstance := LMethodGetEnumerator.Invoke(AInstance, []).AsObject;
+  if not Assigned(LEnumInstance) then
+    Exit;
+
+  LEnumType := TRttiUtils.Context.GetType(LEnumInstance.ClassType);
+
+  LCurrentProp := LEnumType.GetProperty('Current');
+  if not Assigned(LCurrentProp) then
+    Exit;
+
+  LMethodMoveNext := LEnumType.GetMethod('MoveNext');
+  if not Assigned(LMethodMoveNext) or
+     (Length(LMethodMoveNext.GetParameters) <> 0) or
+     (LMethodMoveNext.MethodKind <> mkFunction) or
+     (LMethodMoveNext.ReturnType.Handle <> TypeInfo(Boolean))
+  then
+    Exit;
+
+  Result := TDynamicList.Create(
+    AInstance,
+    LEnumInstance,
+    LItemType,
+    LMethodAdd,
+    LMethodClear,
+    LMethodMoveNext,
+    LCurrentProp,
+    LCountProp
+  );
+end;
+
+function TDynamicList.MoveNext: Boolean;
+begin
+  Result := FMoveNextMethod.Invoke(FEnumInstance, []).AsBoolean;
+end;
+
+function TDynamicList.NewItem: TValue;
+begin
+  Result := TRttiUtils.CreateNewValue(FItemType);
+end;
+
+{ TDynamicMap }
+
+procedure TDynamicMap.Add(const AKey, AValue: TValue);
+begin
+  FAddMethod.Invoke(FInstance, [AKey, AValue]);
+end;
+
+procedure TDynamicMap.Clear;
+begin
+  FClearMethod.Invoke(FInstance, []);
+end;
+
+function TDynamicMap.Count: Integer;
+begin
+  Result := FCountProp.GetValue(FInstance).AsInteger;
+end;
+
+constructor TDynamicMap.Create(AInstance: TObject; AKeyType, AValueType: TRttiType;
+  AAddMethod, AClearMethod: TRttiMethod; ACountProp: TRttiProperty;
+  AKeyEnum, AValueEnum: TDynamicMap.TEnumerator; AToStringMethod, AFromStringMethod: TRttiMethod);
+begin
+  FInstance := AInstance;
+  FKeyType := AKeyType;
+  FValueType := AValueType;
+  FAddMethod := AAddMethod;
+  FClearMethod := AClearMethod;
+  FKeyEnum := AKeyEnum;
+  FValueEnum := AValueEnum;
+  FCountProp := ACountProp;
+  FToStringMethod := AToStringMethod;
+  FFromStringMethod := AFromStringMethod;
+end;
+
+function TDynamicMap.CurrentKey: TValue;
+begin
+  Result := FKeyEnum.Current;
+end;
+
+function TDynamicMap.CurrentValue: TValue;
+begin
+  Result := FValueEnum.Current;
+end;
+
+destructor TDynamicMap.Destroy;
+begin
+  FKeyEnum.Free;
+  FValueEnum.Free;
+  inherited;
+end;
+
+procedure TDynamicMap.KeyFromString(const AKey: TValue; const AStringVal: string);
+begin
+  if Assigned(FFromStringMethod) then
+    FFromStringMethod.Invoke(AKey.AsObject, [AStringVal]);
+end;
+
+function TDynamicMap.GetKeyType: TRttiType;
+begin
+  Result := FKeyType;
+end;
+
+function TDynamicMap.GetValueType: TRttiType;
+begin
+  Result := FValueType;
+end;
+
+class function TDynamicMap.GuessType(AInstance: TObject): IDynamicMap;
+var
+  LMapType: TRttiType;
+  LKeyType, LValType: TRttiType;
+  LKeyProp, LValProp: TRttiProperty;
+  LCountProp: TRttiProperty;
+  LAddMethod, LClearMethod: TRttiMethod;
+  LToStringMethod, LFromStringMethod: TRttiMethod;
+
+  LKeyEnumMethod, LValEnumMethod: TRttiMethod;
+  LKeyEnumObject, LValEnumObject: TObject;
+  LKeyEnum, LValEnum: TDynamicMap.TEnumerator;
+begin
+  Result := nil;
+
+  if not Assigned(AInstance) then
+    Exit;
+
+  LMapType := TRttiUtils.Context.GetType(AInstance.ClassType);
+
+  // Keys & Values Enumerator
+  LKeyProp := LMapType.GetProperty('Keys');
+  if not Assigned(LKeyProp) then
+    Exit;
+
+  LValProp := LMapType.GetProperty('Values');
+  if not Assigned(LValProp) then
+    Exit;
+
+  LKeyEnumObject := LKeyProp.GetValue(AInstance).AsObject;
+  LValEnumObject := LValProp.GetValue(AInstance).AsObject;
+
+  LKeyEnumMethod := TRttiUtils.Context.GetType(LKeyEnumObject.ClassInfo).GetMethod('GetEnumerator');
+  LValEnumMethod := TRttiUtils.Context.GetType(LValEnumObject.ClassInfo).GetMethod('GetEnumerator');
+
+  LKeyEnum := TDynamicMap.TEnumerator.Create(LKeyEnumMethod, LKeyEnumObject);
+  LValEnum := TDynamicMap.TEnumerator.Create(LValEnumMethod, LValEnumObject);
+  // End Keys & Values Enumerator
+
+  LClearMethod := LMapType.GetMethod('Clear');
+  if not Assigned(LClearMethod) then
+    Exit;
+
+  LAddMethod := LMapType.GetMethod('Add');
+  if not Assigned(LAddMethod) or (Length(LAddMethod.GetParameters) <> 2) then
+    Exit;
+
+  LKeyType := LAddMethod.GetParameters[0].ParamType;
+  LValType := LAddMethod.GetParameters[1].ParamType;
+
+  LCountProp := LMapType.GetProperty('Count');
+  if not Assigned(LCountProp) then
+    Exit;
+
+  LToStringMethod := nil;
+  LFromStringMethod := nil;
+
+  // Optional methods (on Key object)
+  case LKeyType.TypeKind of
+    tkClass{, tkRecord, tkInterface}:
+    begin
+      LToStringMethod := LKeyType.GetMethod('ToString');
+      LFromStringMethod := LKeyType.GetMethod('FromString');
+    end;
+  end;
+
+  Result := TDynamicMap.Create(
+    AInstance,
+    LKeyType,
+    LValType,
+    LAddMethod,
+    LClearMethod,
+    LCountProp,
+    LKeyEnum,
+    LValEnum,
+    LToStringMethod,
+    LFromStringMethod
+  );
+end;
+
+function TDynamicMap.MoveNext: Boolean;
+begin
+  Result := (FKeyEnum.MoveNext and FValueEnum.MoveNext);
+end;
+
+function TDynamicMap.NewKey: TValue;
+begin
+  Result := TRttiUtils.CreateNewValue(FKeyType);
+end;
+
+function TDynamicMap.NewValue: TValue;
+begin
+  Result := TRttiUtils.CreateNewValue(FValueType);
+end;
+
+function TDynamicMap.KeyIsString: Boolean;
+begin
+  Result := Assigned(FToStringMethod) and Assigned(FFromStringMethod);
+end;
+
+function TDynamicMap.KeyToString(const AKey: TValue): string;
+begin
+  if Assigned(FToStringMethod) then
+    Result := FToStringMethod.Invoke(AKey.AsObject, []).AsString
+  else
+    Result := '';
+end;
+
+{ TDynamicMap.TEnumerator }
+
+constructor TDynamicMap.TEnumerator.Create(AMethod: TRttiMethod; AInstance: TObject);
+begin
+  // Memory creation, must destroy the object
+  FInstance := AMethod.Invoke(AInstance, []).AsObject;
+
+  FCurrentProperty := TRttiUtils.Context.GetType(FInstance.ClassInfo).GetProperty(CURRENT_PROP);
+  if not Assigned(FCurrentProperty) then
+    raise ENeonException.CreateFmt('Property [%s] not found', [CURRENT_PROP]);
+
+  FMoveNextMethod := TRttiUtils.Context.GetType(FInstance.ClassInfo).GetMethod(MOVENEXT_METH);
+  if not Assigned(FMoveNextMethod) then
+    raise ENeonException.CreateFmt('Method [%s] not found', [MOVENEXT_METH]);
+end;
+
+function TDynamicMap.TEnumerator.Current: TValue;
+begin
+  Result := FCurrentProperty.GetValue(FInstance);
+end;
+
+destructor TDynamicMap.TEnumerator.Destroy;
+begin
+  FInstance.Free;
+  inherited;
+end;
+
+function TDynamicMap.TEnumerator.MoveNext: Boolean;
+begin
+  Result := FMoveNextMethod.Invoke(FInstance, []).AsBoolean;
+end;
+
+{ TDynamicNullable }
+
+constructor TDynamicNullable.Create(AInstance: TValue; ATypeInfoMethod, AHasValueMethod,
+  AGetValueMethod, ASetValueMethod: TRttiMethod);
+begin
+  FInstance := AInstance;
+  FTypeInfoMethod := ATypeInfoMethod;
+  FHasValueMethod := AHasValueMethod;
+  FGetValueMethod := AGetValueMethod;
+  FSetValueMethod := ASetValueMethod;
+end;
+
+class function TDynamicNullable.GuessType(AInstance: TValue): IDynamicNullable;
+var
+  LType: TRttiType;
+  LContainedType: PTypeInfo;
+  LTypeInfoMethod, LHasValueMethod: TRttiMethod;
+  LGetValueMethod, LSetValueMethod: TRttiMethod;
+begin
+  if AInstance.IsEmpty then
+    Exit(nil);
+
+  LType := TRttiUtils.Context.GetType(AInstance.TypeInfo);
+
+  if not Assigned(LType) then
+    Exit(nil);
+
+  LTypeInfoMethod := LType.GetMethod('GetValueType');
+  if not Assigned(LTypeInfoMethod) then
+    Exit(nil);
+
+  LContainedType := LTypeInfoMethod.Invoke(AInstance, []).AsType<PTypeInfo>;
+  if LContainedType = nil then
+    raise ENeonException.Create('Nullable contains type with no RTTI');
+
+  LHasValueMethod := LType.GetMethod('GetHasValue');
+  if not Assigned(LHasValueMethod) then
+    Exit(nil);
+
+  LGetValueMethod := LType.GetMethod('GetValue');
+  if not Assigned(LGetValueMethod) then
+    Exit(nil);
+
+  LSetValueMethod := LType.GetMethod('SetValue');
+  if not Assigned(LSetValueMethod) then
+    Exit(nil);
+
+  Result := Self.Create(AInstance, LTypeInfoMethod, LHasValueMethod, LGetValueMethod, LSetValueMethod);
+end;
+
+function TDynamicNullable.HasValue: Boolean;
+begin
+  Result := FHasValueMethod.Invoke(FInstance, []).AsBoolean;
+end;
+
+procedure TDynamicNullable.SetValue(const AValue: TValue);
+begin
+  FSetValueMethod.Invoke(FInstance, [AValue]);
+end;
+
+function TDynamicNullable.GetValue: TValue;
+begin
+  Result := FGetValueMethod.Invoke(FInstance, []);
+end;
+
+function TDynamicNullable.GetValueType: PTypeInfo;
+begin
+  Result := FTypeInfoMethod.Invoke(FInstance, []).AsType<PTypeInfo>;
+end;
+
+end.

+ 169 - 0
Neon.Core.Nullables.pas

@@ -0,0 +1,169 @@
+unit Neon.Core.Nullables;
+
+interface
+
+uses
+  System.SysUtils, System.Variants, System.Classes, System.Generics.Defaults, System.Rtti,
+  System.TypInfo, System.JSON;
+
+type
+  ENullableException = class(Exception);
+
+  {$RTTI EXPLICIT FIELDS([vcPrivate]) METHODS([vcPrivate])}
+  Nullable<T> = record
+  private
+    FValue: T;
+    FHasValue: string;
+    procedure Clear;
+    function GetValueType: PTypeInfo;
+    function GetValue: T;
+    procedure SetValue(const AValue: T);
+    function GetHasValue: Boolean;
+  public
+    constructor Create(const Value: T); overload;
+    constructor Create(const Value: Variant); overload;
+    function Equals(const Value: Nullable<T>): Boolean;
+    function GetValueOrDefault: T; overload;
+    function GetValueOrDefault(const Default: T): T; overload;
+
+    property HasValue: Boolean read GetHasValue;
+    function IsNull: Boolean;
+
+    property Value: T read GetValue;
+
+    class operator Implicit(const Value: Nullable<T>): T;
+    class operator Implicit(const Value: Nullable<T>): Variant;
+    class operator Implicit(const Value: Pointer): Nullable<T>;
+    class operator Implicit(const Value: T): Nullable<T>;
+    class operator Implicit(const Value: Variant): Nullable<T>;
+    class operator Equal(const Left, Right: Nullable<T>): Boolean;
+    class operator NotEqual(const Left, Right: Nullable<T>): Boolean;
+  end;
+
+  NullString = Nullable<string>;
+  NullBoolean = Nullable<Boolean>;
+  NullInteger = Nullable<Integer>;
+  NullInt64 = Nullable<Int64>;
+  NullDouble = Nullable<Double>;
+  NullDateTime = Nullable<TDateTime>;
+
+implementation
+
+uses
+  Neon.Core.Utils;
+
+{ Nullable<T> }
+
+constructor Nullable<T>.Create(const Value: T);
+var
+  a: TValue;
+begin
+  FValue := Value;
+  FHasValue := DefaultTrueBoolStr;
+end;
+
+constructor Nullable<T>.Create(const Value: Variant);
+begin
+  if not VarIsNull(Value) and not VarIsEmpty(Value) then
+    Create(TValue.FromVariant(Value).AsType<T>)
+  else
+    Clear;
+end;
+
+procedure Nullable<T>.Clear;
+begin
+  FValue := Default(T);
+  FHasValue := '';
+end;
+
+function Nullable<T>.Equals(const Value: Nullable<T>): Boolean;
+begin
+  if HasValue and Value.HasValue then
+    Result := TEqualityComparer<T>.Default.Equals(Self.Value, Value.Value)
+  else
+    Result := HasValue = Value.HasValue;
+end;
+
+function Nullable<T>.GetHasValue: Boolean;
+begin
+  Result := FHasValue <> '';
+end;
+
+function Nullable<T>.GetValueType: PTypeInfo;
+begin
+  Result := TypeInfo(T);
+end;
+
+function Nullable<T>.GetValue: T;
+begin
+  if not HasValue then
+    raise ENullableException.Create('Nullable type has no value');
+  Result := FValue;
+end;
+
+function Nullable<T>.GetValueOrDefault(const Default: T): T;
+begin
+  if HasValue then
+    Result := FValue
+  else
+    Result := Default;
+end;
+
+function Nullable<T>.GetValueOrDefault: T;
+begin
+  Result := GetValueOrDefault(Default(T));
+end;
+
+class operator Nullable<T>.Implicit(const Value: Nullable<T>): T;
+begin
+  Result := Value.Value;
+end;
+
+class operator Nullable<T>.Implicit(const Value: Nullable<T>): Variant;
+begin
+  if Value.HasValue then
+    Result := TValue.From<T>(Value.Value).AsVariant
+  else
+    Result := Null;
+end;
+
+class operator Nullable<T>.Implicit(const Value: Pointer): Nullable<T>;
+begin
+  if Value = nil then
+    Result.Clear
+  else
+    Result := Nullable<T>.Create(T(Value^));
+end;
+
+class operator Nullable<T>.Implicit(const Value: T): Nullable<T>;
+begin
+  Result := Nullable<T>.Create(Value);
+end;
+
+class operator Nullable<T>.Implicit(const Value: Variant): Nullable<T>;
+begin
+  Result := Nullable<T>.Create(Value);
+end;
+
+function Nullable<T>.IsNull: Boolean;
+begin
+  Result := FHasValue = '';
+end;
+
+class operator Nullable<T>.Equal(const Left, Right: Nullable<T>): Boolean;
+begin
+  Result := Left.Equals(Right);
+end;
+
+class operator Nullable<T>.NotEqual(const Left, Right: Nullable<T>): Boolean;
+begin
+  Result := not Left.Equals(Right);
+end;
+
+procedure Nullable<T>.SetValue(const AValue: T);
+begin
+  FValue := AValue;
+  FHasValue := DefaultTrueBoolStr;
+end;
+
+end.

Tiedoston diff-näkymää rajattu, sillä se on liian suuri
+ 1820 - 0
Neon.Core.Persistence.JSON.pas


+ 612 - 0
Neon.Core.Persistence.Swagger.pas

@@ -0,0 +1,612 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.Persistence.Swagger;
+
+interface
+
+{$I Neon.inc}
+
+uses
+  System.SysUtils, System.Classes, System.Rtti, System.SyncObjs,
+  System.TypInfo, System.Generics.Collections, System.JSON, Data.DB,
+
+  Neon.Core.Types,
+  Neon.Core.Attributes,
+  Neon.Core.Persistence,
+  Neon.Core.TypeInfo,
+  Neon.Core.Utils;
+
+type
+  /// <summary>
+  ///   Swagger (OpenAPI 2.0) schema generator
+  /// </summary>
+  TNeonSchemaGenerator = class(TNeonBase)
+  private
+    /// <summary>
+    ///   Writer for members of objects and records
+    /// </summary>
+    procedure WriteMembers(AType: TRttiType; AResult: TJSONObject);
+  private
+    /// <summary>
+    ///   Writer for string types
+    /// </summary>
+    function WriteString(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for Boolean types
+    /// </summary>
+    function WriteBoolean(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for enums types <br />
+    /// </summary>
+    function WriteEnum(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for Integer types <br />
+    /// </summary>
+    function WriteInteger(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for Integer types <br />
+    /// </summary>
+    function WriteInt64(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for float types
+    /// </summary>
+    function WriteFloat(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+    function WriteDouble(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for TDate* types
+    /// </summary>
+    function WriteDate(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+    function WriteDateTime(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for Variant types
+    /// </summary>
+    /// <remarks>
+    ///   The variant will be written as string
+    /// </remarks>
+    function WriteVariant(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for static and dynamic arrays
+    /// </summary>
+    function WriteArray(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+    function WriteDynArray(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for the set type
+    /// </summary>
+    /// <remarks>
+    ///   The output is a string with the values comma separated and enclosed by square brackets
+    /// </remarks>
+    /// <returns>[First,Second,Third]</returns>
+    function WriteSet(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for a record type
+    /// </summary>
+    /// <remarks>
+    ///   For records the engine serialize the fields by default
+    /// </remarks>
+    function WriteRecord(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for a standard TObject (descendants)  type (no list, stream or streamable)
+    /// </summary>
+    function WriteObject(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for an Interface type
+    /// </summary>
+    /// <remarks>
+    ///   The object that implements the interface is serialized
+    /// </remarks>
+    function WriteInterface(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for TStream (descendants) objects
+    /// </summary>
+    function WriteStream(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for TDataSet (descendants) objects
+    /// </summary>
+    function WriteDataSet(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+
+    /// <summary>
+    ///   Writer for "Enumerable" objects (Lists, Generic Lists, TStrings, etc...)
+    /// </summary>
+    /// <remarks>
+    ///   Objects must have GetEnumerator, Clear, Add methods
+    /// </remarks>
+    function WriteEnumerable(AType: TRttiType; ANeonObject: TNeonRttiObject; AList: INeonTypeInfoList): TJSONObject;
+    function IsEnumerable(AType: TRttiType; out AList: INeonTypeInfoList): Boolean;
+
+    /// <summary>
+    ///   Writer for "Dictionary" objects (TDictionary, TObjectDictionary)
+    /// </summary>
+    /// <remarks>
+    ///   Objects must have Keys, Values, GetEnumerator, Clear, Add methods
+    /// </remarks>
+    function WriteEnumerableMap(AType: TRttiType; ANeonObject: TNeonRttiObject; AMap: INeonTypeInfoMap): TJSONObject;
+    function IsEnumerableMap(AType: TRttiType; out AMap: INeonTypeInfoMap): Boolean;
+
+    /// <summary>
+    ///   Writer for "Streamable" objects
+    /// </summary>
+    /// <remarks>
+    ///   Objects must have LoadFromStream and SaveToStream methods
+    /// </remarks>
+    function WriteStreamable(AType: TRttiType; ANeonObject: TNeonRttiObject; AStream: INeonTypeInfoStream): TJSONObject;
+    function IsStreamable(AType: TRttiType; out AStream: INeonTypeInfoStream): Boolean;
+
+    /// <summary>
+    ///   Writer for "Nullable" records
+    /// </summary>
+    /// <remarks>
+    ///   Record must have HasValue and GetValue methods
+    /// </remarks>
+    function WriteNullable(AType: TRttiType; ANeonObject: TNeonRttiObject; ANullable: INeonTypeInfoNullable): TJSONObject;
+    function IsNullable(AType: TRttiType; out ANullable: INeonTypeInfoNullable): Boolean;
+  protected
+    /// <summary>
+    ///   Function to be called by a custom serializer method (ISerializeContext)
+    /// </summary>
+    function WriteDataMember(AType: TRttiType): TJSONObject; overload;
+
+    /// <summary>
+    ///   This method chooses the right Writer based on the Kind of the AValue parameter
+    /// </summary>
+    function WriteDataMember(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject; overload;
+  public
+    constructor Create(const AConfig: INeonConfiguration);
+
+    /// <summary>
+    ///   Serialize any Delphi type into a JSONValue, the Delphi type must be passed as a TRttiType
+    /// </summary>
+    class function TypeToJSONSchema(AType: TRttiType): TJSONObject; overload;
+    class function TypeToJSONSchema(AType: TRttiType; AConfig: INeonConfiguration): TJSONObject; overload;
+
+    /// <summary>
+    ///   Serialize any Delphi type into a JSONValue, the Delphi type must be passed as a TRttiType
+    /// </summary>
+    class function ClassToJSONSchema(AClass: TClass): TJSONObject; overload;
+    class function ClassToJSONSchema(AClass: TClass; AConfig: INeonConfiguration): TJSONObject; overload;
+  end;
+
+implementation
+
+uses
+  System.Variants;
+
+{ TNeonSchemaGenerator }
+
+class function TNeonSchemaGenerator.ClassToJSONSchema(AClass: TClass): TJSONObject;
+begin
+  Result := TypeToJSONSchema(TRttiUtils.Context.GetType(AClass), TNeonConfiguration.Default);
+end;
+
+class function TNeonSchemaGenerator.ClassToJSONSchema(AClass: TClass; AConfig: INeonConfiguration): TJSONObject;
+begin
+  Result := TypeToJSONSchema(TRttiUtils.Context.GetType(AClass), AConfig);
+end;
+
+constructor TNeonSchemaGenerator.Create(const AConfig: INeonConfiguration);
+begin
+  inherited Create(AConfig);
+  FOperation := TNeonOperation.Serialize;
+end;
+
+function TNeonSchemaGenerator.IsEnumerable(AType: TRttiType; out AList: INeonTypeInfoList): Boolean;
+begin
+  AList := TNeonTypeInfoList.GuessType(AType);
+  Result := Assigned(AList);
+end;
+
+function TNeonSchemaGenerator.IsEnumerableMap(AType: TRttiType; out AMap: INeonTypeInfoMap): Boolean;
+begin
+  AMap := TNeonTypeInfoMap.GuessType(AType);
+  Result := Assigned(AMap);
+end;
+
+function TNeonSchemaGenerator.IsNullable(AType: TRttiType; out ANullable: INeonTypeInfoNullable): Boolean;
+begin
+  ANullable := TNeonTypeInfoNullable.GuessType(AType);
+  Result := Assigned(ANullable);
+end;
+
+function TNeonSchemaGenerator.IsStreamable(AType: TRttiType; out AStream: INeonTypeInfoStream): Boolean;
+begin
+  AStream := TNeonTypeInfoStream.GuessType(AType);
+  Result := Assigned(AStream);
+end;
+
+class function TNeonSchemaGenerator.TypeToJSONSchema(AType: TRttiType; AConfig: INeonConfiguration): TJSONObject;
+var
+  LGenerator: TNeonSchemaGenerator;
+begin
+  LGenerator := TNeonSchemaGenerator.Create(AConfig);
+  try
+    Result := LGenerator.WriteDataMember(AType);
+  finally
+    LGenerator.Free;
+  end;
+end;
+
+class function TNeonSchemaGenerator.TypeToJSONSchema(AType: TRttiType): TJSONObject;
+begin
+  Result := TypeToJSONSchema(AType, TNeonConfiguration.Default);
+end;
+
+function TNeonSchemaGenerator.WriteArray(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+var
+  LItems: TJSONObject;
+begin
+  LItems := WriteDataMember((AType as TRttiArrayType).ElementType);
+  Result := TJSONObject.Create
+    .AddPair('type', 'array')
+    .AddPair('items', LItems)
+end;
+
+function TNeonSchemaGenerator.WriteBoolean(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'boolean');
+end;
+
+function TNeonSchemaGenerator.WriteDataMember(AType: TRttiType): TJSONObject;
+var
+  LNeonObject: TNeonRttiObject;
+begin
+  LNeonObject := TNeonRttiObject.Create(AType, FOperation);
+  LNeonObject.ParseAttributes;
+  try
+    Result := WriteDataMember(AType, LNeonObject);
+  finally
+    LNeonObject.Free;
+  end;
+end;
+
+function TNeonSchemaGenerator.WriteDataMember(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+var
+  LNeonTypeInfo: INeonTypeInfo;
+
+  LNeonMap: INeonTypeInfoMap absolute LNeonTypeInfo;
+  LNeonList: INeonTypeInfoList absolute LNeonTypeInfo;
+  LNeonStream: INeonTypeInfoStream absolute LNeonTypeInfo;
+  LNeonNullable: INeonTypeInfoNullable absolute LNeonTypeInfo;
+begin
+  Result := nil;
+
+  case AType.TypeKind of
+    tkChar,
+    tkWChar,
+    tkString,
+    tkLString,
+    tkWString,
+    tkUString:
+    begin
+      Result := WriteString(AType, ANeonObject);
+    end;
+
+    tkEnumeration:
+    begin
+      if AType.Handle = System.TypeInfo(Boolean) then
+        Result := WriteBoolean(AType, ANeonObject)
+      else
+        Result := WriteEnum(AType, ANeonObject);
+    end;
+
+    tkInteger:
+    begin
+      Result := WriteInteger(AType, ANeonObject);
+    end;
+
+    tkInt64:
+    begin
+      Result := WriteInt64(AType, ANeonObject);
+    end;
+
+    tkFloat:
+    begin
+      if AType.Handle = TypeInfo(Single) then
+        Result := WriteFloat(AType, ANeonObject)
+      else if AType.Handle = TypeInfo(TDateTime) then
+        Result := WriteDateTime(AType, ANeonObject)
+      else if AType.Handle = TypeInfo(TTime) then
+        Result := WriteDateTime(AType, ANeonObject)
+      else if AType.Handle = TypeInfo(TDate) then
+        Result := WriteDate(AType, ANeonObject)
+      else
+        Result := WriteDouble(AType, ANeonObject);
+    end;
+
+    tkClass:
+    begin
+      if AType.IsInstance and AType.AsInstance.MetaclassType.InheritsFrom(TDataSet) then
+        Result := WriteDataSet(AType, ANeonObject)
+      else if AType.IsInstance and AType.AsInstance.MetaclassType.InheritsFrom(TStream) then
+        Result := WriteStream(AType, ANeonObject)
+      else if IsEnumerableMap(AType, LNeonMap) then
+        Result := WriteEnumerableMap(AType, ANeonObject, LNeonMap)
+      else if IsEnumerable(AType, LNeonList) then
+        Result := WriteEnumerable(AType, ANeonObject, LNeonList)
+      else if IsStreamable(AType, LNeonStream) then
+        Result := WriteStreamable(AType, ANeonObject, LNeonStream)
+      else
+        Result := WriteObject(AType, ANeonObject);
+    end;
+
+    tkArray:
+    begin
+      Result := WriteArray(AType, ANeonObject);
+    end;
+
+    tkDynArray:
+    begin
+      Result := WriteDynArray(AType, ANeonObject);
+    end;
+
+    tkSet:
+    begin
+      Result := WriteSet(AType, ANeonObject);
+    end;
+
+    tkRecord:
+    begin
+      if IsNullable(AType, LNeonNullable) then
+        Result := WriteNullable(AType, ANeonObject, LNeonNullable)
+      else
+        Result := WriteRecord(AType, ANeonObject);
+    end;
+
+    tkInterface:
+    begin
+      Result := WriteInterface(AType, ANeonObject);
+    end;
+
+    tkVariant:
+    begin
+      Result := WriteVariant(AType, ANeonObject);
+    end;
+
+  end;
+end;
+
+function TNeonSchemaGenerator.WriteDataSet(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+var
+  LJSONProps: TJSONObject;
+begin
+  //Result := TDataSetUtils.RecordToJSONSchema(AValue.AsObject as TDataSet, FConfig);
+
+  LJSONProps := TJSONObject.Create;
+  Result := TJSONObject.Create
+    .AddPair('type', 'object')
+    .AddPair('properties', LJSONProps);
+end;
+
+function TNeonSchemaGenerator.WriteDate(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string')
+    .AddPair('format', 'date');
+end;
+
+function TNeonSchemaGenerator.WriteDateTime(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string')
+    .AddPair('format', 'date-time');
+end;
+
+function TNeonSchemaGenerator.WriteDouble(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'number')
+    .AddPair('format', 'double');
+end;
+
+function TNeonSchemaGenerator.WriteDynArray(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+var
+  LItems: TJSONObject;
+begin
+  LItems := WriteDataMember((AType as TRttiDynamicArrayType).ElementType);
+  Result := TJSONObject.Create
+    .AddPair('type', 'array')
+    .AddPair('items', LItems)
+end;
+
+function TNeonSchemaGenerator.WriteEnum(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string');
+end;
+
+function TNeonSchemaGenerator.WriteFloat(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'number')
+    .AddPair('format', 'float');
+end;
+
+function TNeonSchemaGenerator.WriteInt64(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'integer')
+    .AddPair('format', 'int64');
+end;
+
+function TNeonSchemaGenerator.WriteInteger(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'integer')
+    .AddPair('format', 'int32');
+end;
+
+function TNeonSchemaGenerator.WriteInterface(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := nil;
+end;
+
+procedure TNeonSchemaGenerator.WriteMembers(AType: TRttiType; AResult: TJSONObject);
+var
+  LJSONValue: TJSONObject;
+  LMembers: TNeonRttiMembers;
+  LNeonMember: TNeonRttiMember;
+begin
+  LMembers := GetNeonMembers(nil, AType);
+  LMembers.FilterSerialize;
+  try
+    for LNeonMember in LMembers do
+    begin
+      if LNeonMember.Serializable then
+      begin
+        try
+          LJSONValue := WriteDataMember(LNeonMember.RttiType, LNeonMember);
+          if Assigned(LJSONValue) then
+            (AResult as TJSONObject).AddPair(GetNameFromMember(LNeonMember), LJSONValue);
+        except
+          LogError(Format('Error converting property [%s] of object [%s]',
+            [LNeonMember.Name, AType.Name]));
+        end;
+      end;
+    end;
+  finally
+    LMembers.Free;
+  end;
+end;
+
+function TNeonSchemaGenerator.WriteNullable(AType: TRttiType; ANeonObject: TNeonRttiObject; ANullable: INeonTypeInfoNullable): TJSONObject;
+begin
+  Result := nil;
+
+  if Assigned(ANullable) then
+    Result := WriteDataMember(ANullable.GetBaseType)
+end;
+
+function TNeonSchemaGenerator.WriteObject(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+var
+  LProperties: TJSONObject;
+begin
+  LProperties := TJSONObject.Create;
+
+  WriteMembers(AType, LProperties);
+
+  Result := TJSONObject.Create
+    .AddPair('type', 'object')
+    .AddPair('properties', LProperties);
+end;
+
+function TNeonSchemaGenerator.WriteEnumerable(AType: TRttiType; ANeonObject: TNeonRttiObject; AList: INeonTypeInfoList): TJSONObject;
+var
+  LJSONItems: TJSONObject;
+begin
+  // Is not an Enumerable compatible object
+  if not Assigned(AList) then
+    Exit(nil);
+
+  LJSONItems := WriteDataMember(AList.GetItemType);
+
+  Result := TJSONObject.Create
+    .AddPair('type', 'array')
+    .AddPair('items', LJSONItems);
+end;
+
+function TNeonSchemaGenerator.WriteEnumerableMap(AType: TRttiType; ANeonObject: TNeonRttiObject; AMap: INeonTypeInfoMap): TJSONObject;
+var
+  LValueJSON: TJSONObject;
+begin
+  // Is not an EnumerableMap-compatible object
+  if not Assigned(AMap) then
+    Exit(nil);
+
+  LValueJSON := WriteDataMember(AMap.GetValueType);
+  Result := TJSONObject.Create
+    .AddPair('type', 'object')
+    .AddPair('additionalProperties', LValueJSON);
+end;
+
+function TNeonSchemaGenerator.WriteRecord(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+var
+  LProperties: TJSONObject;
+begin
+  LProperties := TJSONObject.Create;
+
+  WriteMembers(AType, LProperties);
+
+  Result := TJSONObject.Create
+    .AddPair('type', 'object')
+    .AddPair('properties', LProperties);
+end;
+
+function TNeonSchemaGenerator.WriteSet(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string');
+end;
+
+function TNeonSchemaGenerator.WriteStream(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string')
+    .AddPair('format', 'byte');
+end;
+
+function TNeonSchemaGenerator.WriteStreamable(AType: TRttiType; ANeonObject: TNeonRttiObject; AStream: INeonTypeInfoStream): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string')
+    .AddPair('format', 'byte');
+end;
+
+function TNeonSchemaGenerator.WriteString(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+  Result := TJSONObject.Create
+    .AddPair('type', 'string');
+end;
+
+function TNeonSchemaGenerator.WriteVariant(AType: TRttiType; ANeonObject: TNeonRttiObject): TJSONObject;
+begin
+{
+  case ANeonObject.NeonInclude.Value of
+    Include.NotNull:
+    begin
+      if VarIsNull(AValue.AsVariant) then
+        Exit(nil);
+    end;
+    Include.NotEmpty:
+    begin
+      if VarIsEmpty(AValue.AsVariant) then
+        Exit(nil);
+    end;
+  end;
+}
+  Result :=nil;
+  //TJSONString.Create(AValue.AsVariant);
+end;
+
+end.

Tiedoston diff-näkymää rajattu, sillä se on liian suuri
+ 1125 - 0
Neon.Core.Persistence.pas


+ 89 - 0
Neon.Core.Serializers.DB.pas

@@ -0,0 +1,89 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.Serializers.DB;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, System.Rtti, System.SyncObjs, System.TypInfo,
+  System.Generics.Collections, System.Math.Vectors, System.JSON, Data.DB,
+
+  Neon.Core.Types,
+  Neon.Core.Attributes,
+  Neon.Core.Persistence;
+
+type
+  TDataSetSerializer = class(TCustomSerializer)
+  protected
+    class function GetTargetInfo: PTypeInfo; override;
+    class function CanHandle(AType: PTypeInfo): Boolean; override;
+  public
+    function Serialize(const AValue: TValue; ANeonObject: TNeonRttiObject; AContext: ISerializerContext): TJSONValue; override;
+    function Deserialize(AValue: TJSONValue; const AData: TValue; ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue; override;
+  end;
+
+procedure RegisterDefaultSerializers(ARegistry: TNeonSerializerRegistry);
+
+implementation
+
+uses
+  Neon.Core.Utils;
+
+procedure RegisterDefaultSerializers(ARegistry: TNeonSerializerRegistry);
+begin
+  ARegistry.RegisterSerializer(TDataSetSerializer);
+end;
+
+{ TDataSetSerializer }
+
+class function TDataSetSerializer.GetTargetInfo: PTypeInfo;
+begin
+  Result := TDataSet.ClassInfo;
+end;
+
+class function TDataSetSerializer.CanHandle(AType: PTypeInfo): Boolean;
+begin
+  Result := TypeInfoIs(AType);
+end;
+
+function TDataSetSerializer.Deserialize(AValue: TJSONValue; const AData:
+    TValue; ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue;
+begin
+  Result := AData;
+  TDataSetUtils.JSONToDataSet(AValue, AData.AsObject as TDataSet, AContext.GetConfiguration.GetUseUTCDate);
+end;
+
+function TDataSetSerializer.Serialize(const AValue: TValue; ANeonObject:
+    TNeonRttiObject; AContext: ISerializerContext): TJSONValue;
+var
+  LDataSet: TDataSet;
+begin
+  LDataSet := AValue.AsType<TDataSet>;
+
+  if ANeonObject.NeonInclude.Value = IncludeIf.NotEmpty then
+    if LDataSet.IsEmpty then
+      Exit(nil);
+
+  Result := TDataSetUtils.DataSetToJSONArray(LDataSet, AContext.GetConfiguration.GetUseUTCDate);
+end;
+
+end.

+ 148 - 0
Neon.Core.Serializers.RTL.pas

@@ -0,0 +1,148 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.Serializers.RTL;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, System.Rtti, System.SyncObjs, System.TypInfo,
+  System.Generics.Collections, System.Math.Vectors, System.JSON,
+
+  Neon.Core.Types,
+  Neon.Core.Attributes,
+  Neon.Core.Persistence;
+
+type
+  TGUIDSerializer = class(TCustomSerializer)
+  protected
+    class function GetTargetInfo: PTypeInfo; override;
+    class function CanHandle(AType: PTypeInfo): Boolean; override;
+  public
+    function Serialize(const AValue: TValue; ANeonObject: TNeonRttiObject; AContext: ISerializerContext): TJSONValue; override;
+    function Deserialize(AValue: TJSONValue; const AData: TValue; ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue; override;
+  end;
+
+  TStreamSerializer = class(TCustomSerializer)
+  protected
+    class function GetTargetInfo: PTypeInfo; override;
+    class function CanHandle(AType: PTypeInfo): Boolean; override;
+  public
+    function Serialize(const AValue: TValue; ANeonObject: TNeonRttiObject; AContext: ISerializerContext): TJSONValue; override;
+    function Deserialize(AValue: TJSONValue; const AData: TValue; ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue; override;
+  end;
+
+procedure RegisterDefaultSerializers(ARegistry: TNeonSerializerRegistry);
+
+implementation
+
+uses
+  Neon.Core.Utils;
+
+procedure RegisterDefaultSerializers(ARegistry: TNeonSerializerRegistry);
+begin
+  ARegistry.RegisterSerializer(TGUIDSerializer);
+  ARegistry.RegisterSerializer(TStreamSerializer);
+end;
+
+{ TGUIDSerializer }
+
+class function TGUIDSerializer.GetTargetInfo: PTypeInfo;
+begin
+  Result := TypeInfo(TGUID);
+end;
+
+function TGUIDSerializer.Serialize(const AValue: TValue; ANeonObject:
+    TNeonRttiObject; AContext: ISerializerContext): TJSONValue;
+var
+  LGUID: TGUID;
+begin
+  LGUID := AValue.AsType<TGUID>;
+  Result := TJSONString.Create(Format('%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x',
+    [LGUID.D1, LGUID.D2, LGUID.D3, LGUID.D4[0], LGUID.D4[1], LGUID.D4[2],
+     LGUID.D4[3], LGUID.D4[4], LGUID.D4[5], LGUID.D4[6], LGUID.D4[7]])
+    );
+end;
+
+class function TGUIDSerializer.CanHandle(AType: PTypeInfo): Boolean;
+begin
+  if AType = GetTargetInfo then
+    Result := True
+  else
+    Result := False;
+end;
+
+function TGUIDSerializer.Deserialize(AValue: TJSONValue; const AData: TValue;
+    ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue;
+var
+  LGUID: TGUID;
+begin
+  LGUID := StringToGUID(Format('{%s}', [AValue.Value]));
+  Result := TValue.From<TGUID>(LGUID);
+end;
+
+{ TStreamSerializer }
+
+class function TStreamSerializer.GetTargetInfo: PTypeInfo;
+begin
+  Result := TStream.ClassInfo;
+end;
+
+class function TStreamSerializer.CanHandle(AType: PTypeInfo): Boolean;
+begin
+  Result := TypeInfoIs(AType);
+end;
+
+function TStreamSerializer.Serialize(const AValue: TValue;
+  ANeonObject: TNeonRttiObject; AContext: ISerializerContext): TJSONValue;
+var
+  LStream: TStream;
+  LBase64: string;
+begin
+  LStream := AValue.AsObject as TStream;
+
+  if LStream.Size = 0 then
+  begin
+    case ANeonObject.NeonInclude.Value of
+      IncludeIf.NotEmpty, IncludeIf.NotDefault: Exit(nil);
+    else
+      Exit(TJSONString.Create(''));
+    end;
+  end;
+
+  LStream.Position := soFromBeginning;
+  LBase64 := TBase64.Encode(LStream);
+  Result := TJSONString.Create(LBase64);
+end;
+
+function TStreamSerializer.Deserialize(AValue: TJSONValue; const AData: TValue;
+  ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue;
+var
+  LStream: TStream;
+begin
+  Result := AData;
+  LStream := AData.AsObject as TStream;
+  LStream.Position := soFromBeginning;
+
+  TBase64.Decode(AValue.Value, LStream);
+end;
+
+end.

+ 116 - 0
Neon.Core.Serializers.VCL.pas

@@ -0,0 +1,116 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.Serializers.VCL;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, System.Rtti, System.TypInfo,
+  System.Generics.Collections, System.JSON,
+
+  Neon.Core.Types,
+  Neon.Core.Attributes,
+  Neon.Core.Persistence;
+
+type
+  TImageSerializer = class(TCustomSerializer)
+  protected
+    class function GetTargetInfo: PTypeInfo; override;
+    class function CanHandle(AType: PTypeInfo): Boolean; override;
+  public
+    function Serialize(const AValue: TValue; ANeonObject: TNeonRttiObject; AContext: ISerializerContext): TJSONValue; override;
+    function Deserialize(AValue: TJSONValue; const AData: TValue; ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue; override;
+  end;
+
+implementation
+
+uses
+  Vcl.ExtCtrls,
+  Neon.Core.Utils;
+
+{ TImageSerializer }
+
+class function TImageSerializer.CanHandle(AType: PTypeInfo): Boolean;
+begin
+  Result := TypeInfoIs(AType);
+end;
+
+class function TImageSerializer.GetTargetInfo: PTypeInfo;
+begin
+  Result := TImage.ClassInfo;
+end;
+
+function TImageSerializer.Serialize(const AValue: TValue;
+  ANeonObject: TNeonRttiObject; AContext: ISerializerContext): TJSONValue;
+var
+  LImage: TImage;
+  LStream: TMemoryStream;
+  LBase64: string;
+begin
+  LImage := AValue.AsObject as TImage;
+
+  if LImage.Picture = nil then
+  begin
+    case ANeonObject.NeonInclude.Value of
+      IncludeIf.NotEmpty, IncludeIf.NotDefault: Exit(nil);
+    else
+      Exit(TJSONString.Create(''));
+    end;
+  end;
+
+  LStream := TMemoryStream.Create;
+  try
+    LImage.Picture.SaveToStream(LStream);
+    LStream.Position := soFromBeginning;
+    LBase64 := TBase64.Encode(LStream);
+  finally
+    LStream.Free;
+  end;
+  Result := TJSONString.Create(LBase64);
+end;
+
+function TImageSerializer.Deserialize(AValue: TJSONValue; const AData: TValue;
+  ANeonObject: TNeonRttiObject; AContext: IDeserializerContext): TValue;
+var
+  LImage: TImage;
+  LStream: TMemoryStream;
+begin
+  Result := AData;
+  LImage := AData.AsObject as TImage;
+
+  if AValue.Value.IsEmpty then
+  begin
+    LImage.Picture := nil;
+    Exit(AData);
+  end;
+
+  LStream := TMemoryStream.Create;
+  try
+    TBase64.Decode(AValue.Value, LStream);
+    LStream.Position := soFromBeginning;
+    LImage.Picture.LoadFromStream(LStream);
+  finally
+    LStream.Free;
+  end;
+end;
+
+end.

+ 253 - 0
Neon.Core.TypeInfo.pas

@@ -0,0 +1,253 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.TypeInfo;
+
+interface
+
+uses
+  System.Classes, System.SysUtils, System.Rtti, System.TypInfo,
+  System.Generics.Collections;
+
+type
+  INeonTypeInfo = interface
+  ['{DA498D59-E50C-490C-8F7F-4F0B8804D322}']
+  end;
+
+  INeonTypeInfoStream = interface(INeonTypeInfo)
+  ['{285B6152-BC07-4195-8A10-B6A9B2A54536}']
+    function GetStreamType: TRttiType;
+  end;
+
+  INeonTypeInfoList = interface(INeonTypeInfo)
+  ['{0432B934-A484-46BE-8AF8-D2207694E1EA}']
+    function GetItemType: TRttiType;
+  end;
+
+  INeonTypeInfoMap = interface(INeonTypeInfo)
+  ['{9788B4FE-8F9E-4284-86F5-6DB5EFF326FC}']
+    function GetKeyType: TRttiType;
+    function GetValueType: TRttiType;
+  end;
+
+  INeonTypeInfoNullable = interface(INeonTypeInfo)
+  ['{20924A89-A952-4048-9A3A-7E209CA7C40D}']
+    function GetBaseType: TRttiType;
+  end;
+
+  TNeonTypeInfoStream = class(TInterfacedObject, INeonTypeInfoStream)
+  private
+    FStreamType: TRttiType;
+    constructor Create(AStreamType: TRttiType);
+  public
+    class function GuessType(AType: TRttiType): INeonTypeInfoStream;
+  public
+    function GetStreamType: TRttiType;
+  end;
+
+  TNeonTypeInfoList = class(TInterfacedObject, INeonTypeInfoList)
+  private
+    FItemType: TRttiType;
+    constructor Create(AItemType: TRttiType);
+  public
+    class function GuessType(AType: TRttiType): INeonTypeInfoList;
+  public
+    function GetItemType: TRttiType;
+  end;
+
+  TNeonTypeInfoMap = class(TInterfacedObject, INeonTypeInfoMap)
+  private
+    FKeyType: TRttiType;
+    FValueType: TRttiType;
+    constructor Create(AKeyType, AValueType: TRttiType);
+  public
+    class function GuessType(AType: TRttiType): INeonTypeInfoMap;
+  public
+    function GetKeyType: TRttiType;
+    function GetValueType: TRttiType;
+  end;
+
+  TNeonTypeInfoNullable = class(TInterfacedObject, INeonTypeInfoNullable)
+  private
+    FBaseType: TRttiType;
+    constructor Create(ABaseType: TRttiType);
+  public
+    class function GuessType(AType: TRttiType): INeonTypeInfoNullable;
+  public
+    function GetBaseType: TRttiType;
+  end;
+
+implementation
+
+uses
+  Neon.Core.Types,
+  Neon.Core.Utils;
+
+{ TNeonTypeInfoStream }
+
+constructor TNeonTypeInfoStream.Create(AStreamType: TRttiType);
+begin
+  FStreamType := AStreamType;
+end;
+
+function TNeonTypeInfoStream.GetStreamType: TRttiType;
+begin
+  Result := FStreamType;
+end;
+
+class function TNeonTypeInfoStream.GuessType(AType: TRttiType): INeonTypeInfoStream;
+begin
+  if not Assigned(AType) then
+    Exit(nil);
+
+  if not Assigned(AType.GetMethod('LoadFromStream')) then
+    Exit(nil);
+
+  if not Assigned(AType.GetMethod('SaveToStream')) then
+    Exit(nil);
+
+  Result := Self.Create(TRttiUtils.Context.GetType(TypeInfo(string)));
+end;
+
+{ TNeonTypeInfoList }
+
+constructor TNeonTypeInfoList.Create(AItemType: TRttiType);
+begin
+  FItemType := AItemType;
+end;
+
+function TNeonTypeInfoList.GetItemType: TRttiType;
+begin
+  Result := FItemType;
+end;
+
+class function TNeonTypeInfoList.GuessType(AType: TRttiType): INeonTypeInfoList;
+var
+  LMethodGetEnumerator, LMethodAdd: TRttiMethod;
+  LItemType: TRttiType;
+begin
+  Result := nil;
+
+  LMethodGetEnumerator := AType.GetMethod('GetEnumerator');
+  if not Assigned(LMethodGetEnumerator) or
+     (LMethodGetEnumerator.MethodKind <> mkFunction) or
+     (LMethodGetEnumerator.ReturnType.Handle.Kind <> tkClass)
+  then
+    Exit;
+
+  if not Assigned(AType.GetMethod('Clear')) then
+    Exit;
+
+  LMethodAdd := AType.GetMethod('Add');
+  if not Assigned(LMethodAdd) or (Length(LMethodAdd.GetParameters) <> 1) then
+    Exit;
+
+  LItemType := LMethodAdd.GetParameters[0].ParamType;
+
+  if not Assigned(AType.GetProperty('Count')) then
+    Exit;
+
+  Result := TNeonTypeInfoList.Create(LItemType);
+end;
+
+{ TNeonTypeInfoMap }
+
+constructor TNeonTypeInfoMap.Create(AKeyType, AValueType: TRttiType);
+begin
+  FKeyType := AKeyType;
+  FValueType := AValueType;
+end;
+
+function TNeonTypeInfoMap.GetKeyType: TRttiType;
+begin
+  Result := FKeyType;
+end;
+
+function TNeonTypeInfoMap.GetValueType: TRttiType;
+begin
+  Result := FValueType;
+end;
+
+class function TNeonTypeInfoMap.GuessType(AType: TRttiType): INeonTypeInfoMap;
+var
+  LKeyType, LValType: TRttiType;
+  LAddMethod: TRttiMethod;
+begin
+  Result := nil;
+
+  if not Assigned(AType.GetProperty('Keys')) then
+    Exit;
+
+  if not Assigned(AType.GetProperty('Values')) then
+    Exit;
+
+  if not Assigned(AType.GetMethod('Clear')) then
+    Exit;
+
+  LAddMethod := AType.GetMethod('Add');
+  if not Assigned(LAddMethod) or (Length(LAddMethod.GetParameters) <> 2) then
+    Exit;
+
+  LKeyType := LAddMethod.GetParameters[0].ParamType;
+  LValType := LAddMethod.GetParameters[1].ParamType;
+
+  if not Assigned(AType.GetProperty('Count')) then
+    Exit;
+
+  Result := TNeonTypeInfoMap.Create(LKeyType, LValType);
+end;
+
+{ TNeonTypeInfoNullable }
+
+constructor TNeonTypeInfoNullable.Create(ABaseType: TRttiType);
+begin
+  FBaseType := ABaseType;
+end;
+
+function TNeonTypeInfoNullable.GetBaseType: TRttiType;
+begin
+  Result := FBaseType;
+end;
+
+class function TNeonTypeInfoNullable.GuessType(AType: TRttiType): INeonTypeInfoNullable;
+var
+  LGetValueMethod: TRttiMethod;
+begin
+  if not Assigned(AType) then
+    Exit(nil);
+
+  LGetValueMethod := AType.GetMethod('GetValue');
+  if not Assigned(LGetValueMethod) then
+    Exit(nil);
+
+  if not Assigned(AType.GetMethod('GetValueType')) then
+    Exit(nil);
+
+  if not Assigned(AType.GetMethod('GetHasValue')) then
+    Exit(nil);
+
+  if not Assigned(AType.GetMethod('SetValue')) then
+    Exit(nil);
+
+  Result := Self.Create(LGetValueMethod.ReturnType);
+end;
+
+end.

+ 64 - 0
Neon.Core.Types.pas

@@ -0,0 +1,64 @@
+{******************************************************************************}
+{                                                                              }
+{  Neon: Serialization Library for Delphi                                      }
+{  Copyright (c) 2018-2019 Paolo Rossi                                         }
+{  https://github.com/paolo-rossi/neon-library                                 }
+{                                                                              }
+{******************************************************************************}
+{                                                                              }
+{  Licensed under the Apache License, Version 2.0 (the "License");             }
+{  you may not use this file except in compliance with the License.            }
+{  You may obtain a copy of the License at                                     }
+{                                                                              }
+{      http://www.apache.org/licenses/LICENSE-2.0                              }
+{                                                                              }
+{  Unless required by applicable law or agreed to in writing, software         }
+{  distributed under the License is distributed on an "AS IS" BASIS,           }
+{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
+{  See the License for the specific language governing permissions and         }
+{  limitations under the License.                                              }
+{                                                                              }
+{******************************************************************************}
+unit Neon.Core.Types;
+
+interface
+
+uses
+  System.Classes, System.SysUtils, System.TypInfo;
+
+{$SCOPEDENUMS ON}
+
+type
+  ENeonException = class(Exception);
+
+type
+  TNeonCase = (LowerCase, UpperCase, PascalCase, CamelCase, SnakeCase, CustomCase);
+  TNeonMemberType = (Unknown, Prop, Field, Indexed);
+  TNeonMembers = (Standard, Fields, Properties);
+  TNeonMembersSet = set of TNeonMembers;
+  TNeonVisibility = set of TMemberVisibility;
+  TNeonIncludeOption = (Default, Include, Exclude);
+  TNeonOperation = (Serialize, Deserialize);
+
+  TNeonIgnoreIfContext = record
+  public
+    MemberName: string;
+    Operation: TNeonOperation;
+    constructor Create(const AMemberName: string; AOperation: TNeonOperation);
+  end;
+
+type
+  TNeonIgnoreCallback = function(const AContext: TNeonIgnoreIfContext): Boolean of object;
+  TCaseFunc = reference to function (const AString: string): string;
+
+implementation
+
+{ TNeonIgnoreIfContext }
+
+constructor TNeonIgnoreIfContext.Create(const AMemberName: string; AOperation: TNeonOperation);
+begin
+  MemberName := AMemberName;
+  Operation := AOperation;
+end;
+
+end.

Tiedoston diff-näkymää rajattu, sillä se on liian suuri
+ 1387 - 0
Neon.Core.Utils.pas


+ 33 - 0
Neon.inc

@@ -0,0 +1,33 @@
+{$IF CompilerVersion >= 27} // Delphi XE6
+  {$DEFINE HAS_SYSTEM_JSON}
+{$ENDIF}
+
+{$IF CompilerVersion >= 28} // Delphi XE7
+  {$DEFINE HAS_NEW_ARRAY}
+  {$DEFINE HAS_NET_ENCODING}
+  {$DEFINE HAS_SYSTEM_THREADING}
+{$ENDIF}
+
+{$IF CompilerVersion >= 29} // Delphi XE8
+  {$DEFINE HAS_NETHTTP_CLIENT}
+{$ENDIF}
+
+{$IF CompilerVersion >= 30} // Delphi 10.0 Seattle
+  {$DEFINE HAS_HMAC_HASH}
+  {$DEFINE HAS_GENERIC_CREATE}
+{$ENDIF}
+
+{$IF CompilerVersion >= 31} // Delphi 10.1 Berlin
+  {$DEFINE HAS_UTF8CHAR}
+  {$DEFINE NO_ARRAY_HELPER_BUG}
+{$ENDIF}
+
+{$IF CompilerVersion >= 33} // Delphi 10.3 Rio
+  {$DEFINE HAS_NEW_PIDS}
+  {$DEFINE HAS_NEW_JSON}
+{$ENDIF}
+
+{$IF CompilerVersion >= 34} // Delphi 10.4 Sydney
+  {$DEFINE HAS_MRECORDS}
+{$ENDIF}
+

+ 34 - 0
U_CommonData.pas

@@ -0,0 +1,34 @@
+unit U_CommonData;
+
+interface
+
+type
+  THttpResponse = class
+  public
+    httpCode: Integer;
+    data: string;
+  end;
+
+  TPrinterClient = class
+  public
+    printerUniqueCode: string;
+    printerName: string;
+    voidFlag: Integer;
+    authorizeDate: Int64;
+    authorizeDateLong: Int64;
+    province: string;
+    city: string;
+    district: string;
+    address: string;
+    permissions: string;
+  end;
+
+  TCheckResult = packed record
+    expireDate: Int64;
+    remainDays: Integer;
+    permissions: array [0 .. 49] of Integer;
+  end;
+
+implementation
+
+end.

+ 164 - 0
dyAuth.dpr

@@ -0,0 +1,164 @@
+library dyAuth;
+
+{ Important note about DLL memory management: ShareMem must be the
+  first unit in your library's USES clause AND your project's (select
+  Project-View Source) USES clause if your DLL exports any procedures or
+  functions that pass strings as parameters or function results. This
+  applies to all strings passed to and from your DLL--even those that
+  are nested in records and classes. ShareMem is the interface unit to
+  the BORLNDMM.DLL shared memory manager, which must be deployed along
+  with your DLL. To avoid using BORLNDMM.DLL, pass string information
+  using PChar or ShortString parameters.
+
+  Important note about VCL usage: when this DLL will be implicitly
+  loaded and this DLL uses TWicImage / TImageCollection created in
+  any unit initialization section, then Vcl.WicImageInit must be
+  included into your library's USES clause. }
+
+uses
+  System.SysUtils,
+  System.Classes,
+  IdHTTP,
+  IdSSLOpenSSL,
+  DateUtils,
+  Neon.Core.Attributes in 'Neon.Core.Attributes.pas',
+  Neon.Core.DynamicTypes in 'Neon.Core.DynamicTypes.pas',
+  Neon.Core.Nullables in 'Neon.Core.Nullables.pas',
+  Neon.Core.Persistence.JSON in 'Neon.Core.Persistence.JSON.pas',
+  Neon.Core.Persistence in 'Neon.Core.Persistence.pas',
+  Neon.Core.Persistence.Swagger in 'Neon.Core.Persistence.Swagger.pas',
+  Neon.Core.Serializers.DB in 'Neon.Core.Serializers.DB.pas',
+  Neon.Core.Serializers.RTL in 'Neon.Core.Serializers.RTL.pas',
+  Neon.Core.Serializers.VCL in 'Neon.Core.Serializers.VCL.pas',
+  Neon.Core.TypeInfo in 'Neon.Core.TypeInfo.pas',
+  Neon.Core.Types in 'Neon.Core.Types.pas',
+  Neon.Core.Utils in 'Neon.Core.Utils.pas',
+  U_CommonData in 'U_CommonData.pas';
+
+{$R *.res}
+
+function UnixMillisecondsToTDateTime(UnixTimeStampMS: Int64): TDateTime;
+begin
+  // 将毫秒转换为秒,然后使用标准转换函数
+  Result := UnixToDateTime(UnixTimeStampMS div 1000);
+
+  // 添加剩余的毫秒部分
+  // TDateTime中1天=86400秒,1秒=1000毫秒
+  // 所以1毫秒 = 1/86400000 天
+  Result := Result + (UnixTimeStampMS mod 1000) / 86400000.0;
+
+  // 备注:也可以使用完整公式直接转换
+  // Result := UnixTimeStampMS / 86400000.0 + 25569.0;
+end;
+
+function InternalPerformHttpPost(const AUrl: string; const printerUniqueCode: string; out AResponse: string): Boolean;
+var
+  HTTP: TIdHTTP;
+  RequestList: TStringList; // 请求信息
+begin
+  Result := False;
+  AResponse := '';
+  HTTP := TIdHTTP.Create(nil);
+  RequestList := TStringList.Create;
+  try
+    // 配置HTTP组件
+    HTTP.HTTPOptions := HTTP.HTTPOptions + [hoForceEncodeParams];
+    HTTP.Request.UserAgent := 'Delphi HTTP Client DLL';
+
+    RequestList.Add('printerUniqueCode=' + printerUniqueCode);
+    try
+      AResponse := HTTP.Post(AUrl, RequestList);
+      Result := True;
+    except
+      on E: Exception do
+        AResponse := 'HTTP POST Error: ' + E.Message;
+    end;
+  finally
+    HTTP.Free;
+    RequestList.Free;
+  end;
+end;
+
+function CheckPrinterAuth(const printerUniqueCode: PWideChar; out AResponse: TCheckResult): Boolean; stdcall;
+var
+  UrlStr, ResponseStr: string;
+  ResByteArray: TByteArray;
+  Response: THttpResponse;
+
+  printerClient: TPrinterClient;
+  ch: String;
+  index: Integer;
+begin
+  Result := False;
+
+  UrlStr := 'http://192.168.1.44:18652/apis0/authorize/checkPrinterPerms';
+  if InternalPerformHttpPost(UrlStr, string(printerUniqueCode), ResponseStr) then begin
+    Response := TNeon.JSONToObject<THttpResponse>(ResponseStr);
+    try
+      if Response.httpCode = 200 then begin
+        printerClient := TNeon.JSONToObject<TPrinterClient>(Response.data);
+        try
+          AResponse.expireDate := printerClient.authorizeDateLong;
+          AResponse.remainDays := DaysBetween(Now, UnixMillisecondsToTDateTime(AResponse.expireDate));
+
+          index := 0;
+          for ch in printerClient.permissions do begin
+            AResponse.permissions[index] := StrToInt(ch);
+            Inc(index);
+          end;
+
+        finally
+          printerClient.Free;
+        end;
+      end
+      else begin
+        Result := False;
+        Exit;
+      end;
+
+      Result := True;
+    finally
+      Response.Free;
+    end;
+  end
+  else begin
+    Result := False;
+  end;
+end;
+
+function TestExport(const i: Integer): TCheckResult; stdcall;
+begin
+  Result.remainDays := i;
+  Result.expireDate := 1000;
+  Result.permissions[0] := 0;
+  Result.permissions[1] := 1;
+  Result.permissions[2] := 2;
+  Result.permissions[3] := 3;
+  Result.permissions[4] := 4;
+end;
+
+// 导出函数列表
+exports
+  CheckPrinterAuth, TestExport;
+
+begin
+  WriteLn('Testing HTTP Client DLL...');
+  // 测试URL,可替换为其他有效地址
+  var
+  Url := 'http://192.168.1.44:18652/apis0/authorize/checkPrinterPerms';
+  var
+  uniqueCode := 'aaa';
+  var
+    Response: string;
+  if InternalPerformHttpPost(Url, uniqueCode, Response) then begin
+    WriteLn('Success:');
+    WriteLn(Response);
+  end
+  else begin
+    WriteLn('Failed:');
+    WriteLn(Response);
+  end;
+  WriteLn('Press Enter to exit...');
+  ReadLn; // 等待用户按键,以便查看输出
+
+end.

Tiedoston diff-näkymää rajattu, sillä se on liian suuri
+ 1215 - 0
dyAuth.dproj


+ 20 - 0
dyAuth.dproj.local

@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="utf-8"?>
+<BorlandProject>
+	<Transactions>
+    <Transaction>2026/01/28 11:12:37.000.083,D:\Work\Project1.dproj=D:\Work\dyDigitalPrintersAuthorize_Dll\dyAuth.dproj</Transaction>
+    <Transaction>2026/01/28 12:08:33.000.432,=D:\Work\dyDigitalPrintersAuthorize_Dll\Unit1.pas</Transaction>
+    <Transaction>2026/01/28 12:08:46.000.333,D:\Work\dyDigitalPrintersAuthorize_Dll\Unit1.pas=D:\Work\dyDigitalPrintersAuthorize_Dll\U_CommonData.pas</Transaction>
+    <Transaction>2026/01/29 11:30:48.094,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Attributes.pas</Transaction>
+    <Transaction>2026/01/29 11:30:48.128,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.DynamicTypes.pas</Transaction>
+    <Transaction>2026/01/29 11:30:48.159,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Nullables.pas</Transaction>
+    <Transaction>2026/01/29 11:33:07.191,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Persistence.JSON.pas</Transaction>
+    <Transaction>2026/01/29 11:33:07.244,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Persistence.pas</Transaction>
+    <Transaction>2026/01/29 11:33:07.274,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Persistence.Swagger.pas</Transaction>
+    <Transaction>2026/01/29 11:33:07.321,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Serializers.DB.pas</Transaction>
+    <Transaction>2026/01/29 11:33:07.345,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Serializers.RTL.pas</Transaction>
+    <Transaction>2026/01/29 11:33:21.036,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Serializers.VCL.pas</Transaction>
+    <Transaction>2026/01/29 11:33:21.064,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.TypeInfo.pas</Transaction>
+    <Transaction>2026/01/29 11:33:21.078,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Types.pas</Transaction>
+    <Transaction>2026/01/29 11:33:21.206,=D:\Work\dyDigitalPrintersAuthorize_Dll\Neon.Core.Utils.pas</Transaction>
+  </Transactions>
+</BorlandProject>

BIN
dyAuth.identcache


BIN
dyAuth.res