opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-26 11:17:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

Issue #1482: migrate away from ini files in TAppSettings, use a new approach based on TJSONConf which better syncs with the Windows based TRegistry object

Browse Source
This commit is contained in:
Ansgar Becker
2025-03-19 12:36:28 +01:00
parent 5adb1e7808
commit 071ccfd724
7 changed files with 434 additions and 169 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
heidisql.lpi
View File

@ -225,6 +225,10 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="source\jsonregistry.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

2
heidisql.lpr
View File

@ -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 {, printlist (EnablePrint not defined) }
connections, jsonregistry {, printlist (EnablePrint not defined) }
;
{$R *.res}

173
source/apphelpers.pas
View File

@ -7,8 +7,8 @@ interface
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, EditBtn, ComCtrls, SynCompletion, IniFiles,
dbconnection, dbstructures;
Character, DateUtils, laz.VirtualTrees, SynEdit, EditBtn, ComCtrls, SynCompletion,
dbconnection, dbstructures, jsonregistry;
type
@ -187,7 +187,6 @@ type
//TSimpleKeyValuePairs = TDictionary<String, String>;
TStringInifileDict = TDictionary<String, TIniFile>;
TAppSettingDataType = (adInt, adBool, adString);
TAppSettingIndex = (asHiddenColumns, asFilter, asSort, asDisplayedColumnsSorted, asLastSessions,
asLastActiveSession, asAutoReconnect, asRestoreLastUsedDB, asLastUsedDB, asTreeBackground, asIgnoreDatabasePattern, asLogFileDdl, asLogFileDml, asLogFilePath,
@ -265,19 +264,15 @@ type
private
FReads, FWrites: Integer;
FBasePath: String;
FSessionsBasePath: String;
FSessionPath: String;
FStoredPath: String;
FIniFiles: TStringInifileDict;
FCurrentInifile: TIniFile;
FCurrentInifileSection: String;
FRegistry: TJsonRegistry;
FPortableMode: Boolean;
FPortableModeReadOnly: Boolean;
FRestoreTabsInitValue: Boolean;
FSettingsFile: String;
FSettings: Array[TAppSettingIndex] of TAppSetting;
const FPortableLockFileBase: String='portable.lock';
const FMainSection: String='main';
procedure InitSetting(Index: TAppSettingIndex; Name: String;
DefaultInt: Integer=0; DefaultBool: Boolean=False; DefaultString: String='';
Session: Boolean=False);
@ -288,9 +283,8 @@ type
DI: Integer; DB: Boolean; DS: String);
procedure Write(Index: TAppSettingIndex; FormatName: String;
DataType: TAppSettingDataType; I: Integer; B: Boolean; S: String);
function EscapeLinebreaks(S: String): String;
function UnescapeLinebreaks(S: String): String;
public
const Delimiter: Char = '/';
constructor Create;
destructor Destroy; override;
function ReadInt(Index: TAppSettingIndex; FormatName: String=''; Default: Integer=0): Integer;
@ -313,7 +307,7 @@ type
procedure GetSessionPaths(ParentPath: String; var Sessions: TStringList);
function DeleteValue(Index: TAppSettingIndex; FormatName: String=''): Boolean; overload;
function DeleteValue(ValueName: String): Boolean; overload;
procedure DeleteSection(Section: String);
procedure DeleteCurrentKey;
procedure MoveCurrentKey(TargetPath: String);
function ValueExists(Index: TAppSettingIndex): Boolean;
function SessionPathExists(SessionPath: String): Boolean;
@ -336,7 +330,7 @@ type
function DirnameHighlighters: String;
// "Static" options, initialized in OnCreate only. For settings which need a restart to take effect.
property RestoreTabsInitValue: Boolean read FRestoreTabsInitValue;
procedure SetCurrentSection(Section: String='');
function AppendDelimiter(Path: String): String;
end;
{$I const.inc}
@ -3573,9 +3567,7 @@ var
NewFileHandle: THandle;
begin
inherited;
FIniFiles := TStringInifileDict.Create;
FCurrentInifile := nil;
FCurrentInifileSection := '';
FRegistry := TJsonRegistry.Create(DirnameUserAppData + 'settings.json');
FReads := 0;
FWrites := 0;
@ -3605,7 +3597,7 @@ begin
if FPortableMode then begin
// Create file if only the lock file exists
{if not FileExists(FSettingsFile) then begin
if not FileExists(FSettingsFile) then begin
NewFileHandle := FileCreate(FSettingsFile);
FileClose(NewFileHandle);
end;
@ -3615,10 +3607,9 @@ begin
except
on E:Exception do
MessageDlg(E.Message, mtError, [mbOK], 0, mbOK);
end;}
end;
end else begin
FBasePath := DirnameUserAppData;
FSessionsBasePath := DirnameUserAppData + REGKEY_SESSIONS + DirectorySeparator;
FBasePath := Delimiter;
FSettingsFile := '';
end;
@ -3914,7 +3905,7 @@ begin
InitSetting(asListColPositions, 'ColPositions_%s', 0, False, '');
InitSetting(asListColSort, 'ColSort_%s', 0, False, '');
InitSetting(asSessionFolder, 'Folder', 0, False, '', True);
InitSetting(asRecentFilter, 'RecentFilters.%s', 0, False, '', True);
InitSetting(asRecentFilter, '%s', 0, False, '', True);
InitSetting(asTimestampColumns, 'TimestampColumns', 0, False, '', True);
InitSetting(asDateTimeEditorCursorPos, 'DateTimeEditor_CursorPos_Type%s', 0);
InitSetting(asAppLanguage, 'Language', 0, False, '');
@ -3956,8 +3947,6 @@ var
ProcRuns: Boolean;
SnapShot: THandle;
rx: TRegExpr;
IniName: String;
Inifile: TIniFile;
begin
// Export settings into textfile in portable mode.
if FPortableMode then try
@ -3997,11 +3986,7 @@ begin
on E:Exception do // Prefer ShowMessage, see http://www.heidisql.com/forum.php?t=14001
ShowMessage('Error: '+E.Message);
end;
for Inifile in FIniFiles.Values do begin
Inifile.UpdateFile;
Inifile.Free;
end;
FIniFiles.Free;
FRegistry.Free;
inherited;
end;
@ -4048,32 +4033,20 @@ end;
procedure TAppSettings.PrepareRegistry;
var
Folder, IniKey, IniPath: String;
FileSet: Boolean;
Folder: String;
begin
// Open the wanted ini file
if FSessionPath.IsEmpty then begin
IniKey := 'globals';
IniPath := FBasePath + IniKey + '.ini';
end
else begin
// Find and open session ini file
IniKey := FSessionPath;
IniPath := FSessionsBasePath + FSessionPath + '.ini';
// Open the wanted registry path
Folder := FBasePath;
if FSessionPath <> '' then
Folder := Folder + AppendDelimiter(REGKEY_SESSIONS) + FSessionPath;
if Delimiter+FRegistry.CurrentPath <> Folder then try
FRegistry.OpenKey(Folder, True);
except
on E:Exception do begin
// Recreate exception with a more useful message
E.Message := E.Message + CRLF + CRLF + 'While trying to open registry key "'+Folder+'"';
raise;
end;
if (not Assigned(FCurrentInifile)) or (FCurrentInifile.FileName <> IniPath) then begin
FileSet := False;
if FIniFiles.ContainsKey(IniKey) then
FileSet := FIniFiles.TryGetValue(IniKey, FCurrentInifile);
if not FileSet then begin
FCurrentInifile := TIniFile.Create(IniPath, [{ifoEscapeLineFeeds}]);
FIniFiles.AddOrSetValue(IniKey, FCurrentInifile);
end;
FCurrentInifileSection := FMainSection;
// probably creating object..
//mainform.LogSQL('Switched to '+FCurrentInifile.FileName+' ['+FCurrentInifileSection+']');
end;
end;
@ -4082,7 +4055,7 @@ function TAppSettings.GetValueNames: TStringList;
begin
PrepareRegistry;
Result := TStringList.Create;
FCurrentInifile.ReadSection(FCurrentInifileSection, Result);
FRegistry.GetValueNames(Result);
end;
@ -4094,10 +4067,9 @@ end;
function TAppSettings.GetKeyNames: TStringList;
begin
// needed for finding table|db|tablename sections
PrepareRegistry;
Result := TStringList.Create;
FCurrentInifile.ReadSections(Result);
FRegistry.GetKeyNames(Result);
end;
@ -4109,18 +4081,18 @@ begin
ValueName := GetValueName(Index);
if FormatName <> '' then
ValueName := Format(ValueName, [FormatName]);
FCurrentInifile.DeleteKey(FCurrentInifileSection, ValueName);
Result := FRegistry.DeleteValue(ValueName);
FSettings[Index].Synced := False;
end;
function TAppSettings.DeleteValue(ValueName: String): Boolean;
begin
FCurrentInifile.DeleteKey(FCurrentInifileSection, ValueName);
Result := FRegistry.DeleteValue(ValueName);
end;
procedure TAppSettings.DeleteSection(Section: String);
procedure TAppSettings.DeleteCurrentKey;
var
KeyPath: String;
begin
@ -4128,10 +4100,11 @@ 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
FCurrentInifile.EraseSection(Section);
FCurrentInifileSection := FMainSection;
KeyPath := AppendDelimiter(REGKEY_SESSIONS) + FSessionPath;
ResetPath;
FRegistry.DeleteKey(KeyPath);
end;
end;
@ -4142,11 +4115,11 @@ var
begin
PrepareRegistry;
if FSessionPath.IsEmpty then
//raise Exception.CreateFmt(_('No path set, won''t move root key %s'), [FRegistry.CurrentPath])
raise Exception.CreateFmt(_('No path set, won''t move root key %s'), [FRegistry.CurrentPath])
else begin
KeyPath := REGKEY_SESSIONS + '\' + FSessionPath;
KeyPath := AppendDelimiter(REGKEY_SESSIONS) + FSessionPath;
ResetPath;
//FRegistry.MoveKey(KeyPath, TargetPath, True);
FRegistry.MoveKey(KeyPath, TargetPath, True);
end;
end;
@ -4154,19 +4127,16 @@ end;
function TAppSettings.ValueExists(Index: TAppSettingIndex): Boolean;
var
ValueName: String;
ExistingValues: TStringList;
begin
PrepareRegistry;
ValueName := GetValueName(Index);
ExistingValues := GetValueNames;
Result := ExistingValues.IndexOf(ValueName) > -1;
ExistingValues.Free;
Result := FRegistry.ValueExists(ValueName);
end;
function TAppSettings.SessionPathExists(SessionPath: String): Boolean;
begin
Result := FileExists(FSessionsBasePath + SessionPath + '.ini');
Result := FRegistry.KeyExists(FBasePath + AppendDelimiter(REGKEY_SESSIONS) + SessionPath);
end;
@ -4175,7 +4145,7 @@ var
TestList: TStringList;
begin
TestList := GetValueNames;
Result := TestList.Count = 0;
Result := (not FRegistry.HasSubKeys) and (TestList.Count = 0);
TestList.Free;
end;
@ -4230,12 +4200,12 @@ begin
adString: S := FSettings[Index].CurrentString;
else raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]);
end;
end else if true {FRegistry.ValueExists(ValueName)} then begin
end else if FRegistry.ValueExists(ValueName) then begin
Inc(FReads);
case DataType of
adInt: I := FCurrentInifile.ReadInteger(FCurrentInifileSection, ValueName, I);
adBool: B := FCurrentInifile.ReadBool(FCurrentInifileSection, ValueName, B);
adString: S := UnescapeLinebreaks(FCurrentInifile.ReadString(FCurrentInifileSection, ValueName, S));
adInt: I := FRegistry.ReadInteger(ValueName);
adBool: B := FRegistry.ReadBool(ValueName);
adString: S := FRegistry.ReadString(ValueName);
else raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]);
end;
end;
@ -4286,7 +4256,7 @@ end;
function TAppSettings.ReadString(ValueName: String): String;
begin
PrepareRegistry;
Result := UnescapeLinebreaks(FCurrentInifile.ReadString(FCurrentInifileSection, ValueName, ''));
Result := FRegistry.ReadString(ValueName);
end;
@ -4310,7 +4280,7 @@ begin
adInt: begin
SameAsCurrent := FSettings[Index].Synced and (I = FSettings[Index].CurrentInt);
if not SameAsCurrent then begin
FCurrentInifile.WriteInteger(FCurrentInifileSection, ValueName, I);
FRegistry.WriteInteger(ValueName, I);
Inc(FWrites);
end;
FSettings[Index].CurrentInt := I;
@ -4318,7 +4288,7 @@ begin
adBool: begin
SameAsCurrent := FSettings[Index].Synced and (B = FSettings[Index].CurrentBool);
if not SameAsCurrent then begin
FCurrentInifile.WriteBool(FCurrentInifileSection, ValueName, B);
FRegistry.WriteBool(ValueName, B);
Inc(FWrites);
end;
FSettings[Index].CurrentBool := B;
@ -4326,7 +4296,7 @@ begin
adString: begin
SameAsCurrent := FSettings[Index].Synced and (S = FSettings[Index].CurrentString);
if not SameAsCurrent then begin
FCurrentInifile.WriteString(FCurrentInifileSection, ValueName, EscapeLinebreaks(S));
FRegistry.WriteString(ValueName, S);
Inc(FWrites);
end;
FSettings[Index].CurrentString := S;
@ -4338,17 +4308,6 @@ begin
FSettings[Index].Synced := True;
end;
function TAppSettings.EscapeLinebreaks(S: String): String;
begin
Result := StringReplace(S, #13, '\r', [rfReplaceAll]);
Result := StringReplace(Result, #10, '\n', [rfReplaceAll]);
end;
function TAppSettings.UnescapeLinebreaks(S: String): String;
begin
Result := StringReplace(S, '\r', #13, [rfReplaceAll]);
Result := StringReplace(Result, '\n', #10, [rfReplaceAll]);
end;
procedure TAppSettings.WriteInt(Index: TAppSettingIndex; Value: Integer; FormatName: String='');
begin
@ -4378,7 +4337,7 @@ end;
procedure TAppSettings.WriteString(ValueName, Value: String);
begin
PrepareRegistry;
FCurrentInifile.WriteString(FCurrentInifileSection, ValueName, EscapeLinebreaks(Value));
FRegistry.WriteString(ValueName, Value);
end;
@ -4388,17 +4347,21 @@ var
CurPath: String;
begin
ResetPath;
CurPath := FBasePath + AppendDelimiter(REGKEY_SESSIONS) + ParentPath;
FRegistry.OpenKey(CurPath, False);
Result := TStringList.Create;
FindAllFiles(Result, FSessionsBasePath + ParentPath, '*.ini', False);
FindAllDirectories(Folders, FSessionsBasePath + ParentPath, False);
// Return without path, just the file names
for i:=0 to Result.Count-1 do begin
Result[i] := ExtractFileName(Result[i]);
Result[i] := ChangeFileExt(Result[i], '');
FRegistry.GetKeyNames(Result);
for i:=Result.Count-1 downto 0 do begin
// Issue #1111 describes a recursive endless loop, which may be caused by an empty key name here?
if Result[i].IsEmpty then
Continue;
// ... may also be caused by some non accessible key. Check result of .OpenKey before looking for "Folder" value:
if FRegistry.OpenKey(AppendDelimiter(CurPath)+Result[i], False) then begin
if FRegistry.ValueExists(GetValueName(asSessionFolder)) then begin
Folders.Add(Result[i]);
Result.Delete(i);
end;
end;
for i:=0 to Folders.Count-1 do begin
Folders[i] := ExtractFileName(Folders[i]);
//showmessage(Folders[i]);
end;
end;
@ -4413,7 +4376,7 @@ begin
for i:=0 to Names.Count-1 do
Sessions.Add(ParentPath+Names[i]);
for i:=0 to Folders.Count-1 do
GetSessionPaths(ParentPath+Folders[i]+'\', Sessions);
GetSessionPaths(ParentPath+AppendDelimiter(Folders[i]), Sessions);
Sessions.Sort;
Names.Free;
Folders.Free;
@ -4503,7 +4466,7 @@ var
Names.Clear;
FRegistry.GetKeyNames(Names);
for i:=0 to Names.Count-1 do
ReadKeyToContent(Path + Names[i] + '\');
ReadKeyToContent(Path + AppendDelimiter(Names[i]));
Names.Free;}
end;
@ -4594,15 +4557,13 @@ begin
end;
procedure TAppSettings.SetCurrentSection(Section: String='');
function TAppSettings.AppendDelimiter(Path: String): String;
begin
if Section.IsEmpty then
FCurrentInifileSection := FMainSection
else
FCurrentInifileSection := Section;
Result := Path;
if Result[Length(Result)] <> Delimiter then
Result := Result + Delimiter;
end;
{ TUTF8NoBOMEncoding }
function TUTF8NoBOMEncoding.GetPreamble: TBytes;

12
source/connections.pas
View File

@ -661,7 +661,7 @@ var
Sess: PConnectionParameters;
Node, FocusNode: PVirtualNode;
begin
{Node := ListSessions.FocusedNode;
Node := ListSessions.FocusedNode;
Sess := ListSessions.GetNodeData(Node);
if MessageDialog(f_('Delete session "%s"?', [Sess.SessionName]), mtConfirmation, [mbYes, mbCancel]) = mrYes then
begin
@ -676,8 +676,9 @@ begin
ListSessions.DeleteNode(Node);
SelectNode(ListSessions, FocusNode);
ListSessions.SetFocus;
end;}
end;
end;
function Tconnform.SelectedSessionPath: String;
var
@ -833,7 +834,7 @@ begin
RegKey := '';
if Node <> ListSessions.RootNode then begin
Sess := ListSessions.GetNodeData(Node);
RegKey := Sess.SessionPath + '\';
RegKey := AppSettings.AppendDelimiter(Sess.SessionPath);
end;
// Fetch from registry
@ -910,7 +911,7 @@ begin
else begin
try
AppSettings.SessionPath := FocusedSess.SessionPath;
AppSettings.MoveCurrentKey(REGKEY_SESSIONS+'\'+ParentKey+FocusedSess.SessionName);
AppSettings.MoveCurrentKey(AppSettings.AppendDelimiter(REGKEY_SESSIONS)+ParentKey+FocusedSess.SessionName);
ListSessions.MoveTo(ListSessions.FocusedNode, TargetNode, AttachMode, False);
FocusedSess.SessionPath := ParentKey+FocusedSess.SessionName;
except
@ -1060,6 +1061,7 @@ begin
Screen.Cursor := crDefault;
end;
procedure Tconnform.RefreshBackgroundColors;
begin
// Trigger OnGetColors event
@ -1141,7 +1143,7 @@ begin
NewText := Sess.SessionName;
end else begin
AppSettings.SessionPath := Sess.SessionPath;
AppSettings.MoveCurrentKey(REGKEY_SESSIONS+'\'+ParentKey+NewText);
AppSettings.MoveCurrentKey(AppSettings.AppendDelimiter(REGKEY_SESSIONS)+ParentKey+NewText);
// Also fix internal session names in main form, which gets used to store e.g. "lastuseddb" later
for Connection in MainForm.Connections do begin
if Connection.Parameters.SessionPath = Sess.SessionPath then

2
source/dbconnection.pas
View File

@ -2103,7 +2103,7 @@ function TConnectionParameters.GetSessionName: String;
var
LastBackSlash: Integer;
begin
LastBackSlash := LastDelimiter('\', FSessionPath);
LastBackSlash := LastDelimiter(AppSettings.Delimiter, FSessionPath);
if LastBackSlash > 0 then
Result := Copy(FSessionPath, LastBackSlash+1, MaxInt)
else

294
source/jsonregistry.pas Normal file
View File

@ -0,0 +1,294 @@
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.

64
source/main.pas
View File

@ -2689,14 +2689,14 @@ begin
AppSettings.SessionPath := Item.Parameters.SessionPath;
Keys := AppSettings.GetKeyNames;
rx := TRegExpr.Create;
rx.Expression := '^table' + QuoteRegExprMetaChars(DELIM) + '.+';
rx.Expression := '.+'+QuoteRegExprMetaChars(DELIM)+'.+';
for i:=0 to Keys.Count-1 do begin
if rx.Exec(Keys[i]) then begin
AppSettings.SessionPath := AppSettings.AppendDelimiter(Item.Parameters.SessionPath) + Keys[i];
NamesInKey := AppSettings.GetValueNames;
if (NamesInKey.Count = 0) or ForceDeleteTableKey then begin
AppSettings.DeleteSection(Keys[i]);
AppSettings.DeleteCurrentKey;
end;
NamesInKey.Free;
end;
end;
rx.Free;
@ -2942,8 +2942,7 @@ end;
procedure TMainForm.menuClearDataTabFilterClick(Sender: TObject);
begin
// Same as "Clear filter" button, but *before* the data tab is activated
AppSettings.SessionPath := ActiveDbObj.Connection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
AppSettings.SessionPath := GetRegKeyTable;
if AppSettings.ValueExists(asFilter) then begin
AppSettings.DeleteValue(asFilter);
LogSQL(f_('Data filter for %s deleted', [ActiveDbObj.Name]), lcInfo);
@ -2995,8 +2994,7 @@ var
GridColumn: TVirtualTreeColumn;
begin
// Mark focused column as UNIX timestamp column
AppSettings.SessionPath := ActiveDbObj.Connection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
AppSettings.SessionPath := GetRegKeyTable;
GridColumn := DataGrid.Header.Columns[DataGrid.FocusedColumn];
FocusedColumnName := GridColumn.Text;
i := SelectedTableTimestampColumns.IndexOf(FocusedColumnName);
@ -3569,7 +3567,7 @@ begin
// Delete identical history items to avoid spam
// Delete old items
// Delete items which exceed a max datasize barrier
AppSettings.SessionPath := Thread.Connection.Parameters.SessionPath + '\' + REGKEY_QUERYHISTORY;
AppSettings.SessionPath := AppSettings.AppendDelimiter(Thread.Connection.Parameters.SessionPath) + REGKEY_QUERYHISTORY;
MinDate := IncDay(Now, -KeepDays);
RegItemsSize := Thread.Batch.Size;
for HistoryItem in History do begin
@ -5336,8 +5334,7 @@ begin
// Recreate recent filters list
Filters := TStringList.Create;
Filters.Add(Trim(SynMemoFilter.Text));
AppSettings.SessionPath := ActiveConnection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
AppSettings.SessionPath := AppSettings.AppendDelimiter(GetRegKeyTable) + REGKEY_RECENTFILTERS;
// Add old filters
for i:=1 to 20 do begin
val := AppSettings.ReadString(asRecentFilter, IntToStr(i));
@ -8693,12 +8690,18 @@ var
begin
// Clear query history items in registry
// Take care of MessageDialog, probably changing the current SessionPath
PathToDelete := AppSettings.AppendDelimiter(ActiveConnection.Parameters.SessionPath) + REGKEY_QUERYHISTORY;
AppSettings.SessionPath := PathToDelete;
Values := AppSettings.GetValueNames;
if MessageDialog(_('Clear query history?'), f_('%s history items will be deleted.', [FormatNumber(Values.Count)]), mtConfirmation, [mbYes, mbNo]) = mrYes then begin
Screen.Cursor := crHourglass;
AppSettings.DeleteSection(REGKEY_QUERYHISTORY);
AppSettings.SessionPath := PathToDelete;
AppSettings.DeleteCurrentKey;
RefreshHelperNode(TQueryTab.HelperNodeHistory);
Screen.Cursor := crDefault;
end;
Values.Free;
AppSettings.ResetPath;
end;
@ -9770,8 +9773,7 @@ begin
SelectedTableColumns.Clear;
SelectedTableKeys.Clear;
SelectedTableForeignKeys.Clear;
AppSettings.SessionPath := ActiveDbObj.Connection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
AppSettings.SessionPath := GetRegKeyTable;
SelectedTableTimestampColumns.Text := AppSettings.ReadString(asTimestampColumns);
InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False);
try
@ -11200,8 +11202,7 @@ begin
Inc(DataGridWantedRowCount, AppSettings.ReadInt(asDatagridRowsPerStep));
end else begin
// Save current attributes if grid gets refreshed
AppSettings.SessionPath := ActiveDbObj.Connection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
AppSettings.SessionPath := GetRegKeyTable;
if DataGridHiddenColumns.Count > 0 then
AppSettings.WriteString(asHiddenColumns, DataGridHiddenColumns.DelimitedText)
else if AppSettings.ValueExists(asHiddenColumns) then
@ -11223,13 +11224,14 @@ begin
end;
// Auto remove registry spam if table folder is empty
AppSettings.SessionPath := ActiveDbObj.Connection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
if AppSettings.SessionPathExists(GetRegKeyTable) then begin
AppSettings.SessionPath := GetRegKeyTable;
if AppSettings.IsEmptyKey then
AppSettings.DeleteSection(GetRegKeyTable);
AppSettings.DeleteCurrentKey;
end;
// Do nothing if table was not filtered yet
if AppSettings.GetKeyNames.IndexOf(GetRegKeyTable) = -1 then
if not AppSettings.SessionPathExists(GetRegKeyTable) then
Exit;
// Columns
@ -11276,8 +11278,9 @@ end;
function TMainForm.GetRegKeyTable: String;
begin
// Return the slightly complex ini section to table|curdb|curtable
Result := 'table' + DELIM + ActiveDatabase + DELIM + ActiveDbObj.Name;
// Return the slightly complex registry path to \Servers\CustomFolder\ActiveServer\curdb|curtable
Result := AppSettings.AppendDelimiter(ActiveDbObj.Connection.Parameters.SessionPath) +
ActiveDatabase + DELIM + ActiveDbObj.Name;
end;
@ -11738,8 +11741,7 @@ begin
ToggleFilterPanel(True);
actApplyFilter.Execute;
// SynMemoFilter will be cleared and set value of asFilter (in HandleDataGridAttributes from DataGridBeforePaint)
AppSettings.SessionPath := Conn.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
AppSettings.SessionPath := GetRegKeyTable;
AppSettings.WriteString(asFilter, Filter);
end;
@ -12081,8 +12083,9 @@ begin
menuRecentFilters.Delete(i);
comboRecentFilters.Items.Clear;
// Enumerate recent filters from registry
AppSettings.SessionPath := ActiveConnection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
Path := AppSettings.AppendDelimiter(GetRegKeyTable) + REGKEY_RECENTFILTERS;
if AppSettings.SessionPathExists(Path) then begin
AppSettings.SessionPath := Path;
rx := TRegExpr.Create;
rx.Expression := '\s+';
for i:=1 to 20 do begin
@ -12102,7 +12105,7 @@ begin
FreeAndNil(rx);
AppSettings.ResetPath;
menuRecentFilters.Enabled := menuRecentFilters.Count > 0;
end;
comboRecentFilters.Visible := comboRecentFilters.Items.Count > 0;
lblRecentFilters.Visible := comboRecentFilters.Visible;
SynMemoFilter.Height := pnlFilter.Height - 3;
@ -12125,8 +12128,9 @@ begin
key := (Sender as TMenuItem).Tag
else
key := (Sender as TComboBox).ItemIndex+1;
AppSettings.SessionPath := ActiveConnection.Parameters.SessionPath;
AppSettings.SetCurrentSection(GetRegKeyTable);
Path := AppSettings.AppendDelimiter(GetRegKeyTable) + REGKEY_RECENTFILTERS;
if AppSettings.SessionPathExists(Path) then begin
AppSettings.SessionPath := Path;
//SynMemoFilter.UndoList.AddGroupBreak;
SynMemoFilter.BeginUpdate;
SynMemoFilter.SelectAll;
@ -12134,6 +12138,7 @@ begin
SynMemoFilter.EndUpdate;
AppSettings.ResetPath;
end;
end;
procedure TMainForm.PlaceObjectEditor(Obj: TDBObject);
@ -15507,8 +15512,7 @@ var
Item: TQueryHistoryItem;
begin
inherited Create(TQueryHistoryItemComparer.Create, True);
AppSettings.SessionPath := SessionPath;
AppSettings.SetCurrentSection(REGKEY_QUERYHISTORY);
AppSettings.SessionPath := AppSettings.AppendDelimiter(SessionPath) + REGKEY_QUERYHISTORY;
ValueNames := AppSettings.GetValueNames;
for i:=0 to ValueNames.Count-1 do begin
j := StrToIntDef(ValueNames[i], -1);