Issue #1482: replace TJsonRegistry with Lazarus' TRegistry implementation, which reads and write an XML config on Linux

heidisql.lpr

@@ -19,7 +19,7 @@ uses
   dbstructures.sqlite, change_password, loginform, data_sorting, extra_controls,
   column_selection, loaddata, csv_detector, createdatabase, editvar, copytable,
   exportgrid, usermanager, selectdbobject, reformatter, searchreplace,
-  connections, jsonregistry, sqlhelp, updatecheck, insertfiles, texteditor,
+  connections, sqlhelp, updatecheck, insertfiles, texteditor,
   customize_highlighter, preferences;
 
 {$R *.res}

source/apphelpers.pas

@@ -8,7 +8,7 @@ uses
   Classes, SysUtils, Generics.Collections, Generics.Defaults, Controls, RegExpr, Math, FileUtil,
   StrUtils, Graphics, GraphUtil, LCLIntf, Forms, Clipbrd, Process, ActnList, Menus, Dialogs,
   Character, DateUtils, laz.VirtualTrees, SynEdit, SynEditHighlighter, EditBtn, ComCtrls, SynCompletion, fphttpclient,
-  dbconnection, dbstructures, jsonregistry;
+  dbconnection, dbstructures, Registry;
 
 type
 
@@ -272,7 +272,7 @@ type
       FBasePath: String;
       FSessionPath: String;
       FStoredPath: String;
-      FRegistry: TJsonRegistry;
+      FRegistry: TRegistry;
       FPortableMode: Boolean;
       FPortableModeReadOnly: Boolean;
       FRestoreTabsInitValue: Boolean;
@@ -291,7 +291,7 @@ type
       procedure Write(Index: TAppSettingIndex; FormatName: String;
         DataType: TAppSettingDataType; I: Integer; B: Boolean; S: String);
     public
-      const PathDelimiter: Char = '/';
+      const PathDelimiter = '\';
       constructor Create;
       destructor Destroy; override;
       function ReadInt(Index: TAppSettingIndex; FormatName: String=''; Default: Integer=0): Integer;
@@ -3525,7 +3525,8 @@ var
 begin
   inherited;
   FDirnameUserAppData := '';
-  FRegistry := TJsonRegistry.Create(DirnameUserAppData + 'settings.json');
+  FRegistry := TRegistry.Create;
+  FRegistry.RootKey := HKEY_CURRENT_USER;
   FReads := 0;
   FWrites := 0;
 
@@ -3567,7 +3568,7 @@ begin
         MessageDlg(E.Message, mtError, [mbOK], 0, mbOK);
     end;
   end else begin
-    FBasePath := PathDelimiter;
+    FBasePath := PathDelimiter + 'Software' + PathDelimiter + APPNAME + PathDelimiter;
     FSettingsFile := '';
   end;
 
@@ -4058,7 +4059,7 @@ begin
   // Note that, contrary to the documentation, .DeleteKey is done even when this key has subkeys
   PrepareRegistry;
   if FSessionPath.IsEmpty then
-     raise Exception.CreateFmt(_('No path set, won''t delete root key %s'), [FRegistry.CurrentPath])
+    raise Exception.CreateFmt(_('No path set, won''t delete root key %s'), [FRegistry.CurrentPath])
   else begin
     KeyPath := AppendDelimiter(REGKEY_SESSIONS) + FSessionPath;
     ResetPath;
@@ -4361,8 +4362,6 @@ begin
     Segments := Explode(LINEDELIMITER, Lines[i]);
     if Segments.Count <> 3 then
       continue;
