You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
RnQ/for.RnQ/RnQPrefsLib.pas

907 lines
21 KiB
Plaintext

{
This file is part of R&Q.
Under same license
}
unit RnQPrefsLib;
{$I ForRnQConfig.inc}
interface
uses
System.Classes, System.SysUtils, System.StrUtils, System.IniFiles, RDGlobal;
{$I NoRTTI.inc}
type
TElemType = (ET_String = 0, ET_Integer, ET_Blob, ET_Blob64, ET_Double, ET_Date, ET_Time, ET_Bool);
TPrefElem = record
sVal: String;
iVal: Integer;
bVal: RawByteString;
rVal: RawByteString;
dVal: Double;
tVal: TDate;
dtVal: TDateTime;
yVal: Boolean;
end;
PPrefElement = ^TPrefElement;
TPrefElement = class(TObject) // record
public
ElType: TElemType;
elem: TPrefElem;
procedure Clear;
Destructor Destroy; OverRide;
function AsBlob: RawByteString;
function Clone: TPrefElement;
end;
PPrefElementRec = ^TPrefElementRec;
TPrefElementRec = record
Key: String;
Element: TPrefElement;
end;
type
TRnQPref = class
private
fPrefStr: THashedStringList;
fInUpdate: Boolean;
public
constructor Create;
Destructor Destroy; override;
procedure Load(const cfg: RawByteString);
procedure ResetPrefs;
function getPrefStr(const key: String; var Val: String): Boolean;
function getPrefStrList(const key: String; var Val: TStringList): Boolean;
function getPrefBool(const key: String; var Val: Boolean): Boolean;
procedure getPrefBlob(const key: String; var Val: RawByteString);
procedure getPrefBlob64(const key: String; var Val: RawByteString);
function getPrefInt(const key: String; var Val: Integer): Boolean;
procedure getPrefDate(const key: String; var Val: TDateTime);
procedure getPrefDateTime(const key: String; var Val: TDateTime);
function getPrefGuid(const key: String; var Val: TGUID): Boolean;
function getPrefBoolDef(const key: String; const DefVal: Boolean): Boolean;
function getPrefBlobDef(const key: String; const DefVal: RawByteString = ''): RawByteString;
function getPrefBlob64Def(const key: String; const DefVal: RawByteString = ''): RawByteString;
function getPrefStrDef(const key: String; const DefVal: String = ''): String;
function getPrefIntDef(const key: String; const DefVal: Integer = -1): Integer;
function getPrefVal(const key: String): TPrefElement;
function GetPreloadPrefs: RawByteString;
function GetDBPrefs: THashedStringList;
procedure DeletePref(const key: String);
function prefExists(const key: String): Boolean;
procedure addPrefVal(const key: String; const Val: TPrefElement);
procedure addPrefBlobOld(const key: String; const Val: RawByteString);
procedure addPrefBlob64(const key: String; const Val: RawByteString);
procedure addPrefInt(const key: String; const Val: Integer);
procedure addPrefBool(const key: String; const Val: Boolean);
procedure addPrefStr(const key: String; const Val: String);
procedure addPrefStrList(const key: String; const Val: TStringList);
procedure addPrefTime(const key: String; const Val: TDateTime);
procedure addPrefDate(const key: String; const Val: TDate);
procedure addPrefGuid(const key: String; const Val: TGUID);
procedure initPrefBool(const key: String; const Val: Boolean);
procedure initPrefInt(const key: String; const Val: Integer);
procedure initPrefStr(const key: String; const Val: String);
procedure BeginUpdate;
procedure EndUpdate;
property IsUpdating: Boolean read fInUpdate;
end;
PPrefPage = ^TPrefPage;
TPrefPage = class
public
idx: byte;
Name, Caption: string;
public
destructor Destroy; override;
function Clone: TPrefPage;
end;
TPrefPagesArr = array of TPrefPage;
const
PreloadPrefs: TArray = [
'sqlite-config', 'account-id', 'account-name', 'start-minimized',
'history-crypt-enabled', 'history-crypt-save-password', 'history-crypt-password', 'history-crypt-password64'
];
implementation
uses
System.Types,
{$IFDEF UNICODE}
System.AnsiStrings,
{$ENDIF UNICODE}
RDUtils, Base64;
{ TRnQPref }
procedure TRnQPref.addPrefVal(const key: String; const Val: TPrefElement);
begin
fPrefStr.AddObject(key, Val);
end;
procedure TRnQPref.addPrefBlobOld(const key: String; const Val: RawByteString);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_Blob;
El.elem.bVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
end;
procedure TRnQPref.addPrefBlob64(const key: String; const Val: RawByteString);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_Blob64;
El.elem.rVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
end;
procedure TRnQPref.addPrefBool(const key: String; const Val: Boolean);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_Bool;
El.elem.yVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
end;
procedure TRnQPref.addPrefDate(const key: String; const Val: TDate);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_Date;
El.elem.tVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
end;
procedure TRnQPref.addPrefGuid(const key: String; const Val: TGUID);
begin
addPrefStr(Key, GUIDToString(Val));
end;
procedure TRnQPref.addPrefInt(const key: String; const Val: Integer);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_Integer;
El.elem.iVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
// Result := i;
end;
procedure TRnQPref.addPrefStr(const key, Val: String);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_String;
El.elem.sVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
end;
procedure TRnQPref.addPrefStrList(const key: String; const Val: TStringList);
var
s, str: String;
begin
if Val.Count = 0 then
addPrefStr(key, '')
else
begin
for s in Val do
str := str + ',' + s;
Delete(str, 1, 1);
addPrefStr(key, str);
end;
end;
procedure TRnQPref.addPrefTime(const key: String; const Val: TDateTime);
var
El: TPrefElement;
i: Integer;
begin
if key = '' then
Exit;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
end else
El := TPrefElement.Create;
El.ElType := ET_Time;
El.elem.dtVal := Val;
if i < 0 then
fPrefStr.AddObject(key, El);
end;
constructor TRnQPref.Create;
begin
inherited;
// if not Assigned(fPrefStr) then
fPrefStr := THashedStringList.Create;
fPrefStr.CaseSensitive := False;
fInUpdate := False;
end;
procedure TRnQPref.DeletePref(const key: String);
var
El: TPrefElement;
i: Integer;
begin
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
fPrefStr.Objects[i] := nil;
El.Clear;
El.Free;
fPrefStr.Delete(i);
end
end;
function TRnQPref.prefExists(const key: String): Boolean;
begin
Result := fPrefStr.IndexOf(key) >= 0;
end;
destructor TRnQPref.Destroy;
begin
ResetPrefs;
FreeAndNil(fPrefStr);
inherited;
end;
procedure TRnQPref.ResetPrefs;
var
i: Integer;
El: TPrefElement;
begin
if Assigned(fPrefStr) then
begin
for i := 0 to fPrefStr.Count - 1 do
begin
El := TPrefElement(fPrefStr.Objects[i]);
El.Clear;
fPrefStr.Objects[i] := nil;
El.Free;
end;
fPrefStr.Clear;
end;
end; // resetLanguage
procedure TRnQPref.Load(const cfg: RawByteString);
var
l: RawByteString;
key: String;
hhh: RawByteString;
pp: PAnsiChar;
p1, p2, // Position of CRLF
len, m1, m: Integer;
// lastVersion:integer;
// i:integer;
begin
if cfg = '' then
Exit;
fPrefStr.Sorted := False;
p1 := 1;
// p2 := 1;
len := Length(cfg);
try
// while p2 > 0 do
while p1 < len do
begin
p2 := p1;
m1 := 1;
while (p2 < len) and not(cfg[p2] in [#10, #13]) do
Inc(p2);
if (p2 < len) and (cfg[p2 + 1] in [#10, #13]) then
Inc(m1); // #13 + #10
// p2 := PosEx(CRLF, cfg, p1);
// if p2 > 0 then
l := Copy(cfg, p1, p2 - p1);
// else
// l := Copy(cfg, p1, len);
p1 := p2 + m1;
// l:=chop(CRLF,cfg);
// hhh := LowerCase(chop(AnsiString('='),l));
// hhh := copy(Trim(LowerCase(chop('=',l))), 1, 1000);
// hhh := Trim(LowerCase(chop(RawByteString('='),l)));
m := pos(RawByteString('='), l);
// hhh := Copy(l, m+1, $FFFF);
hhh := LowerCase(Trim(Copy(l, 1, m - 1)));
Delete(l, 1, m);
pp := PAnsiChar(hhh);
key := pp;
// PrefAddVal(key, l, fPrefStr);
addPrefBlobOld(key, l);
end;
finally
fPrefStr.Sorted := True;
end;
end;
function TRnQPref.GetPreloadPrefs: RawByteString;
var
I: Integer;
begin
Result := '';
for I := 0 to fPrefStr.Count - 1 do
if MatchText(fPrefStr.Strings[I], PreloadPrefs) then
if Assigned(fPrefStr.Objects[I]) then
Result := Result + AnsiString(fPrefStr.Strings[I]) + '=' + TPrefElement(fPrefStr.Objects[I]).AsBlob + CRLF;
end;
function TRnQPref.GetDBPrefs: THashedStringList;
var
I: Integer;
begin
Result := THashedStringList.Create;
Result.Assign(fPrefStr);
for I := Result.Count - 1 downto 0 do
if MatchText(fPrefStr.Strings[I], PreloadPrefs) then
Result.Delete(I);
end;
procedure TRnQPref.getPrefBlob(const key: String; var Val: RawByteString);
var
i: Integer;
El: TPrefElement;
begin
begin
// Result := '';
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := El.elem.bVal
else if El.ElType = ET_Blob64 then
Val := El.elem.rVal
// else
// Result := DefVal;
end
end;
end;
procedure TRnQPref.getPrefBlob64(const key: String; var Val: RawByteString);
var
i: Integer;
El: TPrefElement;
begin
begin
// Result := '';
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := Base64DecodeString(El.elem.bVal)
else if El.ElType = ET_Blob64 then
Val := El.elem.rVal
// else
// Result := DefVal;
end
end;
end;
function TRnQPref.getPrefBlobDef(const key: String; const DefVal: RawByteString): RawByteString;
var
i: Integer;
El: TPrefElement;
begin
begin
Result := '';
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Result := El.elem.bVal
else
Result := DefVal;
end else
Result := DefVal;
end;
end;
function TRnQPref.getPrefBlob64Def(const key: String; const DefVal: RawByteString): RawByteString;
var
i: Integer;
El: TPrefElement;
sr: RawByteString;
begin
begin
Result := '';
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
begin
sr := El.elem.bVal;
if sr > '' then
Result := Base64DecodeString(sr);
end else if El.ElType = ET_Blob64 then
Result := El.elem.rVal
else
Result := DefVal;
end else
Result := DefVal;
end;
end;
function TRnQPref.getPrefStr(const key: String; var Val: String): Boolean;
var
i: Integer;
El: TPrefElement;
begin
begin
Result := False;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
Result := True;
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := UnUTF(El.elem.bVal)
else if El.ElType = ET_String then
Val := El.elem.sVal
else
Result := False;
end
end;
end;
function TRnQPref.getPrefStrList(const key: String; var Val: TStringList): Boolean;
var
str: String;
begin
Result := getPrefStr(key, str);
Val.DelimitedText := str;
end;
function TRnQPref.getPrefGuid(const key: String; var Val: TGUID): Boolean;
var
str: String;
begin
Result := getPrefStr(key, str);
if not Result then
Val := GUID_NULL
else if str = '' then
Val := GUID_NULL
else try
Val := StringToGUID(str);
except
Val := GUID_NULL;
Result := False;
end;
end;
function TRnQPref.getPrefStrDef(const key: String; const DefVal: String): String;
var
i: Integer;
El: TPrefElement;
begin
begin
Result := '';
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Result := UnUTF(El.elem.bVal)
else if El.ElType = ET_String then
Result := El.elem.sVal
else
Result := DefVal;
end else
Result := DefVal;
end;
end;
function yesnof(l: PAnsiChar): Boolean; inline;
const
yyy = AnsiString('yes');
begin
Result := System.AnsiStrings.StrIComp(l, PAnsiChar(yyy)) = 0
end;
function TRnQPref.getPrefBool(const key: String; var Val: Boolean): Boolean;
var
i: Integer;
El: TPrefElement;
begin
Result := False;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
Result := True;
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := yesnof(PAnsiChar(El.elem.bVal))
else
if El.ElType = ET_Bool then
Val := El.elem.yVal
else
Result := False;
end;
end;
function TRnQPref.getPrefBoolDef(const key: String; const DefVal: Boolean): Boolean;
(* function yesno(l : PAnsiChar):boolean; inline;
const
yyy = AnsiString('yes');
begin
// result := comparetext(l,)=0
result := StrIComp(l, PAnsiChar(yyy)) = 0
end; *)
var
i: Integer;
El: TPrefElement;
begin
Result := DefVal;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Result := yesnof(PAnsiChar(El.elem.bVal))
else
if El.ElType = ET_Bool then
Result := El.elem.yVal
// else
// Result := DefVal;
end;
end;
function TRnQPref.getPrefInt(const key: String; var Val: Integer): Boolean;
function int(l: PAnsiChar): Integer; inline;
var
bb: Integer;
// ss : AnsiString;
ss: String;
begin
ss := l;
System.Val(ss, Result, bb);
if bb <> 0 then
Result := 0;
end;
var
i: Integer;
El: TPrefElement;
begin
Result := False;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
Result := True;
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := int(PAnsiChar(El.elem.bVal))
else
if El.ElType = ET_Integer then
Val := El.elem.iVal
else
Result := False;
end;
end;
function TRnQPref.getPrefIntDef(const key: String; const DefVal: Integer): Integer;
function int(l: PAnsiChar): Integer; inline;
var
bb: Integer;
// ss : AnsiString;
ss: String;
begin
ss := l;
System.Val(ss, Result, bb);
if bb <> 0 then
Result := 0;
end;
var
i: Integer;
El: TPrefElement;
begin
Result := DefVal;
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Result := int(PAnsiChar(El.elem.bVal))
else if El.ElType = ET_Integer then
Result := El.elem.iVal
// else
// Result := DefVal;
end;
end;
procedure TRnQPref.getPrefDate(const key: String; var Val: TDateTime);
function dt(l: PAnsiChar): TDateTime; inline;
var
df: TFormatSettings;
s: string;
begin
try
// GetLocaleFormatSettings(0, df);
df := TFormatSettings.Create('');
df.ShortDateFormat := 'dd.mm.yyyy';
df.DateSeparator := '.';
s := Copy(l, 1, 10);
Result := StrToDate(s, df);
except
Result := 0;
end;
end;
var
i: Integer;
El: TPrefElement;
begin
i := fPrefStr.IndexOf(key);
if i >= 0 then
begin
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := dt(PAnsiChar(El.elem.bVal))
else if El.ElType = ET_Date then
Val := El.elem.tVal
// else
// Result := DefVal;
end;
end;
procedure TRnQPref.getPrefDateTime(const key: String; var Val: TDateTime);
function dtt(l: PAnsiChar): TDateTime; inline;
var
df: TFormatSettings;
begin
// GetLocaleFormatSettings(0, df);
df := TFormatSettings.Create('');
// df.LongDateFormat := 'dd.mm.yyyy';
df.ShortDateFormat := 'dd.mm.yyyy';
df.DateSeparator := '.';
df.LongTimeFormat := 'hh:mm:ss';
df.ShortTimeFormat := 'hh:mm:ss';
df.TimeSeparator := ':';
Result := StrToDateTime(l, df);
end;
var
i: Integer;
El: TPrefElement;
begin
i := fPrefStr.IndexOf(key);
if i >= 0 then
try
El := TPrefElement(fPrefStr.Objects[i]);
if El.ElType = ET_Blob then
Val := dtt(PAnsiChar(El.elem.bVal))
else if El.ElType = ET_Time then
Val := El.elem.dtVal
// else
// Result := DefVal;
except
Val := 0;
end;
end;
function TRnQPref.getPrefVal(const key: String): TPrefElement;
var
i: Integer;
begin
i := fPrefStr.IndexOf(key);
if i >= 0 then
Result := TPrefElement(fPrefStr.Objects[i]).Clone
else
Result := nil;
end;
procedure TRnQPref.initPrefBool(const key: String; const Val: Boolean);
begin
if not prefExists(key) then
addPrefBool(key, Val);
end;
procedure TRnQPref.initPrefInt(const key: String; const Val: Integer);
begin
if not prefExists(key) then
addPrefInt(key, Val);
end;
procedure TRnQPref.initPrefStr(const key: String; const Val: String);
begin
if not prefExists(key) then
addPrefStr(key, Val);
end;
procedure TRnQPref.BeginUpdate;
begin
fInUpdate := True;
end;
procedure TRnQPref.EndUpdate;
begin
fInUpdate := False;
end;
{ TPrefElement }
function TPrefElement.AsBlob: RawByteString;
begin
try
case ElType of
ET_String:
begin
if elem.sVal <> '' then
Result := UTF(elem.sVal)
else
Result := '';
end;
ET_Integer:
begin
Result := IntToStr(elem.iVal);
end;
ET_Blob:
begin
if elem.bVal <> '' then
Result := elem.bVal
else
Result := '';
end;
ET_Blob64:
begin
if elem.rVal <> '' then
Result := Base64EncodeString(elem.rVal)
else
Result := '';
end;
ET_Double:
Str(elem.dVal: 0: 4, Result); // := FloatToStr(elem.dVal);
ET_Date:
Result := AnsiString(FormatDateTime(Def_DateFormat, elem.tVal));
ET_Bool:
Result := yesno[elem.yVal];
ET_Time:
Result := AnsiString(FormatDateTime(Def_DateTimeFormat, elem.dtVal));
end;
except
Result := '';
end;
end;
procedure TPrefElement.Clear;
begin
ElType := ET_Integer;
elem.dVal := 0;
end;
function TPrefElement.Clone: TPrefElement;
begin
Result := TPrefElement.Create;
Result.ElType := Self.ElType;
case ElType of
ET_String:
Result.elem.sVal := elem.sVal;
ET_Integer:
Result.elem.iVal := elem.iVal;
ET_Blob:
Result.elem.bVal := elem.bVal;
ET_Blob64:
Result.elem.rVal := elem.rVal;
ET_Double:
Result.elem.dVal := elem.dVal;
ET_Date:
Result.elem.tVal := elem.tVal;
ET_Time:
Result.elem.dtVal := elem.dtVal;
ET_Bool:
Result.elem.yVal := elem.yVal;
end;
end;
destructor TPrefElement.Destroy;
begin
Clear;
inherited;
end;
destructor TPrefPage.Destroy;
begin
SetLength(Self.Name, 0);
SetLength(Self.Caption, 0);
inherited;
end;
function TPrefPage.Clone: TPrefPage;
begin
Result := TPrefPage.Create;
Result.idx := Self.idx;
Result.Name := Self.Name;
Result.Caption := Self.Caption;
end;
end.