326 lines
12 KiB
ObjectPascal
326 lines
12 KiB
ObjectPascal
unit SimplyJSON;
|
||
{$MODE Delphi}
|
||
{$codepage UTF8}
|
||
{*************************************************************************************************************************************
|
||
SimplyJSON
|
||
Модуль для парсинга JSON файлов (используется TJSONConfig).
|
||
Авторские права (c) 2016 - 2019, Александр Бабаев.
|
||
История изменений:
|
||
1.3 (01.05.2019) Переработан алгоритм открытия / парсинга JSON файлов при чтении, изменена функция JSReadFont
|
||
1.2 (09.05.2017) Добавлены функции чтения/записи шрифтов.
|
||
*************************************************************************************************************************************}
|
||
interface
|
||
uses Classes, SysUtils, Graphics, GraphicsEx, LazUTF8Classes, LazFileUtils, fpjson, jsonparser, jsonConf,
|
||
ANBFormatString;
|
||
//stdcalls
|
||
function JSReadString (const AKey, ADefault: UnicodeString; const AFileName: String): UnicodeString; STDCALL; OVERLOAD;
|
||
function JSReadString (const AKey, ADefault, AFileName: String): String; STDCALL; OVERLOAD;
|
||
function JSReadInteger (const AKey: UnicodeString; const ADefault: Int64; const AFileName: String): Int64; STDCALL; OVERLOAD;
|
||
function JSReadInteger (const AKey: String; const ADefault: Int64; const AFileName: String): Int64; STDCALL; OVERLOAD;
|
||
function JSReadBoolean (const AKey: UnicodeString; const ADefault: Boolean; const AFileName: String): Boolean; STDCALL; OVERLOAD;
|
||
function JSReadBoolean (const AKey: String; const ADefault: Boolean; const AFileName: String): Boolean; STDCALL; OVERLOAD;
|
||
function JSReadRGBColor (const AKey: UnicodeString; const ADefault: TRGBColor; const AFileName: String): TRGBColor; STDCALL; OVERLOAD;
|
||
function JSReadRGBColor (const AKey: String; const ADefault: TRGBColor; const AFileName: String): TRGBColor; STDCALL; OVERLOAD;
|
||
procedure JSReadFont (const AKey: UnicodeString; var Font: TFont; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSReadFont (const AKey: String; var Font: TFont; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteString (const AKey, AValue: UnicodeString; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteString (const AKey, AValue, AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteInteger (const AKey: UnicodeString; const AValue: Int64; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteInteger (const AKey: String; const AValue: Int64; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteBoolean (const AKey: UnicodeString; const AValue: Boolean; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteBoolean (const AKey: String; const AValue: Boolean; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteRGBColor (const AKey: UnicodeString; const AValue: TRGBColor; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteRGBColor (const AKey: String; const AValue: TRGBColor; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteFont (const AKey: UnicodeString; const AValue: TFont; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSWriteFont (const AKey: String; const AValue: TFont; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSDeleteKey (const AKey: UnicodeString; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSDeleteKey (const AKey, AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSReadSubKeys (const AKey: UnicodeString; SubkeyList: TStrings; const AFileName: String); STDCALL; OVERLOAD;
|
||
procedure JSReadSubKeys (const AKey: String; SubkeyList: TStrings; const AFileName: String); STDCALL; OVERLOAD;
|
||
implementation
|
||
//Support functions
|
||
procedure GetJSData (const AFileName: String; var JSData: TJSONData);
|
||
var FS: TFileStreamUTF8;
|
||
SL: TStringListUTF8;
|
||
begin
|
||
if not FileExistsUTF8(AFileName) then
|
||
begin
|
||
FS:= TFileStreamUTF8.Create(AFileName, fmOpenWrite);
|
||
SL:= TStringListUTF8.Create;
|
||
SL.Text:= '{}';
|
||
SL.SaveToStream(FS);
|
||
SL.Free;
|
||
FS.Free;
|
||
end;
|
||
FS:= TFileStreamUTF8.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||
JSData:= GetJSON(FS, True);
|
||
FS.Free;
|
||
end;
|
||
function FrmtKey (const AKey: UnicodeString): UnicodeString;
|
||
var KeyM: UnicodeString;
|
||
begin
|
||
Result:= AKey;
|
||
//Для совместимости с SimplyJSON 1.0 - 1.2 и операциями записи
|
||
KeyM:= AKey;
|
||
if KeyM[1] = '/' then
|
||
Delete(KeyM, 1, 1);
|
||
Result:= UnicodeString(FormatStr(KeyM, ['/'], ['.']));
|
||
end;
|
||
//Read functions
|
||
function JSReadString (const AKey, ADefault: UnicodeString; const AFileName: String): UnicodeString; OVERLOAD;
|
||
var JD: TJSONData;
|
||
begin
|
||
GetJSData(AFileName, JD);
|
||
try
|
||
Result:= JD.FindPath(FrmtKey(AKey)).AsUnicodeString;
|
||
except
|
||
Result:= ADefault;
|
||
end;
|
||
JD.Free;
|
||
end;
|
||
function JSReadString (const AKey, ADefault, AFileName: String): String; OVERLOAD;
|
||
var Key, Def, Res: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
Def:= UnicodeString(ADefault);
|
||
Res:= JSReadString(Key, Def, AFileName);
|
||
Result:= String(Res);
|
||
end;
|
||
function JSReadInteger (const AKey: UnicodeString; const ADefault: Int64; const AFileName: String): Int64; OVERLOAD;
|
||
var JD: TJSONData;
|
||
begin
|
||
GetJSData(AFileName, JD);
|
||
try
|
||
Result:= JD.FindPath(FrmtKey(AKey)).AsInt64;
|
||
except
|
||
Result:= ADefault;
|
||
end;
|
||
JD.Free;
|
||
end;
|
||
function JSReadInteger (const AKey: String; const ADefault: Int64; const AFileName: String): Int64; OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
Result:= JSReadInteger(Key, ADefault, AFileName);
|
||
end;
|
||
function JSReadBoolean (const AKey: UnicodeString; const ADefault: Boolean; const AFileName: String): Boolean; OVERLOAD;
|
||
var JD: TJSONData;
|
||
begin
|
||
GetJSData(AFileName, JD);
|
||
try
|
||
Result:= JD.FindPath(FrmtKey(AKey)).AsBoolean;
|
||
except
|
||
Result:= ADefault;
|
||
end;
|
||
JD.Free;
|
||
end;
|
||
function JSReadBoolean (const AKey: String; const ADefault: Boolean; const AFileName: String): Boolean; OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
Result:= JSReadBoolean(Key, ADefault, AFileName);
|
||
end;
|
||
function JSReadRGBColor (const AKey: UnicodeString; const ADefault: TRGBColor; const AFileName: String): TRGBColor; OVERLOAD;
|
||
var JD: TJSONData;
|
||
KeyM: UnicodeString;
|
||
begin
|
||
GetJSData(AFileName, JD);
|
||
KeyM:= FrmtKey(AKey);
|
||
try
|
||
Result.R:= JD.FindPath(KeyM + '.r').AsInteger;
|
||
Result.G:= JD.FindPath(KeyM + '.g').AsInteger;
|
||
Result.B:= JD.FindPath(KeyM + '.b').AsInteger;
|
||
except
|
||
Result:= ADefault;
|
||
end;
|
||
JD.Free;
|
||
end;
|
||
function JSReadRGBColor (const AKey: String; const ADefault: TRGBColor; const AFileName: String): TRGBColor; OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
Result:= JSReadRGBColor(Key, ADefault, AFileName);
|
||
end;
|
||
procedure JSReadFont (const AKey: UnicodeString; var Font: TFont; const AFileName: String);
|
||
var JD: TJSONData;
|
||
FStyle: TFontStyles;
|
||
KeyM: UnicodeString;
|
||
begin
|
||
GetJSData(AFileName, JD);
|
||
KeyM:= FrmtKey(AKey);
|
||
try
|
||
Font.CharSet:= TFontCharSet(JD.FindPath(KeyM + '.charset').AsInteger);
|
||
Font.Color:= StringToColor(JD.FindPath(KeyM + '.color').AsString);
|
||
Font.Height:= JD.FindPath(KeyM + '.height').AsInteger;
|
||
Font.Name:= JD.FindPath(KeyM + '.name').AsString;
|
||
Font.Orientation:= JD.FindPath(KeyM + '.orientation').AsInteger;
|
||
Font.Pitch:= TFontPitch(JD.FindPath(KeyM + '.pitch').AsInteger);
|
||
Font.Quality:= TFontQuality(JD.FindPath(KeyM + '.quality').AsInteger);
|
||
Font.Size:= JD.FindPath(KeyM + '.size').AsInteger;
|
||
FStyle:= [];
|
||
if (JD.FindPath(KeyM + '.style.bold').AsBoolean) then
|
||
FStyle:= FStyle + [fsBold];
|
||
if (JD.FindPath(KeyM + '.style.italic').AsBoolean) then
|
||
FStyle:= FStyle + [fsItalic];
|
||
if (JD.FindPath(KeyM + '.style.underline').AsBoolean) then
|
||
FStyle:= FStyle + [fsUnderline];
|
||
if (JD.FindPath(KeyM + '.style.strikeout').AsBoolean) then
|
||
FStyle:= FStyle + [fsStrikeOut];
|
||
Font.Style:= FStyle;
|
||
except
|
||
end;
|
||
JD.Free;
|
||
end;
|
||
procedure JSReadFont (const AKey: String; var Font: TFont; const AFileName: String);
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSReadFont(Key, Font, AFileName);
|
||
end;
|
||
//Write procedures
|
||
procedure JSWriteString (const AKey, AValue: UnicodeString; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
SetValue(AKey, AValue);
|
||
Flush;
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSWriteString (const AKey, AValue, AFileName: String); OVERLOAD;
|
||
var Key, Val: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
Val:= UnicodeString(AValue);
|
||
JSWriteString(Key, Val, AFileName);
|
||
end;
|
||
procedure JSWriteInteger (const AKey: UnicodeString; const AValue: Int64; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
SetValue(AKey, AValue);
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSWriteInteger (const AKey: String; const AValue: Int64; const AFileName: String); OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSWriteInteger(Key, AValue, AFileName);
|
||
end;
|
||
procedure JSWriteBoolean (const AKey: UnicodeString; const AValue: Boolean; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
SetValue(AKey, AValue);
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSWriteBoolean (const AKey: String; const AValue: Boolean; const AFileName: String); OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSWriteBoolean(Key, AValue, AFileName);
|
||
end;
|
||
procedure JSWriteRGBColor (const AKey: UnicodeString; const AValue: TRGBColor; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
SetValue(AKey + '/r', AValue.R);
|
||
SetValue(AKey + '/g', AValue.G);
|
||
SetValue(AKey + '/b', AValue.B);
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSWriteRGBColor (const AKey: String; const AValue: TRGBColor; const AFileName: String); OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSWriteRGBColor(Key, AValue, AFileName);
|
||
end;
|
||
procedure JSWriteFont (const AKey: UnicodeString; const AValue: TFont; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
SetValue(AKey + '/charset', Integer(AValue.CharSet));
|
||
SetValue(AKey + '/color', ColorToString(AValue.Color));
|
||
SetValue(AKey + '/height', AValue.Height);
|
||
SetValue(AKey + '/name', AValue.Name);
|
||
SetValue(AKey + '/orientation', AValue.Orientation);
|
||
SetValue(AKey + '/pitch', Integer(AValue.Pitch));
|
||
SetValue(AKey + '/quality', Integer(AValue.Quality));
|
||
SetValue(AKey + '/size', AValue.Size);
|
||
SetValue(AKey + '/style/bold', (fsBold in AValue.Style));
|
||
SetValue(AKey + '/style/italic', (fsItalic in AValue.Style));
|
||
SetValue(AKey + '/style/underline', (fsUnderline in AValue.Style));
|
||
SetValue(AKey + '/style/strikeout', (fsStrikeOut in AValue.Style));
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSWriteFont (const AKey: String; const AValue: TFont; const AFileName: String); OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSWriteFont(Key, AValue, AFileName);
|
||
end;
|
||
//Delete function
|
||
procedure JSDeleteKey (const AKey: UnicodeString; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
DeletePath(AKey);
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSDeleteKey (const AKey, AFileName: String); OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSDeleteKey(Key, AFileName);
|
||
end;
|
||
//Read subkeys
|
||
procedure JSReadSubKeys (const AKey: UnicodeString; SubkeyList: TStrings; const AFileName: String); OVERLOAD;
|
||
var JSConf: TJSONConfig;
|
||
begin
|
||
JSConf:= TJSONConfig.Create(Nil);
|
||
with JSConf do
|
||
begin
|
||
Filename:= AFileName;
|
||
Formatted:= True;
|
||
SubkeyList.Clear;
|
||
EnumSubKeys(AKey, SubkeyList);
|
||
Free;
|
||
end;
|
||
end;
|
||
procedure JSReadSubKeys (const AKey: String; SubkeyList: TStrings; const AFileName: String); OVERLOAD;
|
||
var Key: UnicodeString;
|
||
begin
|
||
Key:= UnicodeString(AKey);
|
||
JSReadSubKeys(Key, SubkeyList, AFileName);
|
||
end;
|
||
end.
|