From ec59c9f130a96b60b9e718e6733ff18a7b1ca06b Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Mon, 27 Sep 2021 18:28:53 +0200 Subject: [PATCH] v2.2 --- samples/01CmdsSample/CmdsSample.dproj | 99 ++++++++++++++++++++------- sources/JsonDataObjects.pas | 98 +++++++++++++++++++++----- tests/RedisClientTests.dproj | 99 +++++++++++++++------------ 3 files changed, 209 insertions(+), 87 deletions(-) diff --git a/samples/01CmdsSample/CmdsSample.dproj b/samples/01CmdsSample/CmdsSample.dproj index 2156288..e248b1c 100644 --- a/samples/01CmdsSample/CmdsSample.dproj +++ b/samples/01CmdsSample/CmdsSample.dproj @@ -7,7 +7,7 @@ 129 Console None - 19.1 + 19.3 Win32 @@ -44,6 +44,12 @@ true true + + true + Cfg_2 + true + true + $(BDS)\bin\delphi_PROJECTICNS.icns CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= @@ -57,6 +63,7 @@ 1040 System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) false + ..\..\sources;$(DCC_UnitSearchPath) $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png @@ -86,6 +93,7 @@ $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= @@ -113,6 +121,7 @@ true true $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(ModuleName);FileDescription=$(ModuleName);ProductName=$(ModuleName) @@ -134,14 +143,15 @@ true /usr/bin/xterm -e "%debuggee%" + + 1033 + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + (None) + MainSource - - Cfg_2 - Base - Base @@ -149,6 +159,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -158,6 +172,12 @@ CmdsSample.dpr + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + False @@ -167,24 +187,20 @@ False - - - true - - CmdsSample true - - + + true - - + + + CmdsSample.exe true @@ -193,9 +209,8 @@ true - - - CmdsSample.exe + + true @@ -209,6 +224,11 @@ true + + + true + + 1 @@ -217,6 +237,16 @@ 0 + + + classes + 64 + + + classes + 64 + + classes @@ -515,6 +545,10 @@ 1 .framework + + 1 + .framework + 0 @@ -528,6 +562,10 @@ 1 .dylib + + 1 + .dylib + 0 .dll;.bpl @@ -554,6 +592,10 @@ 1 .dylib + + 1 + .dylib + 0 .bpl @@ -581,6 +623,9 @@ 0 + + 0 + 0 @@ -1134,6 +1179,10 @@ Contents\Resources 1 + + Contents\Resources + 1 + @@ -1162,6 +1211,9 @@ 1 + + 1 + 0 @@ -1200,16 +1252,17 @@ 1 - + + + + + + + - - - - - 12 diff --git a/sources/JsonDataObjects.pas b/sources/JsonDataObjects.pas index cda1294..3f980b8 100644 --- a/sources/JsonDataObjects.pas +++ b/sources/JsonDataObjects.pas @@ -37,6 +37,9 @@ {$ELSE} {$IF CompilerVersion >= 24.0} // XE3 or newer {$LEGACYIFEND ON} + {$IF CompilerVersion >= 35.0} //11.0 + {$DEFINE USE_NATIVEINT} + {$IFEND} {$IFEND} {$IF CompilerVersion >= 23.0} {$DEFINE HAS_UNIT_SCOPE} @@ -137,6 +140,8 @@ interface SysUtils, Classes; {$ENDIF HAS_UNIT_SCOPE} +{$HPPEMIT '#pragma link "Jsondataobjects"'} + type TJsonBaseObject = class; TJsonObject = class; @@ -367,7 +372,11 @@ TJsonDataValueHelper = record function GetObjectUtcDateTime(const Name: string): TDateTime; inline; function GetObjectBool(const Name: string): Boolean; inline; function GetArray(const Name: string): TJsonArray; inline; + {$IFDEF BCB} + function GetObj(const Name: string): TJsonDataValueHelper; inline; // work around C++Builder Windows.h::GetObject macro + {$ELSE} function GetObject(const Name: string): TJsonDataValueHelper; inline; + {$ENDIF BCB} function GetObjectVariant(const Name: string): Variant; inline; procedure SetObjectString(const Name, Value: string); inline; procedure SetObjectInt(const Name: string; const Value: Integer); inline; @@ -443,7 +452,7 @@ TJsonDataValueHelper = record // Used to auto create arrays property A[const Name: string]: TJsonArray read GetArray write SetArray; // Used to auto create objects and as default property where no Implicit operator matches - property O[const Name: string]: TJsonDataValueHelper read GetObject write SetObject; default; + property O[const Name: string]: TJsonDataValueHelper read {$IFDEF BCB}GetObj{$ELSE}GetObject{$ENDIF} write SetObject; default; property V[const Name: string]: Variant read GetObjectVariant write SetObjectVariant; property Path[const Name: string]: TJsonDataValueHelper read GetObjectPath write SetObjectPath; @@ -543,7 +552,7 @@ TStreamInfo = record // ToString() returns a compact JSON string function ToString: string; override; - function Clone: TJsonBaseObject; virtual; abstract; + function Clone: TJsonBaseObject; class function JSONToDateTime(const Value: string; ConvertToLocalTime: Boolean = True): TDateTime; static; class function DateTimeToJSON(const Value: TDateTime; UseUtcTime: Boolean): string; static; @@ -580,7 +589,11 @@ TJsonArray = class {$IFDEF USE_FAST_NEWINSTANCE}sealed{$ENDIF}(TJsonBaseObject function GetUtcDateTime(Index: Integer): TDateTime; inline; function GetBool(Index: Integer): Boolean; inline; function GetArray(Index: Integer): TJsonArray; inline; + {$IFDEF BCB} + function GetObj(Index: Integer): TJsonObject; inline; + {$ELSE} function GetObject(Index: Integer): TJsonObject; inline; + {$ENDIF BCB} function GetVariant(Index: Integer): Variant; inline; procedure SetString(Index: Integer; const Value: string); inline; @@ -620,7 +633,7 @@ TJsonArray = class {$IFDEF USE_FAST_NEWINSTANCE}sealed{$ENDIF}(TJsonBaseObject function ExtractArray(Index: Integer): TJsonArray; function ExtractObject(Index: Integer): TJsonObject; procedure Assign(ASource: TJsonArray); - function Clone: TJsonBaseObject; override; + function Clone: TJsonArray; procedure Add(const AValue: string); overload; procedure Add(const AValue: Integer); overload; @@ -668,7 +681,7 @@ TJsonArray = class {$IFDEF USE_FAST_NEWINSTANCE}sealed{$ENDIF}(TJsonBaseObject property DUtc[Index: Integer]: TDateTime read GetUtcDateTime write SetUtcDateTime; property B[Index: Integer]: Boolean read GetBool write SetBool; property A[Index: Integer]: TJsonArray read GetArray write SetArray; - property O[Index: Integer]: TJsonObject read GetObject write SetObject; + property O[Index: Integer]: TJsonObject read {$IFDEF BCB}GetObj{$ELSE}GetObject{$ENDIF} write SetObject; property V[Index: Integer]: Variant read GetVariant write SetVariant; property Items[Index: Integer]: PJsonDataValue read GetItem; @@ -719,7 +732,11 @@ TJsonObject = class {$IFDEF USE_FAST_NEWINSTANCE}sealed{$ENDIF}(TJsonBaseObjec function GetFloat(const Name: string): Double; function GetDateTime(const Name: string): TDateTime; function GetUtcDateTime(const Name: string): TDateTime; + {$IFDEF BCB} + function GetObj(const Name: string): TJsonObject; + {$ELSE} function GetObject(const Name: string): TJsonObject; + {$ENDIF BCB} function GetArray(const Name: string): TJsonArray; procedure SetString(const Name, Value: string); procedure SetBool(const Name: string; const Value: Boolean); @@ -769,7 +786,7 @@ TJsonObject = class {$IFDEF USE_FAST_NEWINSTANCE}sealed{$ENDIF}(TJsonBaseObjec public destructor Destroy; override; procedure Assign(ASource: TJsonObject); - function Clone: TJsonBaseObject; override; + function Clone: TJsonObject; // ToSimpleObject() maps the JSON object properties to the Delphi object by using the object's // TypeInfo. @@ -805,7 +822,7 @@ TJsonObject = class {$IFDEF USE_FAST_NEWINSTANCE}sealed{$ENDIF}(TJsonBaseObjec property DUtc[const Name: string]: TDateTime read GetUtcDateTime write SetUtcDateTime; // returns 0 if property doesn't exist, auto type-cast except for array/object property B[const Name: string]: Boolean read GetBool write SetBool; // returns false if property doesn't exist, auto type-cast with "<>'true'" and "<>0" except for array/object property A[const Name: string]: TJsonArray read GetArray write SetArray; // auto creates array on first access - property O[const Name: string]: TJsonObject read GetObject write SetObject; // auto creates object on first access + property O[const Name: string]: TJsonObject read {$IFDEF BCB}GetObj{$ELSE}GetObject{$ENDIF} write SetObject; // auto creates object on first access property Path[const NamePath: string]: TJsonDataValueHelper read GetPath write SetPath; @@ -1064,7 +1081,7 @@ TJsonUTF8StringStream = class(TMemoryStream) private FDataString: UTF8String; protected - function Realloc(var NewCapacity: Longint): Pointer; override; + function Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; override; public constructor Create; property DataString: UTF8String read FDataString; @@ -1075,7 +1092,7 @@ TJsonBytesStream = class(TMemoryStream) private FBytes: TBytes; protected - function Realloc(var NewCapacity: Longint): Pointer; override; + function Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; override; public constructor Create; property Bytes: TBytes read FBytes; @@ -1139,7 +1156,7 @@ procedure InitializeJsonMemInfo; if VirtualQuery(PByte(MainInstance + $1000), MemInfo, SizeOf(MemInfo)) = SizeOf(MemInfo) then begin JsonMemInfoMainBlockStart := MemInfo.AllocationBase; - JsonMemInfoMainBlockEnd := JsonMemInfoBlockStart + MemInfo.RegionSize; + JsonMemInfoMainBlockEnd := JsonMemInfoMainBlockStart + MemInfo.RegionSize; end; end; end; @@ -1439,6 +1456,14 @@ class function TJsonBaseObject.UtcDateTimeToJSON(const UtcDateTime: TDateTime): [Year, Month, Day, Hour, Minute, Second, Milliseconds]); end; +function TJsonBaseObject.Clone: TJsonBaseObject; +begin + if Self is TJsonArray then + Result := TJsonArray(Self).Clone + else + Result := TJsonObject(Self).Clone; +end; + class function TJsonBaseObject.DateTimeToJSON(const Value: TDateTime; UseUtcTime: Boolean): string; {$IFDEF MSWINDOWS} var @@ -1574,7 +1599,7 @@ class function TJsonBaseObject.JSONToDateTime(const Value: string; ConvertToLoca P := ParseDateTimePart(P + 1, MSec, 3); end; Result := Result + EncodeTime(Hour, Min, Sec, MSec); - if P^ <> 'Z' then + if (P^ <> 'Z') and (P^ <> #0) then begin if (P^ = '+') or (P^ = '-') then begin @@ -3777,6 +3802,16 @@ function TJsonArray.GetBool(Index: Integer): Boolean; Result := FItems[Index].BoolValue; end; +{$IFDEF BCB} +function TJsonArray.GetObj(Index: Integer): TJsonObject; +begin + {$IFDEF CHECK_ARRAY_INDEX} + if Cardinal(Index) >= Cardinal(FCount) then + RaiseListError(Index); + {$ENDIF CHECK_ARRAY_INDEX} + Result := FItems[Index].ObjectValue; +end; +{$ELSE} function TJsonArray.GetObject(Index: Integer): TJsonObject; begin {$IFDEF CHECK_ARRAY_INDEX} @@ -3785,6 +3820,7 @@ function TJsonArray.GetObject(Index: Integer): TJsonObject; {$ENDIF CHECK_ARRAY_INDEX} Result := FItems[Index].ObjectValue; end; +{$ENDIF BCB} function TJsonArray.GetVariant(Index: Integer): Variant; begin @@ -4298,7 +4334,7 @@ procedure TJsonArray.Assign(ASource: TJsonArray); end; end; -function TJsonArray.Clone: TJsonBaseObject; +function TJsonArray.Clone: TJsonArray; begin Result := TJsonArray.Create; try @@ -4613,6 +4649,23 @@ function TJsonObject.GetUtcDateTime(const Name: string): TDateTime; Result := 0; end; +{$IFDEF BCB} +function TJsonObject.GetObj(const Name: string): TJsonObject; +var + Item: PJsonDataValue; +begin + if FindItem(Name, Item) then + Result := Item.ObjectValue + else + begin + Result := TJsonObject.Create; + AddItem(Name).ObjectValue := Result; + {$IFDEF USE_LAST_NAME_STRING_LITERAL_CACHE} + UpdateLastValueItem(Name, Item); + {$ENDIF USE_LAST_NAME_STRING_LITERAL_CACHE} + end; +end; +{$ELSE} function TJsonObject.GetObject(const Name: string): TJsonObject; var Item: PJsonDataValue; @@ -4628,6 +4681,7 @@ function TJsonObject.GetObject(const Name: string): TJsonObject; {$ENDIF USE_LAST_NAME_STRING_LITERAL_CACHE} end; end; +{$ENDIF BCB} function TJsonObject.GetString(const Name: string): string; var @@ -5193,7 +5247,7 @@ procedure TJsonObject.Assign(ASource: TJsonObject); end; end; -function TJsonObject.Clone: TJsonBaseObject; +function TJsonObject.Clone: TJsonObject; begin Result := TJsonObject.Create; try @@ -6161,7 +6215,7 @@ function ParseUInt64Utf8(P, EndP: PByte): UInt64; Inc(P); while P < EndP do begin - Result := Result * 10 + (P^ - Byte(Ord('0'))); + Result := Result * 10 + Byte(P^ - Byte(Ord('0'))); Inc(P); end; end; @@ -6688,7 +6742,7 @@ function ParseUInt64(P, EndP: PWideChar): UInt64; Inc(P); while P < EndP do begin - Result := Result * 10 + (Ord(P^) - Ord('0')); + Result := Result * 10 + Byte(Ord(P^) - Ord('0')); Inc(P); end; end; @@ -7774,10 +7828,17 @@ function TJsonDataValueHelper.GetArray(const Name: string): TJsonArray; Result := ObjectValue.A[Name]; end; +{$IFDEF BCB} +function TJsonDataValueHelper.GetObj(const Name: string): TJsonDataValueHelper; +begin + Result := ObjectValue.Values[Name]; +end; +{$ELSE} function TJsonDataValueHelper.GetObject(const Name: string): TJsonDataValueHelper; begin Result := ObjectValue.Values[Name]; end; +{$ENDIF BCB} function TJsonDataValueHelper.GetObjectVariant(const Name: string): Variant; begin @@ -8175,9 +8236,9 @@ constructor TJsonUTF8StringStream.Create; SetPointer(nil, 0); end; -function TJsonUTF8StringStream.Realloc(var NewCapacity: Longint): Pointer; +function TJsonUTF8StringStream.Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; var - L: Longint; + L: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}; begin if NewCapacity <> Capacity then begin @@ -8213,9 +8274,9 @@ constructor TJsonBytesStream.Create; SetPointer(nil, 0); end; -function TJsonBytesStream.Realloc(var NewCapacity: Longint): Pointer; +function TJsonBytesStream.Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; var - L: Longint; + L: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}; begin if NewCapacity <> Capacity then begin @@ -8260,4 +8321,3 @@ initialization JSONFormatSettings.DecimalSeparator := '.'; end. - diff --git a/tests/RedisClientTests.dproj b/tests/RedisClientTests.dproj index 7148305..fe5b659 100644 --- a/tests/RedisClientTests.dproj +++ b/tests/RedisClientTests.dproj @@ -1,7 +1,7 @@  {7843B265-EF0B-481C-9CF2-1FD021717D89} - 19.2 + 19.3 None True Debug @@ -23,16 +23,6 @@ Base true - - true - Base - true - - - true - Base - true - true Base @@ -132,18 +122,6 @@ true $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png - - CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers - iPhoneAndiPad - true - Debug - $(MSBuildProjectName) - - - CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers - iPhoneAndiPad - true - None dcu @@ -192,10 +170,6 @@ - - Cfg_2 - Base - Base @@ -203,6 +177,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -220,23 +198,18 @@ - - - true - - RedisClientTests.exe true - - + + true - + true @@ -246,8 +219,8 @@ true - - + + true @@ -256,6 +229,11 @@ true + + + true + + 1 @@ -264,6 +242,16 @@ 0 + + + classes + 64 + + + classes + 64 + + classes @@ -563,6 +551,10 @@ 1 .framework + + 1 + .framework + 0 @@ -576,6 +568,10 @@ 1 .dylib + + 1 + .dylib + 0 .dll;.bpl @@ -602,6 +598,10 @@ 1 .dylib + + 1 + .dylib + 0 .bpl @@ -629,6 +629,9 @@ 0 + + 0 + 0 @@ -1182,6 +1185,10 @@ Contents\Resources 1 + + Contents\Resources + 1 + @@ -1210,6 +1217,9 @@ 1 + + 1 + 0 @@ -1248,22 +1258,21 @@ 1 - + + + + + + - + - - - - False False - False - False False True False