-    // Windows registry to JSON path delimiter conversion: \ => /
-    Segments[0] := StringReplace(Segments[0], '\', PathDelimiter, [rfReplaceAll]);
     KeyPath := FBasePath + ExtractFilePath(Segments[0]);
     Name := ExtractFileName(Segments[0]);
     DataType := StrToIntDef(Segments[1], 0);
@@ -4378,7 +4377,7 @@ begin
         Value := StringReplace(Value, CHR10REPLACEMENT, #10, [rfReplaceAll]);
         FRegistry.WriteString(Name, Value);
       end;
-      3: // Integer
+      3: // Integer (Delphi definition)
         FRegistry.WriteInteger(Name, MakeInt(Value));
       else
         ErrorDialog(Name+' has an unsupported data type.');
@@ -4392,7 +4391,8 @@ end;
 function TAppSettings.ExportSettings(Filename: String): Boolean;
 var
   Content, Value: String;
-  //DataType: TRegDataType;
+  DataType: TRegDataType;
+  DataTypeInt: Integer;
 
   procedure ReadKeyToContent(Path: String);
   var
@@ -4401,15 +4401,19 @@ var
     SubPath: String;
   begin
     // Recursively read values in keys and their subkeys into "content" variable
-    {FRegistry.OpenKey(Path, True);
+    FRegistry.OpenKey(Path, True);
     SubPath := Copy(Path, Length(FBasePath)+1, MaxInt);
     Names := TStringList.Create;
     FRegistry.GetValueNames(Names);
     for i:=0 to Names.Count-1 do begin
       DataType := FRegistry.GetDataType(Names[i]);
+      DataTypeInt := Integer(DataType);
+      // Delphi uses 3, Lazarus 4
+      if DataTypeInt = 4 then
+        DataTypeInt := 3;
       Content := Content +
-        SubPath + Names[i] + DELIMITER +
+        SubPath + Names[i] + LINEDELIMITER +
-        IntToStr(Integer(DataType)) + DELIMITER;
+        DataTypeInt.ToString + LINEDELIMITER;
       case DataType of
         rdString: begin
           Value := FRegistry.ReadString(Names[i]);
@@ -4426,8 +4430,8 @@ var
     Names.Clear;
     FRegistry.GetKeyNames(Names);
     for i:=0 to Names.Count-1 do
-      ReadKeyToContent(Path + AppendDelimiter(Names[i]));
+      ReadKeyToContent(Path + Names[i] + PathDelimiter);
-    Names.Free;}
+    Names.Free;
   end;
 
 begin

source/jsonregistry.pas

@@ -1,294 +0,0 @@
-unit jsonregistry;
-
-{$mode Delphi}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, jsonConf, fpjson, ExtCtrls;
-
-type
-
-  { TJSONConfigExtended }
-
-  TJSONConfigExtended = class(TJSONConfig)
-    public
-      function AddEndSlash(Path: UnicodeString): UnicodeString;
-      function StripEndSlash(Path: UnicodeString): UnicodeString;
-      procedure MoveKey(SourcePath: UnicodeString; TargetPath: UnicodeString; Delete: Boolean);
-      function DataType(Path: UnicodeString): TJSONtype;
-  end;
-
-  { TJSONRegistry }
-
-  TJsonRegistry = class(TPersistent)
-    private
-      FJsConf: TJSONConfigExtended;
-      FCurrentKeyPath: UnicodeString;
-      FAutoFlushTimer: TTimer;
-      function GetAutoFlushMilliSeconds: Cardinal;
-      procedure SetAutoFlushMilliSeconds(aValue: Cardinal);
-      procedure AutoFlushOnTimer(Sender: TObject);
-    public
-      constructor Create(JsonFilePath: String);
-      destructor Destroy; override;
-      function FilePath: String;
-      // Keys:
-      function OpenKey(Path: UnicodeString; CanCreate: Boolean): Boolean;
-      procedure CloseKey;
-      function DeleteKey(Path: UnicodeString): Boolean;
-      procedure MoveKey(sourcepath: UnicodeString; targetpath: UnicodeString; Delete: Boolean);
-      procedure GetKeyNames(list: TStringList);
-      function CurrentPath: UnicodeString;
-      function KeyExists(path: UnicodeString): Boolean;
-      function HasSubKeys: Boolean;
-      // Values:
-      function DeleteValue(name: UnicodeString): Boolean;
-      procedure GetValueNames(list: TStringList);
-      function ValueExists(name: UnicodeString): Boolean;
-      function ReadInteger(name: UnicodeString): Integer;
-      function ReadBool(name: UnicodeString): Boolean;
-      function ReadString(name: UnicodeString): UnicodeString;
-      procedure WriteInteger(name: UnicodeString; value: Integer);
-      procedure WriteBool(name: UnicodeString; value: Boolean);
-      procedure WriteString(name: UnicodeString; value: UnicodeString);
-      function GetDataType(Path: UnicodeString): TJSONtype;
-
-      property AutoFlushMilliSeconds: Cardinal read GetAutoFlushMilliSeconds write SetAutoFlushMilliSeconds;
-  end;
-
-implementation
-
-{ TJSONConfigExtended }
-
-function TJSONConfigExtended.AddEndSlash(Path: UnicodeString): UnicodeString;
-begin
-  Result := Path;
-  if Result[Length(Result)] <> '/' then
-    Result := Result + '/';
-end;
-
-function TJSONConfigExtended.StripEndSlash(Path: UnicodeString): UnicodeString;
-begin
-  Result := Path;
-  if Result[Length(Result)] = '/' then
-    Delete(Result, Length(Result), 1);
-end;
-
-procedure TJSONConfigExtended.MoveKey(SourcePath: UnicodeString;
-  TargetPath: UnicodeString; Delete: Boolean);
-var
-  OldNode, NewNode, NewNodeParent: TJSONObject;
-  NewNodeName: UnicodeString;
-  TargetPathSlash, TargetPathNoSlash: UnicodeString;
-begin
-
-  if Length(SourcePath) = 0 then
-    Raise EJSONConfigError.Create('Cannot move from empty path');
-  if Length(TargetPath) = 0 then
-    Raise EJSONConfigError.Create('Cannot move to empty path');
-
-  SourcePath := AddEndSlash(SourcePath);
-  OldNode := FindObject(SourcePath, False);
-  if not Assigned(OldNode) then
-    raise EJSONConfigError.CreateFmt('Source path does not exist: %s', [SourcePath]);
-
-  TargetPathSlash := AddEndSlash(TargetPath);
-  TargetPathNoSlash := StripEndSlash(TargetPath);
-  //showmessage('TargetPathSlash:"'+TargetPathSlash+'"'+sLineBreak+'TargetPathNoSlash:"'+TargetPathNoSlash+'"');
-
-  // Error if target exists
-  NewNode := FindObject(TargetPathSlash, False);
-  if Assigned(NewNode) then
-    Raise EJSONConfigError.CreateFmt('Target path already exists: %s', [TargetPathSlash]);
-
-  // Create copied key
-  NewNodeParent := FindObject(TargetPathNoSlash, True, NewNodeName);
-  NewNodeParent.Add(NewNodeName, OldNode.Clone);
-
-  if Delete then begin
-    // Deleting source key. Note we have cloned this before.
-    DeletePath(SourcePath);
-  end;
-
-  FModified:=True;
-end;
-
-function TJSONConfigExtended.DataType(Path: UnicodeString): TJSONtype;
-var
-  e: TJSONData;
-begin
-  e := FindElement(Path, False, True);
-  if Assigned(e) then
-    Result := e.JSONType
-  else
-    Result := jtUnknown;
-end;
-
-
-{ TJsonRegistry }
-
-constructor TJsonRegistry.Create(JsonFilePath: String);
-begin
-  FJsConf := TJSONConfigExtended.Create(nil);
-  FJsConf.Formatted := True;
-  FJsConf.Filename := JsonFilePath;
-  FAutoFlushTimer := TTimer.Create(nil);
-  FAutoFlushTimer.Enabled := False;
-  FAutoFlushTimer.OnTimer := AutoFlushOnTimer;
-  SetAutoFlushMilliSeconds(5000);
-end;
-
-destructor TJsonRegistry.Destroy;
-begin
-  FJsConf.Flush;
-  FAutoFlushTimer.Free;
-end;
-
-function TJsonRegistry.GetAutoFlushMilliSeconds: Cardinal;
-begin
-  Result := FAutoFlushTimer.Interval;
-end;
-
-procedure TJsonRegistry.SetAutoFlushMilliSeconds(aValue: Cardinal);
-begin
-  FAutoFlushTimer.Enabled := False;
-  FAutoFlushTimer.Interval := aValue;
-  FAutoFlushTimer.Enabled := aValue > 0;
-end;
-
-procedure TJsonRegistry.AutoFlushOnTimer(Sender: TObject);
-begin
-  FJsConf.Flush;
-end;
-
-function TJsonRegistry.FilePath: String;
-begin
-  Result := FJsConf.Filename;
-end;
-
-function TJsonRegistry.OpenKey(Path: UnicodeString; CanCreate: Boolean): Boolean;
-begin
-  try
-    FJsConf.OpenKey(Path, CanCreate);
-    FCurrentKeyPath := Path;
-    Result := True;
-  except
-    on EJSONConfigError do begin
-      Result := False;
-    end;
-  end;
-end;
-
-procedure TJsonRegistry.CloseKey;
-begin
-  FJsConf.Flush;
-  FJsConf.CloseKey;
-end;
-
-function TJsonRegistry.DeleteKey(Path: UnicodeString): Boolean;
-begin
-  FJsConf.DeletePath(Path);
-  Result := True;
-end;
-
-procedure TJsonRegistry.MoveKey(sourcepath: UnicodeString; targetpath: UnicodeString; Delete: Boolean);
-begin
-  FJsConf.MoveKey(sourcepath, targetpath, Delete);
-end;
-
-procedure TJsonRegistry.GetKeyNames(list: TStringList);
-begin
-  FJsConf.EnumSubKeys(FCurrentKeyPath, list);
-end;
-
-function TJsonRegistry.CurrentPath: UnicodeString;
-begin
-  Result := FCurrentKeyPath;
-end;
-
-function TJsonRegistry.KeyExists(path: UnicodeString): Boolean;
-var
-  SubKeys: TStringList;
-  LastDelim: Integer;
-  folder, name: UnicodeString;
-begin
-  SubKeys := TStringList.Create;
-  path := FJsConf.StripEndSlash(path);
-  LastDelim := String(path).LastIndexOf('/');
-  name := Copy(path, LastDelim+2);
-  folder := Copy(path, 1, LastDelim);
-  //showmessage('folder:'+folder+sLineBreak+'name:'+name);
-  FJsConf.EnumSubKeys(folder, SubKeys);
-  Result := SubKeys.IndexOf(name) > -1;
-  SubKeys.Free;
-end;
-
-function TJsonRegistry.HasSubKeys: Boolean;
-var
-  SubKeys: TStringList;
-begin
-  SubKeys := TStringList.Create;
-  GetKeyNames(SubKeys);
-  Result := SubKeys.Count > 0;
-  SubKeys.Free;
-end;
-
-function TJsonRegistry.DeleteValue(name: UnicodeString): Boolean;
-begin
-  FJsConf.DeleteValue(name);
-  Result := True;
-end;
-
-procedure TJsonRegistry.GetValueNames(list: TStringList);
-begin
-  FJsConf.EnumValues(FCurrentKeyPath, list);
-end;
-
-function TJsonRegistry.ValueExists(name: UnicodeString): Boolean;
-var
-  Values: TStringList;
-begin
-  Values := TStringList.Create;
-  GetValueNames(Values);
-  Result := Values.IndexOf(name) > -1;
-  Values.Free;
-end;
-
-function TJsonRegistry.ReadInteger(name: UnicodeString): Integer;
-begin
-  Result := FJsConf.GetValue(name, 0);
-end;
-
-function TJsonRegistry.ReadBool(name: UnicodeString): Boolean;
-begin
-  Result := FJsConf.GetValue(name, False);
-end;
-
-function TJsonRegistry.ReadString(name: UnicodeString): UnicodeString;
-begin
-  Result := FJsConf.GetValue(name, '');
-end;
-
-procedure TJsonRegistry.WriteInteger(name: UnicodeString; value: Integer);
-begin
-  FJsConf.SetValue(name, value);
-end;
-
-procedure TJsonRegistry.WriteBool(name: UnicodeString; value: Boolean);
-begin
-  FJsConf.SetValue(name, value);
-end;
-
-procedure TJsonRegistry.WriteString(name: UnicodeString; value: UnicodeString);
-begin
-  FJsConf.SetValue(name, value);
-end;
-
-function TJsonRegistry.GetDataType(Path: UnicodeString): TJSONtype;
-begin
-  Result := FJsConf.DataType(Path);
-end;
-
-end.
-