tvplanit: Add a string as a second datasource to the TVpJSONDatastore (see forum https://forum.lazarus.freepascal.org/index.php/topic,42712.msg298324)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6668 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/datastores/json/project1.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <General>
       <SessionStorage Value="InProjectDir"/>
@@ -17,9 +17,10 @@
       <Version Value="2"/>
     </PublishOptions>
     <RunParams>
-      <local>
-        <FormatVersion Value="1"/>
-      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default"/>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="2">
       <Item1>

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

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.
 

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."

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 ""

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é"

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."

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 ""

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 ""

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}

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 ';

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;