diff --git a/heidisql.lpr b/heidisql.lpr index 3857f4d3..39a66df3 100644 --- a/heidisql.lpr +++ b/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} diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 941dcb06..34ae7496 100644 --- a/source/apphelpers.pas +++ b/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 + - IntToStr(Integer(DataType)) + DELIMITER; + SubPath + Names[i] + LINEDELIMITER + + 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])); - Names.Free;} + ReadKeyToContent(Path + Names[i] + PathDelimiter); + Names.Free; end; begin diff --git a/source/jsonregistry.pas b/source/jsonregistry.pas deleted file mode 100644 index 6bb30663..00000000 --- a/source/jsonregistry.pas +++ /dev/null @@ -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. -