diff --git a/components/tvplanit/examples/datastores/json/project1.lpi b/components/tvplanit/examples/datastores/json/project1.lpi index 4f661d701..31e45ec8a 100644 --- a/components/tvplanit/examples/datastores/json/project1.lpi +++ b/components/tvplanit/examples/datastores/json/project1.lpi @@ -1,7 +1,7 @@ - + @@ -17,9 +17,10 @@ - - - + + + + diff --git a/components/tvplanit/examples/datastores/json/unit1.lfm b/components/tvplanit/examples/datastores/json/unit1.lfm index 7ca4bacbf..f0b3d0b11 100644 --- a/components/tvplanit/examples/datastores/json/unit1.lfm +++ b/components/tvplanit/examples/datastores/json/unit1.lfm @@ -7,7 +7,7 @@ object Form1: TForm1 ClientHeight = 686 ClientWidth = 980 OnCreate = FormCreate - LCLVersion = '1.9.0.0' + LCLVersion = '2.1.0.0' object Panel1: TPanel Left = 0 Height = 33 @@ -170,7 +170,6 @@ object Form1: TForm1 Align = alBottom TabStop = True TabOrder = 1 - KBNavigation = True DateLabelFormat = 'mmmm yyyy' DayHeadAttributes.Font.Height = -13 DayHeadAttributes.Font.Name = 'Tahoma' @@ -181,6 +180,7 @@ object Form1: TForm1 EventDayStyle = [] EventFont.Height = -12 HeadAttributes.Color = clBtnFace + KBNavigation = True OffDayColor = clSilver SelectedDayColor = clRed ShowEvents = True @@ -295,7 +295,7 @@ object Form1: TForm1 top = 264 end object VpResourceEditDialog1: TVpResourceEditDialog - Version = 'v1.08' + Version = 'v1.12' DataStore = VpJSONDataStore1 Options = [] Placement.Position = mpCenter @@ -335,6 +335,7 @@ object Form1: TForm1 HiddenCategories.Color = clGray EnableEventTimer = True PlayEventSounds = True + OnDisconnect = VpJSONDataStore1Disconnect FileName = 'data.json' left = 136 top = 192 diff --git a/components/tvplanit/examples/datastores/json/unit1.pas b/components/tvplanit/examples/datastores/json/unit1.pas index 63431e7e0..fd3fbd2bc 100644 --- a/components/tvplanit/examples/datastores/json/unit1.pas +++ b/components/tvplanit/examples/datastores/json/unit1.pas @@ -2,6 +2,10 @@ unit Unit1; {$mode objfpc}{$H+} +{ Activate this define to use a JSON string instead of a file } + +{$DEFINE USE_JSON_STRING} + interface uses @@ -39,6 +43,7 @@ type procedure BtnNewResClick(Sender: TObject); procedure BtnEditResClick(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure VpJSONDataStore1Disconnect(Sender: TObject); private { private declarations } public @@ -78,6 +83,12 @@ var lastRes: TVpResource; datastore: TVpCustomDatastore; begin + {$IFDEF USE_JSON_STRING} + VpJSONDataStore1.FileName := ''; + VpJSONDataStore1.JSONString := '{"Resources":[{"ResourceID":1178568021,"Description":"TEST","Notes":"","ResourceActive":true,"UserField0":"","UserField1":"","UserField2":"","UserField3":"","UserField4":"","UserField5":"","UserField6":"","UserField7":"","UserField8":"","UserField9":"","Events":[{"RecordID":1273124118,"Description":"teset","Notes":"","Location":"test test","Category":0,"AllDayEvent":false,"StartTime":"2018-09-30 08:00:00","EndTime":"2018-09-30 08:30:00","DingPath":"","AlertDisplayed":false,"AlarmSet":false,"AlarmAdvance":15,"AlarmAdvanceType":0,"SnoozeTime":"00:00:00","RepeatCode":0,"RepeatRangeEnd":"","CustomInterval":0,"UserField0":"","UserField1":"","UserField2":"","UserField3":"","UserField4":"","UserField5":"","UserField6":"","UserField7":"","UserField8":"","UserField9":""}]}]}'; + VpJSONDataStore1.JSONStoreType := jstString; + {$ENDIF} + datastore := VpControlLink1.Datastore; datastore.Connected := true; if datastore.Resources.Count > 0 then @@ -87,5 +98,11 @@ begin end; end; +procedure TForm1.VpJSONDataStore1Disconnect(Sender: TObject); +begin + if VpJSONDatastore1.JSONStoreType = jstString then + ShowMessage(VpJSONDatastore1.JSONString); +end; + end. diff --git a/components/tvplanit/languages/vpsr.de.po b/components/tvplanit/languages/vpsr.de.po index c76d70189..d48d003d8 100644 --- a/components/tvplanit/languages/vpsr.de.po +++ b/components/tvplanit/languages/vpsr.de.po @@ -735,6 +735,10 @@ msgstr "Intervall nicht angegeben." msgid "Error: No datastore filename specified." msgstr "Fehler: Datastore-Dateiname nicht angegeben." +#: vpsr.rsnojsonstringspecified +msgid "No JSON string specified." +msgstr "" + #: vpsr.rsnolocalizationfile msgid "Localization file not found." msgstr "Sprachdatei nicht gefunden." diff --git a/components/tvplanit/languages/vpsr.fi.po b/components/tvplanit/languages/vpsr.fi.po index 9a2ae12d0..de4873180 100644 --- a/components/tvplanit/languages/vpsr.fi.po +++ b/components/tvplanit/languages/vpsr.fi.po @@ -726,6 +726,10 @@ msgstr "" msgid "Error: No datastore filename specified." msgstr "" +#: vpsr.rsnojsonstringspecified +msgid "No JSON string specified." +msgstr "" + #: vpsr.rsnolocalizationfile msgid "Localization file not found." msgstr "" diff --git a/components/tvplanit/languages/vpsr.fr.po b/components/tvplanit/languages/vpsr.fr.po index 8b2012abc..08ff407a7 100644 --- a/components/tvplanit/languages/vpsr.fr.po +++ b/components/tvplanit/languages/vpsr.fr.po @@ -741,6 +741,10 @@ msgstr "" msgid "Error: No datastore filename specified." msgstr "" +#: vpsr.rsnojsonstringspecified +msgid "No JSON string specified." +msgstr "" + #: vpsr.rsnolocalizationfile msgid "Localization file not found." msgstr "Fichier de localization non-trouvé" diff --git a/components/tvplanit/languages/vpsr.nl.po b/components/tvplanit/languages/vpsr.nl.po index 785b3ac3b..a5c1272d6 100644 --- a/components/tvplanit/languages/vpsr.nl.po +++ b/components/tvplanit/languages/vpsr.nl.po @@ -735,6 +735,10 @@ msgstr "" msgid "Error: No datastore filename specified." msgstr "" +#: vpsr.rsnojsonstringspecified +msgid "No JSON string specified." +msgstr "" + #: vpsr.rsnolocalizationfile msgid "Localization file not found." msgstr "Vertalingenbestand niet gevonden." diff --git a/components/tvplanit/languages/vpsr.po b/components/tvplanit/languages/vpsr.po index 9079544e7..1a8a0968b 100644 --- a/components/tvplanit/languages/vpsr.po +++ b/components/tvplanit/languages/vpsr.po @@ -725,6 +725,10 @@ msgstr "" msgid "Error: No datastore filename specified." msgstr "" +#: vpsr.rsnojsonstringspecified +msgid "No JSON string specified." +msgstr "" + #: vpsr.rsnolocalizationfile msgid "Localization file not found." msgstr "" diff --git a/components/tvplanit/languages/vpsr.ru.po b/components/tvplanit/languages/vpsr.ru.po index 56bf414c2..95b61075e 100644 --- a/components/tvplanit/languages/vpsr.ru.po +++ b/components/tvplanit/languages/vpsr.ru.po @@ -735,6 +735,10 @@ msgstr "" msgid "Error: No datastore filename specified." msgstr "" +#: vpsr.rsnojsonstringspecified +msgid "No JSON string specified." +msgstr "" + #: vpsr.rsnolocalizationfile msgid "Localization file not found." msgstr "" diff --git a/components/tvplanit/source/design/vpreg.pas b/components/tvplanit/source/design/vpreg.pas index c974755e0..d48f6b49e 100644 --- a/components/tvplanit/source/design/vpreg.pas +++ b/components/tvplanit/source/design/vpreg.pas @@ -54,7 +54,7 @@ type { TVpCategoryInfoImageIndexProperty } TVpCategoryInfoImageIndexProperty = class(TImageIndexPropertyEditor) protected - function GetImageList: TCustomImageList; overload; + function GetImageList: TCustomImageList; override; //overload; -- typo? end; {TDBStringProperty} diff --git a/components/tvplanit/source/include/vpsr.inc b/components/tvplanit/source/include/vpsr.inc index e68e90d27..1c546623e 100644 --- a/components/tvplanit/source/include/vpsr.inc +++ b/components/tvplanit/source/include/vpsr.inc @@ -414,6 +414,9 @@ resourcestring { Ini storage } RSIniFileStructure = 'Incorrect structure of ini file.'; + { JSON storage } + RSNoJsonStringSpecified = 'No JSON string specified.'; + { XML } sIENotInstalled = 'Cannot open WININET, Microsoft IE required'; sOpenFileFailed = 'Unable to open file '; diff --git a/components/tvplanit/source/vpjsonds.pas b/components/tvplanit/source/vpjsonds.pas index 6b8748463..ceab4c81b 100644 --- a/components/tvplanit/source/vpjsonds.pas +++ b/components/tvplanit/source/vpjsonds.pas @@ -11,11 +11,20 @@ uses VpData, VpBaseDS; type + TVpJSONStoreType = (jstFile, jstString); + TVpJSONDataStore = class(TVpCustomDataStore) private FFileName: String; + FJSONString: String; FFormatSettings: TFormatSettings; + FUseUTF8: Boolean; + FStrict: Boolean; + FComments: Boolean; + FIgnoreTrailingComma: Boolean; + FStoreType: TVpJSONStoreType; procedure SetFilename(AValue: String); + procedure SetJSONString(AValue: String); protected { ancestor methods } @@ -34,7 +43,12 @@ type function JSONToTask(AObj: TJSONObject; AResource: TVpResource): TVpTask; procedure ReadJSON; + procedure ReadJSONFromFile; + procedure ReadJSONFromString; + procedure ReadJSONFromStream(AStream: TStream); + procedure WriteJSON; + procedure WriteJSONToMemoryStream(AStream: TMemoryStream); { other methods } function UniqueID(AValue: Integer): Boolean; @@ -58,7 +72,20 @@ type published property AutoConnect default false; + {Determines whether data are read from/written to file or string} + property JSONStoreType: TVpJSONStoreType read FStoreType write FStoreType default jstFile; + { Name of the file to be used when JSONStoreType is jstFile } property FileName: String read FFileName write SetFilename; + { String to be used when TJSONStoreType is jstString } + property JSONString: String read FJSONString write SetJSONString; + { JSON options } + property JSONUseUTF8: Boolean read FUseUTF8 write FUseUTF8 default true; + {$IF FPC_FullVersion >= 30000} + property JSONStrict: Boolean read FStrict write FStrict default false; + property JSONComments: Boolean read FComments write FComments default false; + property JSONIgnoreTrailingComma: Boolean read FIgnoreTrailingComma write FIgnoreTrailingComma default false; + {$IFEND} + end; @@ -84,6 +111,8 @@ begin FFormatSettings.TimeSeparator := ':'; FDayBuffer := 1000*365; // 1000 years, i.e. deactivate daybuffer mechanism + + FUseUTF8 := true; end; destructor TVpJSONDatastore.Destroy; @@ -467,15 +496,16 @@ begin end; procedure TVpJSONDatastore.ReadJSON; +begin + case FStoreType of + jstFile : ReadJSONFromFile; + jstString : ReadJSONFromString; + end; +end; + +procedure TVpJSONDatastore.ReadJSONFromFile; var - p: TJSONParser; stream: TFileStream; - json: TJSONObject; - resObj: TJSONObject; - resObjArray: TJSONArray; - objArray: TJSONArray; - res: TVpResource; - i, j: Integer; begin if (FFileName = '') then raise Exception.Create(RSNoFilenameSpecified); @@ -485,43 +515,81 @@ begin stream := TFileStream.Create(FFilename, fmOpenRead + fmShareDenyWrite); try - Resources.ClearResources; - {$IF FPC_FullVersion >= 30000} - p := TJSONParser.Create(stream, [joUTF8]); - {$ELSE} - p := TJSONParser.Create(stream, true); - {$ENDIF} - try - json := p.Parse as TJSONObject; - resObjArray := json.Find('Resources', jtArray) as TJSONArray; - if Assigned(resObjArray) then - for i := 0 to resObjArray.Count-1 do begin - resObj := resObjArray.Objects[i]; - res := JSONToResource(resObj); - // Extract events - objArray := resObj.Find('Events', jtArray) as TJSONArray; - if Assigned(objArray) then - for j := 0 to objArray.Count-1 do - JSONToEvent(objArray.Objects[j], res); - // Extract contacts - objArray := resObj.Find('Contacts', jtArray) as TJSONArray; - if Assigned(objArray) then - for j := 0 to objArray.Count-1 do - JSONToContact(objArray.Objects[j], res); - // Extract tasks - objArray := resObj.Find('Tasks', jtArray) as TJSONArray; - if Assigned(objArray) then - for j := 0 to objArray.Count - 1 do - JSONToTask(objArray.Objects[j], res); - end; - finally - p.Free; - end; + ReadJSONFromStream(stream); finally stream.Free; end; end; +procedure TVpJSONDatastore.ReadJSONFromString; +var + stream: TStringStream; +begin + if FJSONString = '' then + raise Exception.Create(RSNoJSONStringSpecified); + + stream := TStringStream.Create(FJSONString); + try + ReadJSONFromStream(stream); + finally + stream.Free; + end; +end; + +procedure TVpJSONDatastore.ReadJSONFromStream(AStream: TStream); +var + p: TJSONParser; + json: TJSONObject; + resObj: TJSONObject; + resObjArray: TJSONArray; + objArray: TJSONArray; + res: TVpResource; + i, j: Integer; + {$IF FPC_FullVersion >= 30000} + options: TJSONOptions; + {$IFEND} +begin + Resources.ClearResources; + {$IF FPC_FullVersion >= 30000} + options := []; + if FUseUTF8 then options := options + [joUTF8]; + if FStrict then options := options + [joStrict]; + if FComments then options := options + [joComments]; + if FIgnoreTrailingComma then options := options + [joIgnoreTrailingComma]; + p := TJSONParser.Create(AStream, options); + {$ELSE} + p := TJSONParser.Create(AStream, FUseUTF8); + {$IFEND} + try + json := p.Parse as TJSONObject; + if json = nil then + exit; + resObjArray := json.Find('Resources', jtArray) as TJSONArray; + if Assigned(resObjArray) then + for i := 0 to resObjArray.Count-1 do begin + resObj := resObjArray.Objects[i]; + res := JSONToResource(resObj); + // Extract events + objArray := resObj.Find('Events', jtArray) as TJSONArray; + if Assigned(objArray) then + for j := 0 to objArray.Count-1 do + JSONToEvent(objArray.Objects[j], res); + // Extract contacts + objArray := resObj.Find('Contacts', jtArray) as TJSONArray; + if Assigned(objArray) then + for j := 0 to objArray.Count-1 do + JSONToContact(objArray.Objects[j], res); + // Extract tasks + objArray := resObj.Find('Tasks', jtArray) as TJSONArray; + if Assigned(objArray) then + for j := 0 to objArray.Count - 1 do + JSONToTask(objArray.Objects[j], res); + end; + finally + p.Free; + end; +end; + function TVPJSONDatastore.ResourceToJSON(AResource: TVpResource): TJSONObject; begin Result := TJSONObject.Create; @@ -583,7 +651,17 @@ begin if Connected then raise Exception.Create('The datastore must not be connected when the filename is set.'); FFileName := AValue; - if AutoConnect then ReadJSON; + if AutoConnect then Connected := true; +end; + +procedure TVpJSONDatastore.SetJSONString(AValue: String); +begin + if AValue = FJSONString then + exit; + if Connected then + raise Exception.Create('The datastore must not be connected when the JSON string is set.'); + FJSONString := AValue; + if AutoConnect then Connected := true; end; function TVPJSONDatastore.TaskToJSON(ATask: TVpTask): TJSONObject; @@ -641,6 +719,31 @@ begin end; procedure TVpJSONDatastore.WriteJSON; +var + stream: TMemoryStream; +begin + stream := TMemoryStream.Create; + try + WriteJSONToMemoryStream(stream); + case FStoreType of + jstFile: + begin + stream.Position := 0; + stream.SaveToFile(FFileName); + end; + jstString: + begin + stream.Position := 0; + SetLength(FJSONString, stream.Size); + stream.Read(FJSONString[1], Length(FJSONString)) + end; + end; + finally + stream.Free; + end; +end; + +procedure TVpJSONDatastore.WriteJSONToMemoryStream(AStream: TMemoryStream); var json: TJSONObject; resObj: TJSONObject; @@ -650,13 +753,12 @@ var cont: TVpContact; task: TvpTask; i, j: Integer; - stream: TStream; {$IF FPC_FullVersion < 30000} s: TJSONStringType; {$ENDIF} begin - if FFilename = '' then - raise Exception.Create(RSNoFilenameSpecified); + if AStream = nil then + raise Exception.Create('No stream specified'); if not Connected then exit; @@ -714,17 +816,13 @@ begin end; end; - stream := TFileStream.Create(FFilename, fmCreate); - try - {$IF FPC_FULLVERSION < 030000} - s := json.FormatJSON; - stream.Write(s[1], Length(s)); - {$ELSE} - json.DumpJSON(stream); - {$ENDIF} - finally - stream.Free; - end; + {$IF FPC_FULLVERSION < 030000} + s := json.FormatJSON; + AStream.Write(s[1], Length(s)); + {$ELSE} + json.DumpJSON(AStream); + {$ENDIF} + finally json.Free; end;