mirror of https://gitlab.com/basile.b/dexed.git
switch to FPC 3.0.2
This commit is contained in:
Basile Burg
parent
17873dff77
commit
f20a576245
|
|
@ -1,229 +0,0 @@
|
||||||
This package implements JSON support for FPC.
|
|
||||||
|
|
||||||
You might want to have a look at the lazarus jsonviewer tool, written using
|
|
||||||
fpJSON (see lazarus/tools/jsonviewer). It visualizes the fpJSON data and
|
|
||||||
shows how to program using fpjson.
|
|
||||||
|
|
||||||
JSON support consists of 3 parts:
|
|
||||||
|
|
||||||
unit fpJSON contains the data representation. Basically, it defines a set of
|
|
||||||
classes:
|
|
||||||
|
|
||||||
TJSONData
|
|
||||||
+- TJSONNumber
|
|
||||||
+- TJSONIntegerNumber
|
|
||||||
+- TJSONFloatNumber
|
|
||||||
+- TJSONInt64Number
|
|
||||||
+- TJSONString
|
|
||||||
+- TJSONBoolean
|
|
||||||
+- TJSONNull
|
|
||||||
+- TJSONObject
|
|
||||||
+- TJSONArray
|
|
||||||
|
|
||||||
The TJSONData.JSONType property is an enumerated:
|
|
||||||
TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
|
|
||||||
|
|
||||||
Which allows to determine the type of a value.
|
|
||||||
|
|
||||||
The following methods exist:
|
|
||||||
|
|
||||||
Procedure Clear;
|
|
||||||
Clears the value. For arrays and objects, removes all elements/members
|
|
||||||
Function Clone : TJSONData;
|
|
||||||
Creates an exact replica of the valye
|
|
||||||
property Count: Integer;
|
|
||||||
For simple values this is zero, for complex values this is the number of
|
|
||||||
elements/members. Read only.
|
|
||||||
property Items[Index: Integer]: TJSONData
|
|
||||||
For simple values, reading this will result in an error. For complex
|
|
||||||
values, this gives access to the members.
|
|
||||||
property Value: variant;
|
|
||||||
The value as a variant. Only for simple values.
|
|
||||||
Property AsString : TJSONStringType:
|
|
||||||
The value as a string. Only for simple values.
|
|
||||||
Property AsFloat : TJSONFloat;
|
|
||||||
The value as a float (double). only for simple values.
|
|
||||||
Property AsInteger : Integer ;
|
|
||||||
The value as an integer. only for simple values.
|
|
||||||
Property AsInt64 : Int64;
|
|
||||||
The value as an 64-bit integer. only for simple values.
|
|
||||||
Property AsBoolean : Boolean ;
|
|
||||||
The value as a boolean.
|
|
||||||
Property IsNull : Boolean ;
|
|
||||||
Is the value Null ?
|
|
||||||
Property AsJSON : TJSONStringType
|
|
||||||
Return the value in JSON notation. For simple and complex values.
|
|
||||||
|
|
||||||
The TJSONArray type provides access to the elements in the array in the
|
|
||||||
following ways:
|
|
||||||
|
|
||||||
Property Types[Index : Integer] : TJSONType;
|
|
||||||
Indexed access to the types of the elements in the array.
|
|
||||||
Property Nulls[Index : Integer] : Boolean
|
|
||||||
Checks if the Index-the element is NULL.
|
|
||||||
Property Integers[Index : Integer] : Integer
|
|
||||||
Read/Write element values as integers.
|
|
||||||
Property Int64s[Index : Integer] : Int64
|
|
||||||
Read/Write element values as 64-bit integers.
|
|
||||||
Property Strings[Index : Integer] : TJSONStringType;
|
|
||||||
Read/Write element values as strings.
|
|
||||||
Property Floats[Index : Integer] : TJSONFloat ;
|
|
||||||
Read/Write element values as floats (doubles).
|
|
||||||
Property Booleans[Index : Integer] : Boolean;
|
|
||||||
Read/Write element values as booleans.
|
|
||||||
Property Arrays[Index : Integer] : TJSONArray;
|
|
||||||
Read/Write element values as arrays.
|
|
||||||
Property Objects[Index : Integer] : TJSONObject;
|
|
||||||
Read/Write element values a strings
|
|
||||||
|
|
||||||
Reading an element as a type which is incompatible, will result in an
|
|
||||||
exception. For instance if element 5 is an object value, then the following
|
|
||||||
will result in an exception:
|
|
||||||
i:=i+Array.Integers[5]
|
|
||||||
|
|
||||||
The TJSONObject type similarly provides access to the elements in the array
|
|
||||||
using the member names:
|
|
||||||
property Names[Index : Integer] : TJSONStringType;
|
|
||||||
Indexed access to the member names.
|
|
||||||
property Elements[AName: string] : TJSONData;
|
|
||||||
Read/Write a member as a raw TJSONData value.
|
|
||||||
Property Types[AName : String] : TJSONType Read GetTypes;
|
|
||||||
Read/Write the type of a member.
|
|
||||||
Property Nulls[AName : String] : Boolean;
|
|
||||||
Read/Write a member as a NULL value.
|
|
||||||
Property Floats[AName : String] : TJSONFloat;
|
|
||||||
Read/Write a member as a float value (double)
|
|
||||||
Property Integers[AName : String] : Integer;
|
|
||||||
Read/Write a member as an integer value
|
|
||||||
Property Int64s[AName : String] : Int64;
|
|
||||||
Read/Write a member as an 64-bit integer value
|
|
||||||
Property Strings[AName : String] : TJSONStringType;
|
|
||||||
Read/Write a member as a string value.
|
|
||||||
Property Booleans[AName : String] : Boolean;
|
|
||||||
Read/Write a member as a boolean value.
|
|
||||||
Property Arrays[AName : String] : TJSONArray;
|
|
||||||
Read/Write a member as an array value.
|
|
||||||
Property Objects[AName : String] : TJSONObject
|
|
||||||
Read/Write a member as an object value.
|
|
||||||
|
|
||||||
Members can be added with the Add() call, which exists in various overloaded
|
|
||||||
forms:
|
|
||||||
function Add(const AName: TJSONStringType; Const AValue): Integer;
|
|
||||||
Where the type of AVAlue is one of the supported types:
|
|
||||||
integer, int64, double, string, TJSONArray or TJSONObject.
|
|
||||||
|
|
||||||
The Delete() call deletes an element from an array or object. The element is
|
|
||||||
freed.
|
|
||||||
|
|
||||||
Important remark:
|
|
||||||
The array and object classes own their members: the members are destroyed as
|
|
||||||
they are deleted. For this, the Extract() call exists: it removes an
|
|
||||||
element/member from the array/object, without destroying it.
|
|
||||||
|
|
||||||
Converting from string/stream to JSONData
|
|
||||||
=========================================
|
|
||||||
|
|
||||||
The fpjson unit contains a GetJSON() function which accepts a string or a
|
|
||||||
stream as a parameter. The function will parse the JSON in the stream and
|
|
||||||
the return value is a TJSONData value corresponding to the JSON.
|
|
||||||
The function works with a callback, which is set by the JSONParser unit.
|
|
||||||
The JSONParser unit simply needs to be included in the project.
|
|
||||||
|
|
||||||
The parsing happens with default settings for the parser class.
|
|
||||||
You can override this behaviour by creating your own callback,
|
|
||||||
and creating the parser with different settings.
|
|
||||||
|
|
||||||
Enumerator support
|
|
||||||
==================
|
|
||||||
|
|
||||||
the TJSONData class offers support for an enumerator, hence the
|
|
||||||
For e in JSON do
|
|
||||||
construct can be used. The enumerator is a TJSONEnum value, which has 3
|
|
||||||
members:
|
|
||||||
Key : The key of the element
|
|
||||||
(name in TJSONObject, Index in TJSONArray, empty otherwise)
|
|
||||||
KeyNum: The index of the element.
|
|
||||||
(Index in TJSONArray/TJSONObject, 0 otherwise)
|
|
||||||
Value : The value of the element
|
|
||||||
(These are the member values for TJSONArray/TJSONObject, and is the
|
|
||||||
element itself otherwise)
|
|
||||||
|
|
||||||
While the enumerator is looping, it is not allowed to change the content of
|
|
||||||
the array or object, and the value may not be freed.
|
|
||||||
|
|
||||||
Scanner/Parser
|
|
||||||
==============
|
|
||||||
|
|
||||||
The JSONSCanner unit contains a scanner for JSON data: TJSONScanner.
|
|
||||||
Currently it does not support full unicode, only UTF-8 is supported.
|
|
||||||
|
|
||||||
The JSONParser unit contains the parser for JSON data: TJSONParser.
|
|
||||||
It uses to scanner to read the tokens. The scanner is created automatically.
|
|
||||||
|
|
||||||
|
|
||||||
The Parse method will parse the data that was passed to the parser and will
|
|
||||||
return the JSON value.
|
|
||||||
|
|
||||||
Sample use:
|
|
||||||
|
|
||||||
Var
|
|
||||||
P : TJSONParser;
|
|
||||||
S : String;
|
|
||||||
D : TJSONObject;
|
|
||||||
|
|
||||||
begin
|
|
||||||
P:=TJSONParser.Create('{ "top": 10, "left": 20}');
|
|
||||||
try
|
|
||||||
D:=P.Parse as TJSONObject;
|
|
||||||
Writeln('Top : ',D.Integers['top']);
|
|
||||||
Writeln('Left : ',D.Integers['left']);
|
|
||||||
D.free;
|
|
||||||
Finally
|
|
||||||
P.free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Note that the member names are case sensitive.
|
|
||||||
|
|
||||||
As an alternative, a stream may be passed to the constructor of TJSONParser.
|
|
||||||
|
|
||||||
The scanner and parser support the 'Strict' property.
|
|
||||||
Strict JSON syntax requires the member names of an object to be strings:
|
|
||||||
{ "top": 10, "left": 20}
|
|
||||||
However, due to the sloppy definition of Javascript (and hence JSON),
|
|
||||||
the following type of JSON notation is frequently encountered:
|
|
||||||
{ top: 10, left: 20}
|
|
||||||
By default, this sloppy notation is accepted. Setting 'Strict' to true will
|
|
||||||
reject this.
|
|
||||||
|
|
||||||
A second effect of the Strict property is the requirement of " as a string
|
|
||||||
delimiter. A single quote is also often found in Javascript and JSON:
|
|
||||||
{ title: 'A nice title' }
|
|
||||||
By default, this is accepted. Setting 'Strict' to true will reject this.
|
|
||||||
|
|
||||||
Customizing the classes : Factory support
|
|
||||||
=========================================
|
|
||||||
|
|
||||||
The various classes created by the methods can be customized.
|
|
||||||
This can be useful to create customized descendents, for example to attach
|
|
||||||
extra data to the various values. All instances of TJSONData are created
|
|
||||||
through the CreateJSON() functions, which use a set of customizable classes
|
|
||||||
to create the JSONData structures.
|
|
||||||
|
|
||||||
All functions which somehow create a new instance (clone, add, insert, parsing)
|
|
||||||
use the CreateJSON functions.
|
|
||||||
|
|
||||||
Which classes need to be created for a specific value is enumerated in
|
|
||||||
|
|
||||||
TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberFloat,
|
|
||||||
jitString, jitBoolean, jitNull, jitArray, jitObject);
|
|
||||||
|
|
||||||
when a Int64 value must be instantiated, the class identified with
|
|
||||||
jitNumberInt64 is instantiated.
|
|
||||||
|
|
||||||
To customize the classes, the new class can be set using SetJSONInstanceType:
|
|
||||||
|
|
||||||
Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass);
|
|
||||||
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
|
|
||||||
|
|
||||||
The function checks whether sane classes are specified.;
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -1,809 +0,0 @@
|
||||||
{
|
|
||||||
This file is part of the Free Component Library
|
|
||||||
|
|
||||||
Implementation of TJSONConfig class
|
|
||||||
Copyright (c) 2007 Michael Van Canneyt michael@freepascal.org
|
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
|
||||||
for details about the copyright.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
||||||
|
|
||||||
**********************************************************************}
|
|
||||||
|
|
||||||
{
|
|
||||||
TJSONConfig enables applications to use JSON files for storing their
|
|
||||||
configuration data
|
|
||||||
}
|
|
||||||
|
|
||||||
{$IFDEF FPC}
|
|
||||||
{$MODE objfpc}
|
|
||||||
{$H+}
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
unit xjsonConf;
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
SysUtils, Classes, xfpjson, xjsonscanner, xjsonparser;
|
|
||||||
|
|
||||||
Const
|
|
||||||
DefaultJSONOptions = [joUTF8,joComments];
|
|
||||||
|
|
||||||
type
|
|
||||||
EJSONConfigError = class(Exception);
|
|
||||||
|
|
||||||
(* ********************************************************************
|
|
||||||
"APath" is the path and name of a value: A JSON configuration file
|
|
||||||
is hierachical. "/" is the path delimiter, the part after the last
|
|
||||||
"/" is the name of the value. The path components will be mapped
|
|
||||||
to nested JSON objects, with the name equal to the part. In practice
|
|
||||||
this means that "/my/path/value" will be written as:
|
|
||||||
{
|
|
||||||
"my" : {
|
|
||||||
"path" : {
|
|
||||||
"value" : Value
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
******************************************************************** *)
|
|
||||||
|
|
||||||
{ TJSONConfig }
|
|
||||||
|
|
||||||
TJSONConfig = class(TComponent)
|
|
||||||
private
|
|
||||||
FFilename: String;
|
|
||||||
FFormatIndentSize: Integer;
|
|
||||||
FFormatoptions: TFormatOptions;
|
|
||||||
FFormatted: Boolean;
|
|
||||||
FJSONOptions: TJSONOptions;
|
|
||||||
FKey: TJSONObject;
|
|
||||||
procedure DoSetFilename(const AFilename: String; ForceReload: Boolean);
|
|
||||||
procedure SetFilename(const AFilename: String);
|
|
||||||
procedure SetJSONOptions(AValue: TJSONOptions);
|
|
||||||
Function StripSlash(Const P : UnicodeString) : UnicodeString;
|
|
||||||
protected
|
|
||||||
FJSON: TJSONObject;
|
|
||||||
FModified: Boolean;
|
|
||||||
procedure Loaded; override;
|
|
||||||
function FindPath(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
|
|
||||||
function FindObject(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
|
|
||||||
function FindObject(Const APath: UnicodeString; AllowCreate : Boolean;Out ElName : UnicodeString) : TJSONObject;
|
|
||||||
function FindElement(Const APath: UnicodeString; CreateParent : Boolean; AllowObject : Boolean = False) : TJSONData;
|
|
||||||
function FindElement(Const APath: UnicodeString; CreateParent : Boolean; out AParent : TJSONObject; Out ElName : UnicodeString; AllowObject : Boolean = False) : TJSONData;
|
|
||||||
public
|
|
||||||
constructor Create(AOwner: TComponent); override;
|
|
||||||
destructor Destroy; override;
|
|
||||||
Procedure Reload;
|
|
||||||
procedure Clear;
|
|
||||||
procedure Flush; // Writes the JSON file
|
|
||||||
procedure OpenKey(const aPath: UnicodeString; AllowCreate : Boolean);
|
|
||||||
procedure CloseKey;
|
|
||||||
procedure ResetKey;
|
|
||||||
Procedure EnumSubKeys(Const APath : UnicodeString; List : TStrings);
|
|
||||||
Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
|
|
||||||
|
|
||||||
function GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
|
|
||||||
function GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
|
|
||||||
function GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
|
|
||||||
function GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
|
|
||||||
function GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
|
|
||||||
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
|
|
||||||
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
|
|
||||||
procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
|
|
||||||
procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
|
|
||||||
procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
|
|
||||||
procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
|
|
||||||
procedure SetValue(const APath: UnicodeString; AValue: Double); overload;
|
|
||||||
procedure SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False); overload;
|
|
||||||
|
|
||||||
procedure SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString); overload;
|
|
||||||
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Integer); overload;
|
|
||||||
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Int64); overload;
|
|
||||||
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Boolean); overload;
|
|
||||||
|
|
||||||
procedure DeletePath(const APath: UnicodeString);
|
|
||||||
procedure DeleteValue(const APath: UnicodeString);
|
|
||||||
property Modified: Boolean read FModified;
|
|
||||||
published
|
|
||||||
Property Filename: String read FFilename write SetFilename;
|
|
||||||
Property Formatted : Boolean Read FFormatted Write FFormatted;
|
|
||||||
Property FormatOptions : TFormatOptions Read FFormatoptions Write FFormatOptions Default DefaultFormat;
|
|
||||||
Property FormatIndentsize : Integer Read FFormatIndentSize Write FFormatIndentSize Default DefaultIndentSize;
|
|
||||||
Property JSONOptions : TJSONOptions Read FJSONOptions Write SetJSONOptions Default DefaultJSONOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
// ===================================================================
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
Resourcestring
|
|
||||||
SErrInvalidJSONFile = '"%s" is not a valid JSON configuration file.';
|
|
||||||
SErrCouldNotOpenKey = 'Could not open key "%s".';
|
|
||||||
|
|
||||||
constructor TJSONConfig.Create(AOwner: TComponent);
|
|
||||||
begin
|
|
||||||
inherited Create(AOwner);
|
|
||||||
FJSON:=TJSONObject.Create;
|
|
||||||
FKey:=FJSON;
|
|
||||||
FFormatOptions:=DefaultFormat;
|
|
||||||
FFormatIndentsize:=DefaultIndentSize;
|
|
||||||
FJSONOptions:=DefaultJSONOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TJSONConfig.Destroy;
|
|
||||||
begin
|
|
||||||
if Assigned(FJSON) then
|
|
||||||
begin
|
|
||||||
Flush;
|
|
||||||
FreeANdNil(FJSON);
|
|
||||||
end;
|
|
||||||
inherited Destroy;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.Clear;
|
|
||||||
begin
|
|
||||||
FJSON.Clear;
|
|
||||||
FKey:=FJSON;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.Flush;
|
|
||||||
|
|
||||||
Var
|
|
||||||
F : TFileStream;
|
|
||||||
S : TJSONStringType;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if Modified then
|
|
||||||
begin
|
|
||||||
F:=TFileStream.Create(FileName,fmCreate);
|
|
||||||
Try
|
|
||||||
if Formatted then
|
|
||||||
S:=FJSON.FormatJSON(Formatoptions,FormatIndentSize)
|
|
||||||
else
|
|
||||||
S:=FJSON.AsJSON;
|
|
||||||
if S>'' then
|
|
||||||
F.WriteBuffer(S[1],Length(S));
|
|
||||||
Finally
|
|
||||||
F.Free;
|
|
||||||
end;
|
|
||||||
FModified := False;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean
|
|
||||||
): TJSONObject;
|
|
||||||
|
|
||||||
Var
|
|
||||||
Dummy : UnicodeString;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=FindObject(APath,AllowCreate,Dummy);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean;
|
|
||||||
out ElName: UnicodeString): TJSONObject;
|
|
||||||
|
|
||||||
Var
|
|
||||||
S,El : UnicodeString;
|
|
||||||
P,I : Integer;
|
|
||||||
T : TJSonObject;
|
|
||||||
|
|
||||||
begin
|
|
||||||
// Writeln('Looking for : ', APath);
|
|
||||||
S:=APath;
|
|
||||||
If Pos('/',S)=1 then
|
|
||||||
Result:=FJSON
|
|
||||||
else
|
|
||||||
Result:=FKey;
|
|
||||||
Repeat
|
|
||||||
P:=Pos('/',S);
|
|
||||||
If (P<>0) then
|
|
||||||
begin
|
|
||||||
// Only real paths, ignore double slash
|
|
||||||
If (P<>1) then
|
|
||||||
begin
|
|
||||||
El:=Copy(S,1,P-1);
|
|
||||||
If (Result.Count=0) then
|
|
||||||
I:=-1
|
|
||||||
else
|
|
||||||
I:=Result.IndexOfName(UTF8Encode(El));
|
|
||||||
If (I=-1) then
|
|
||||||
// No element with this name.
|
|
||||||
begin
|
|
||||||
If AllowCreate then
|
|
||||||
begin
|
|
||||||
// Create new node.
|
|
||||||
T:=Result;
|
|
||||||
Result:=TJSonObject.Create;
|
|
||||||
T.Add(UTF8Encode(El),Result);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Result:=Nil
|
|
||||||
end
|
|
||||||
else
|
|
||||||
// Node found, check if it is an object
|
|
||||||
begin
|
|
||||||
if (Result.Items[i].JSONtype=jtObject) then
|
|
||||||
Result:=Result.Objects[UTF8Encode(el)]
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
// Writeln(el,' type wrong');
|
|
||||||
If AllowCreate then
|
|
||||||
begin
|
|
||||||
// Writeln('Creating ',el);
|
|
||||||
Result.Delete(I);
|
|
||||||
T:=Result;
|
|
||||||
Result:=TJSonObject.Create;
|
|
||||||
T.Add(UTF8Encode(El),Result);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Result:=Nil
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Delete(S,1,P);
|
|
||||||
end;
|
|
||||||
Until (P=0) or (Result=Nil);
|
|
||||||
ElName:=S;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.FindElement(const APath: UnicodeString; CreateParent: Boolean; AllowObject : Boolean = False): TJSONData;
|
|
||||||
|
|
||||||
Var
|
|
||||||
O : TJSONObject;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=FindElement(APath,CreateParent,O,ElName,AllowObject);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.FindElement(const APath: UnicodeString;
|
|
||||||
CreateParent: Boolean; out AParent: TJSONObject; out ElName: UnicodeString;
|
|
||||||
AllowObject : Boolean = False): TJSONData;
|
|
||||||
|
|
||||||
Var
|
|
||||||
I : Integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=Nil;
|
|
||||||
Aparent:=FindObject(APath,CreateParent,ElName);
|
|
||||||
If Assigned(Aparent) then
|
|
||||||
begin
|
|
||||||
// Writeln('Found parent, looking for element:',elName);
|
|
||||||
I:=AParent.IndexOfName(UTF8Encode(ElName));
|
|
||||||
// Writeln('Element index is',I);
|
|
||||||
If (I<>-1) And ((AParent.items[I].JSONType<>jtObject) or AllowObject) then
|
|
||||||
Result:=AParent.Items[i];
|
|
||||||
end;
|
|
||||||
// Writeln('Find ',aPath,' in "',FJSON.AsJSOn,'" : ',Elname,' : ',Result<>NIl);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),False);
|
|
||||||
If Assigned(El) then
|
|
||||||
Result:=El.AsUnicodeString
|
|
||||||
else
|
|
||||||
Result:=ADefault;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),False);
|
|
||||||
If Not Assigned(el) then
|
|
||||||
Result:=ADefault
|
|
||||||
else if (el is TJSONNumber) then
|
|
||||||
Result:=El.AsInteger
|
|
||||||
else
|
|
||||||
Result:=StrToIntDef(El.AsString,ADefault);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),False);
|
|
||||||
If Not Assigned(el) then
|
|
||||||
Result:=ADefault
|
|
||||||
else if (el is TJSONNumber) then
|
|
||||||
Result:=El.AsInt64
|
|
||||||
else
|
|
||||||
Result:=StrToInt64Def(El.AsString,ADefault);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),False);
|
|
||||||
If Not Assigned(el) then
|
|
||||||
Result:=ADefault
|
|
||||||
else if (el is TJSONBoolean) then
|
|
||||||
Result:=El.AsBoolean
|
|
||||||
else
|
|
||||||
Result:=StrToBoolDef(El.AsString,ADefault);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),False);
|
|
||||||
If Not Assigned(el) then
|
|
||||||
Result:=ADefault
|
|
||||||
else if (el is TJSONNumber) then
|
|
||||||
Result:=El.AsFloat
|
|
||||||
else
|
|
||||||
Result:=StrToFloatDef(El.AsString,ADefault);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
|
|
||||||
const ADefault: String): Boolean;
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
D : TJSONEnum;
|
|
||||||
|
|
||||||
begin
|
|
||||||
AValue.Clear;
|
|
||||||
El:=FindElement(StripSlash(APath),False,True);
|
|
||||||
Result:=Assigned(el);
|
|
||||||
If Not Result then
|
|
||||||
begin
|
|
||||||
AValue.Text:=ADefault;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
Case El.JSONType of
|
|
||||||
jtArray:
|
|
||||||
For D in El do
|
|
||||||
if D.Value.JSONType in ActualValueJSONTypes then
|
|
||||||
AValue.Add(D.Value.AsString);
|
|
||||||
jtObject:
|
|
||||||
For D in El do
|
|
||||||
if D.Value.JSONType in ActualValueJSONTypes then
|
|
||||||
AValue.Add(D.Key+'='+D.Value.AsString);
|
|
||||||
else
|
|
||||||
AValue.Text:=EL.AsString
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
|
|
||||||
const ADefault: TStrings): Boolean;
|
|
||||||
begin
|
|
||||||
Result:=GetValue(APath,AValue,'');
|
|
||||||
If Not Result then
|
|
||||||
AValue.Assign(ADefault);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetValue(const APath: UnicodeString; const AValue: UnicodeString);
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
O : TJSONObject;
|
|
||||||
I : integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),True,O,ElName);
|
|
||||||
if Assigned(El) and (El.JSONType<>jtString) then
|
|
||||||
begin
|
|
||||||
I:=O.IndexOfName(UTF8Encode(elName));
|
|
||||||
O.Delete(i);
|
|
||||||
El:=Nil;
|
|
||||||
end;
|
|
||||||
If Not Assigned(el) then
|
|
||||||
begin
|
|
||||||
El:=TJSONString.Create(AValue);
|
|
||||||
O.Add(UTF8Encode(ElName),El);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
El.AsUnicodeString:=AValue;
|
|
||||||
FModified:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
|
|
||||||
begin
|
|
||||||
if AValue = DefValue then
|
|
||||||
DeleteValue(APath)
|
|
||||||
else
|
|
||||||
SetValue(APath, AValue);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Integer);
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
O : TJSONObject;
|
|
||||||
I : integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),True,O,ElName);
|
|
||||||
if Assigned(El) and (Not (El is TJSONIntegerNumber)) then
|
|
||||||
begin
|
|
||||||
I:=O.IndexOfName(UTF8Encode(elName));
|
|
||||||
If (I<>-1) then // Normally not needed...
|
|
||||||
O.Delete(i);
|
|
||||||
El:=Nil;
|
|
||||||
end;
|
|
||||||
If Not Assigned(el) then
|
|
||||||
begin
|
|
||||||
El:=TJSONIntegerNumber.Create(AValue);
|
|
||||||
O.Add(UTF8Encode(ElName),El);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
El.AsInteger:=AValue;
|
|
||||||
FModified:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Int64);
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
O : TJSONObject;
|
|
||||||
I : integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),True,O,ElName);
|
|
||||||
if Assigned(El) and (Not (El is TJSONInt64Number)) then
|
|
||||||
begin
|
|
||||||
I:=O.IndexOfName(UTF8Encode(elName));
|
|
||||||
If (I<>-1) then // Normally not needed...
|
|
||||||
O.Delete(i);
|
|
||||||
El:=Nil;
|
|
||||||
end;
|
|
||||||
If Not Assigned(el) then
|
|
||||||
begin
|
|
||||||
El:=TJSONInt64Number.Create(AValue);
|
|
||||||
O.Add(UTF8Encode(ElName),El);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
El.AsInt64:=AValue;
|
|
||||||
FModified:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
|
|
||||||
DefValue: Integer);
|
|
||||||
begin
|
|
||||||
if AValue = DefValue then
|
|
||||||
DeleteValue(APath)
|
|
||||||
else
|
|
||||||
SetValue(APath, AValue);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
|
|
||||||
DefValue: Int64);
|
|
||||||
begin
|
|
||||||
if AValue = DefValue then
|
|
||||||
DeleteValue(APath)
|
|
||||||
else
|
|
||||||
SetValue(APath, AValue);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Boolean);
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
O : TJSONObject;
|
|
||||||
I : integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),True,O,ElName);
|
|
||||||
if Assigned(El) and (el.JSONType<>jtBoolean) then
|
|
||||||
begin
|
|
||||||
I:=O.IndexOfName(UTF8Encode(elName));
|
|
||||||
O.Delete(i);
|
|
||||||
El:=Nil;
|
|
||||||
end;
|
|
||||||
If Not Assigned(el) then
|
|
||||||
begin
|
|
||||||
El:=TJSONBoolean.Create(AValue);
|
|
||||||
O.Add(UTF8Encode(ElName),El);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
El.AsBoolean:=AValue;
|
|
||||||
FModified:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Double);
|
|
||||||
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
O : TJSONObject;
|
|
||||||
I : integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),True,O,ElName);
|
|
||||||
if Assigned(El) and (Not (El is TJSONFloatNumber)) then
|
|
||||||
begin
|
|
||||||
I:=O.IndexOfName(UTF8Encode(elName));
|
|
||||||
O.Delete(i);
|
|
||||||
El:=Nil;
|
|
||||||
end;
|
|
||||||
If Not Assigned(el) then
|
|
||||||
begin
|
|
||||||
El:=TJSONFloatNumber.Create(AValue);
|
|
||||||
O.Add(UTF8Encode(ElName),El);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
El.AsFloat:=AValue;
|
|
||||||
FModified:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False);
|
|
||||||
var
|
|
||||||
El : TJSONData;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
O : TJSONObject;
|
|
||||||
I : integer;
|
|
||||||
A : TJSONArray;
|
|
||||||
N,V : String;
|
|
||||||
DoDelete: Boolean;
|
|
||||||
|
|
||||||
begin
|
|
||||||
El:=FindElement(StripSlash(APath),True,O,ElName,True);
|
|
||||||
if Assigned(El) then
|
|
||||||
begin
|
|
||||||
if AsObject then
|
|
||||||
DoDelete:=(Not (El is TJSONObject))
|
|
||||||
else
|
|
||||||
DoDelete:=(Not (El is TJSONArray));
|
|
||||||
if DoDelete then
|
|
||||||
begin
|
|
||||||
I:=O.IndexOfName(UTF8Encode(elName));
|
|
||||||
O.Delete(i);
|
|
||||||
El:=Nil;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
If Not Assigned(el) then
|
|
||||||
begin
|
|
||||||
if AsObject then
|
|
||||||
El:=TJSONObject.Create
|
|
||||||
else
|
|
||||||
El:=TJSONArray.Create;
|
|
||||||
O.Add(UTF8Encode(ElName),El);
|
|
||||||
end;
|
|
||||||
if Not AsObject then
|
|
||||||
begin
|
|
||||||
A:=El as TJSONArray;
|
|
||||||
A.Clear;
|
|
||||||
For N in Avalue do
|
|
||||||
A.Add(N);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
O:=El as TJSONObject;
|
|
||||||
For I:=0 to AValue.Count-1 do
|
|
||||||
begin
|
|
||||||
AValue.GetNameValue(I,N,V);
|
|
||||||
O.Add(N,V);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
FModified:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
|
|
||||||
DefValue: Boolean);
|
|
||||||
begin
|
|
||||||
if AValue = DefValue then
|
|
||||||
DeleteValue(APath)
|
|
||||||
else
|
|
||||||
SetValue(APath,AValue);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.DeletePath(const APath: UnicodeString);
|
|
||||||
|
|
||||||
Var
|
|
||||||
P : UnicodeString;
|
|
||||||
L : integer;
|
|
||||||
Node : TJSONObject;
|
|
||||||
ElName : UnicodeString;
|
|
||||||
|
|
||||||
begin
|
|
||||||
P:=StripSlash(APath);
|
|
||||||
L:=Length(P);
|
|
||||||
If (L>0) then
|
|
||||||
begin
|
|
||||||
Node := FindObject(P,False,ElName);
|
|
||||||
If Assigned(Node) then
|
|
||||||
begin
|
|
||||||
L:=Node.IndexOfName(UTF8Encode(ElName));
|
|
||||||
If (L<>-1) then
|
|
||||||
Node.Delete(L);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.DeleteValue(const APath: UnicodeString);
|
|
||||||
|
|
||||||
begin
|
|
||||||
DeletePath(APath);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.Reload;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if Length(Filename) > 0 then
|
|
||||||
DoSetFilename(Filename,True);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.Loaded;
|
|
||||||
begin
|
|
||||||
inherited Loaded;
|
|
||||||
Reload;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.FindPath(const APath: UnicodeString; AllowCreate: Boolean
|
|
||||||
): TJSONObject;
|
|
||||||
|
|
||||||
Var
|
|
||||||
P : UnicodeString;
|
|
||||||
L : Integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
P:=APath;
|
|
||||||
L:=Length(P);
|
|
||||||
If (L=0) or (P[L]<>'/') then
|
|
||||||
P:=P+'/';
|
|
||||||
Result:=FindObject(P,AllowCreate);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean);
|
|
||||||
|
|
||||||
Var
|
|
||||||
P : TJSONParser;
|
|
||||||
J : TJSONData;
|
|
||||||
F : TFileStream;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if (not ForceReload) and (FFilename = AFilename) then
|
|
||||||
exit;
|
|
||||||
FFilename := AFilename;
|
|
||||||
|
|
||||||
if csLoading in ComponentState then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
Flush;
|
|
||||||
If Not FileExists(AFileName) then
|
|
||||||
Clear
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
F:=TFileStream.Create(AFileName,fmopenRead);
|
|
||||||
try
|
|
||||||
P:=TJSONParser.Create(F,FJSONOptions);
|
|
||||||
try
|
|
||||||
J:=P.Parse;
|
|
||||||
If (J is TJSONObject) then
|
|
||||||
begin
|
|
||||||
FreeAndNil(FJSON);
|
|
||||||
FJSON:=J as TJSONObject;
|
|
||||||
FKey:=FJSON;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile,[AFileName]);
|
|
||||||
finally
|
|
||||||
P.Free;
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
F.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetFilename(const AFilename: String);
|
|
||||||
begin
|
|
||||||
DoSetFilename(AFilename, False);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.SetJSONOptions(AValue: TJSONOptions);
|
|
||||||
begin
|
|
||||||
if FJSONOptions=AValue then Exit;
|
|
||||||
FJSONOptions:=AValue;
|
|
||||||
if csLoading in ComponentState then
|
|
||||||
exit;
|
|
||||||
if (FFileName<>'') then
|
|
||||||
Reload;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONConfig.StripSlash(const P: UnicodeString): UnicodeString;
|
|
||||||
|
|
||||||
Var
|
|
||||||
L : Integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
L:=Length(P);
|
|
||||||
If (L>0) and (P[l]='/') then
|
|
||||||
Result:=Copy(P,1,L-1)
|
|
||||||
else
|
|
||||||
Result:=P;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TJSONConfig.CloseKey;
|
|
||||||
begin
|
|
||||||
ResetKey;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.OpenKey(const aPath: UnicodeString; AllowCreate: Boolean);
|
|
||||||
|
|
||||||
Var
|
|
||||||
P : UnicodeString;
|
|
||||||
L : Integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
P:=APath;
|
|
||||||
L:=Length(P);
|
|
||||||
If (L=0) then
|
|
||||||
FKey:=FJSON
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if (P[L]<>'/') then
|
|
||||||
P:=P+'/';
|
|
||||||
FKey:=FindObject(P,AllowCreate);
|
|
||||||
If (FKey=Nil) Then
|
|
||||||
Raise EJSONConfigError.CreateFmt(SErrCouldNotOpenKey,[APath]);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.ResetKey;
|
|
||||||
begin
|
|
||||||
FKey:=FJSON;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.EnumSubKeys(const APath: UnicodeString; List: TStrings);
|
|
||||||
|
|
||||||
Var
|
|
||||||
AKey : TJSONObject;
|
|
||||||
I : Integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
AKey:=FindPath(APath,False);
|
|
||||||
If Assigned(AKey) then
|
|
||||||
begin
|
|
||||||
For I:=0 to AKey.Count-1 do
|
|
||||||
If AKey.Items[i] is TJSONObject then
|
|
||||||
List.Add(AKey.Names[i]);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONConfig.EnumValues(const APath: UnicodeString; List: TStrings);
|
|
||||||
|
|
||||||
Var
|
|
||||||
AKey : TJSONObject;
|
|
||||||
I : Integer;
|
|
||||||
|
|
||||||
begin
|
|
||||||
AKey:=FindPath(APath,False);
|
|
||||||
If Assigned(AKey) then
|
|
||||||
begin
|
|
||||||
For I:=0 to AKey.Count-1 do
|
|
||||||
If Not (AKey.Items[i] is TJSONObject) then
|
|
||||||
List.Add(AKey.Names[i]);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
@ -1,382 +0,0 @@
|
||||||
{
|
|
||||||
This file is part of the Free Component Library
|
|
||||||
|
|
||||||
JSON source parser
|
|
||||||
Copyright (c) 2007 by Michael Van Canneyt michael@freepascal.org
|
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
|
||||||
for details about the copyright.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
||||||
|
|
||||||
**********************************************************************}
|
|
||||||
{$mode objfpc}
|
|
||||||
{$h+}
|
|
||||||
unit xjsonparser;
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, xfpJSON, xjsonscanner;
|
|
||||||
|
|
||||||
Type
|
|
||||||
|
|
||||||
{ TJSONParser }
|
|
||||||
|
|
||||||
TJSONParser = Class(TObject)
|
|
||||||
Private
|
|
||||||
FScanner : TJSONScanner;
|
|
||||||
function GetO(AIndex: TJSONOption): Boolean;
|
|
||||||
function GetOptions: TJSONOptions;
|
|
||||||
function ParseNumber: TJSONNumber;
|
|
||||||
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
|
|
||||||
procedure SetOptions(AValue: TJSONOptions);
|
|
||||||
Protected
|
|
||||||
procedure DoError(const Msg: String);
|
|
||||||
function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
|
|
||||||
function GetNextToken: TJSONToken;
|
|
||||||
function CurrentTokenString: String;
|
|
||||||
function CurrentToken: TJSONToken;
|
|
||||||
function ParseArray: TJSONArray;
|
|
||||||
function ParseObject: TJSONObject;
|
|
||||||
Property Scanner : TJSONScanner read FScanner;
|
|
||||||
Public
|
|
||||||
function Parse: TJSONData;
|
|
||||||
Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
|
|
||||||
Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
|
|
||||||
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
|
|
||||||
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
|
|
||||||
destructor Destroy();override;
|
|
||||||
// Use strict JSON: " for strings, object members are strings, not identifiers
|
|
||||||
Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
|
|
||||||
// if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
|
|
||||||
Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
|
|
||||||
// Parsing options
|
|
||||||
Property Options : TJSONOptions Read GetOptions Write SetOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
EJSONParser = Class(EParserError);
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
Resourcestring
|
|
||||||
SErrUnexpectedEOF = 'Unexpected EOF encountered.';
|
|
||||||
SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
|
|
||||||
SErrExpectedColon = 'Expected colon (:), got token "%s".';
|
|
||||||
SErrUnexpectedComma = 'Invalid comma encountered.';
|
|
||||||
SErrEmptyElement = 'Empty element encountered.';
|
|
||||||
SErrExpectedElementName = 'Expected element name, got token "%s"';
|
|
||||||
SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
|
|
||||||
SErrInvalidNumber = 'Number is not an integer or real number: %s';
|
|
||||||
SErrNoScanner = 'No scanner. No source specified ?';
|
|
||||||
|
|
||||||
{ TJSONParser }
|
|
||||||
|
|
||||||
procedure DefJSONParserHandler(AStream: TStream; const AUseUTF8: Boolean; out
|
|
||||||
Data: TJSONData);
|
|
||||||
|
|
||||||
Var
|
|
||||||
P : TJSONParser;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Data:=Nil;
|
|
||||||
P:=TJSONParser.Create(AStream,[joUTF8]);
|
|
||||||
try
|
|
||||||
Data:=P.Parse;
|
|
||||||
finally
|
|
||||||
P.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONParser.Parse: TJSONData;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if (FScanner=Nil) then
|
|
||||||
DoError(SErrNoScanner);
|
|
||||||
Result:=DoParse(False,True);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{
|
|
||||||
Consume next token and convert to JSON data structure.
|
|
||||||
If AtCurrent is true, the current token is used. If false,
|
|
||||||
a token is gotten from the scanner.
|
|
||||||
If AllowEOF is false, encountering a tkEOF will result in an exception.
|
|
||||||
}
|
|
||||||
|
|
||||||
function TJSONParser.CurrentToken: TJSONToken;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=FScanner.CurToken;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONParser.CurrentTokenString: String;
|
|
||||||
|
|
||||||
begin
|
|
||||||
If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
|
|
||||||
Result:=FScanner.CurTokenString
|
|
||||||
else
|
|
||||||
Result:=TokenInfos[CurrentToken];
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONParser.DoParse(AtCurrent, AllowEOF: Boolean): TJSONData;
|
|
||||||
|
|
||||||
var
|
|
||||||
T : TJSONToken;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=nil;
|
|
||||||
try
|
|
||||||
If not AtCurrent then
|
|
||||||
T:=GetNextToken
|
|
||||||
else
|
|
||||||
T:=FScanner.CurToken;
|
|
||||||
Case T of
|
|
||||||
tkEof : If Not AllowEof then
|
|
||||||
DoError(SErrUnexpectedEOF);
|
|
||||||
tkNull : Result:=CreateJSON;
|
|
||||||
tkTrue,
|
|
||||||
tkFalse : Result:=CreateJSON(t=tkTrue);
|
|
||||||
tkString : if joUTF8 in Options then
|
|
||||||
Result:=CreateJSON(UTF8Decode(CurrentTokenString))
|
|
||||||
else
|
|
||||||
Result:=CreateJSON(CurrentTokenString);
|
|
||||||
tkCurlyBraceOpen : Result:=ParseObject;
|
|
||||||
tkCurlyBraceClose : DoError(SErrUnexpectedToken);
|
|
||||||
tkSQuaredBraceOpen : Result:=ParseArray;
|
|
||||||
tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
|
|
||||||
tkNumber : Result:=ParseNumber;
|
|
||||||
tkComma : DoError(SErrUnexpectedToken);
|
|
||||||
end;
|
|
||||||
except
|
|
||||||
FreeAndNil(Result);
|
|
||||||
Raise;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
// Creates the correct JSON number type, based on the current token.
|
|
||||||
function TJSONParser.ParseNumber: TJSONNumber;
|
|
||||||
|
|
||||||
Var
|
|
||||||
I : Integer;
|
|
||||||
I64 : Int64;
|
|
||||||
QW : QWord;
|
|
||||||
F : TJSONFloat;
|
|
||||||
S : String;
|
|
||||||
|
|
||||||
begin
|
|
||||||
S:=CurrentTokenString;
|
|
||||||
I:=0;
|
|
||||||
if TryStrToQWord(S,QW) then
|
|
||||||
begin
|
|
||||||
if QW>qword(high(Int64)) then
|
|
||||||
Result:=CreateJSON(QW)
|
|
||||||
else
|
|
||||||
if QW>MaxInt then
|
|
||||||
begin
|
|
||||||
I64 := QW;
|
|
||||||
Result:=CreateJSON(I64);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
I := QW;
|
|
||||||
Result:=CreateJSON(I);
|
|
||||||
end
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
If TryStrToInt64(S,I64) then
|
|
||||||
if (I64>Maxint) or (I64<-MaxInt) then
|
|
||||||
Result:=CreateJSON(I64)
|
|
||||||
Else
|
|
||||||
begin
|
|
||||||
I:=I64;
|
|
||||||
Result:=CreateJSON(I);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
I:=0;
|
|
||||||
Val(S,F,I);
|
|
||||||
If (I<>0) then
|
|
||||||
DoError(SErrInvalidNumber);
|
|
||||||
Result:=CreateJSON(F);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONParser.GetO(AIndex: TJSONOption): Boolean;
|
|
||||||
begin
|
|
||||||
Result:=AIndex in Options;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONParser.GetOptions: TJSONOptions;
|
|
||||||
begin
|
|
||||||
Result:=FScanner.Options
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONParser.SetO(AIndex: TJSONOption; AValue: Boolean);
|
|
||||||
begin
|
|
||||||
if aValue then
|
|
||||||
FScanner.Options:=FScanner.Options+[AINdex]
|
|
||||||
else
|
|
||||||
FScanner.Options:=FScanner.Options-[AINdex]
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONParser.SetOptions(AValue: TJSONOptions);
|
|
||||||
begin
|
|
||||||
FScanner.Options:=AValue;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
// Current token is {, on exit current token is }
|
|
||||||
function TJSONParser.ParseObject: TJSONObject;
|
|
||||||
|
|
||||||
Var
|
|
||||||
T : TJSONtoken;
|
|
||||||
E : TJSONData;
|
|
||||||
N : String;
|
|
||||||
LastComma : Boolean;
|
|
||||||
|
|
||||||
begin
|
|
||||||
LastComma:=False;
|
|
||||||
Result:=CreateJSONObject([]);
|
|
||||||
Try
|
|
||||||
T:=GetNextToken;
|
|
||||||
While T<>tkCurlyBraceClose do
|
|
||||||
begin
|
|
||||||
If (T<>tkString) and (T<>tkIdentifier) then
|
|
||||||
DoError(SErrExpectedElementName);
|
|
||||||
N:=CurrentTokenString;
|
|
||||||
T:=GetNextToken;
|
|
||||||
If (T<>tkColon) then
|
|
||||||
DoError(SErrExpectedColon);
|
|
||||||
E:=DoParse(False,False);
|
|
||||||
Result.Add(N,E);
|
|
||||||
T:=GetNextToken;
|
|
||||||
If Not (T in [tkComma,tkCurlyBraceClose]) then
|
|
||||||
DoError(SExpectedCommaorBraceClose);
|
|
||||||
If T=tkComma then
|
|
||||||
begin
|
|
||||||
T:=GetNextToken;
|
|
||||||
LastComma:=(t=tkCurlyBraceClose);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options)) then // Test for ,} case
|
|
||||||
DoError(SErrUnExpectedToken);
|
|
||||||
Except
|
|
||||||
FreeAndNil(Result);
|
|
||||||
Raise;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Current token is [, on exit current token is ]
|
|
||||||
function TJSONParser.ParseArray: TJSONArray;
|
|
||||||
|
|
||||||
Var
|
|
||||||
T : TJSONtoken;
|
|
||||||
E : TJSONData;
|
|
||||||
LastComma : Boolean;
|
|
||||||
S : TJSONOPTions;
|
|
||||||
begin
|
|
||||||
Result:=CreateJSONArray([]);
|
|
||||||
LastComma:=False;
|
|
||||||
Try
|
|
||||||
Repeat
|
|
||||||
T:=GetNextToken;
|
|
||||||
If (T<>tkSquaredBraceClose) then
|
|
||||||
begin
|
|
||||||
E:=DoParse(True,False);
|
|
||||||
If (E<>Nil) then
|
|
||||||
Result.Add(E)
|
|
||||||
else if (Result.Count>0) then
|
|
||||||
DoError(SErrEmptyElement);
|
|
||||||
T:=GetNextToken;
|
|
||||||
If Not (T in [tkComma,tkSquaredBraceClose]) then
|
|
||||||
DoError(SExpectedCommaorBraceClose);
|
|
||||||
LastComma:=(t=TkComma);
|
|
||||||
end;
|
|
||||||
Until (T=tkSquaredBraceClose);
|
|
||||||
S:=Options;
|
|
||||||
If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S)) then // Test for ,] case
|
|
||||||
DoError(SErrUnExpectedToken);
|
|
||||||
Except
|
|
||||||
FreeAndNil(Result);
|
|
||||||
Raise;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Get next token, discarding whitespace
|
|
||||||
function TJSONParser.GetNextToken: TJSONToken;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Repeat
|
|
||||||
Result:=FScanner.FetchToken;
|
|
||||||
Until (Not (Result in [tkComment,tkWhiteSpace]));
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONParser.DoError(const Msg: String);
|
|
||||||
|
|
||||||
Var
|
|
||||||
S : String;
|
|
||||||
|
|
||||||
begin
|
|
||||||
S:=Format(Msg,[CurrentTokenString]);
|
|
||||||
S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
|
|
||||||
Raise EJSONParser.Create(S);
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
|
|
||||||
begin
|
|
||||||
Inherited Create;
|
|
||||||
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
|
|
||||||
if AUseUTF8 then
|
|
||||||
Options:=Options + [joUTF8];
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
|
|
||||||
begin
|
|
||||||
Inherited Create;
|
|
||||||
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
|
|
||||||
if AUseUTF8 then
|
|
||||||
Options:=Options + [joUTF8];
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);
|
|
||||||
begin
|
|
||||||
FScanner:=TJSONScanner.Create(Source,AOptions);
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONParser.Create(const Source: String; AOptions: TJSONOptions);
|
|
||||||
begin
|
|
||||||
FScanner:=TJSONScanner.Create(Source,AOptions);
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TJSONParser.Destroy();
|
|
||||||
begin
|
|
||||||
FreeAndNil(FScanner);
|
|
||||||
inherited Destroy();
|
|
||||||
end;
|
|
||||||
|
|
||||||
Procedure InitJSONHandler;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if GetJSONParserHandler=Nil then
|
|
||||||
SetJSONParserHandler(@DefJSONParserHandler);
|
|
||||||
end;
|
|
||||||
|
|
||||||
Procedure DoneJSONHandler;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if GetJSONParserHandler=@DefJSONParserHandler then
|
|
||||||
SetJSONParserHandler(Nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
initialization
|
|
||||||
InitJSONHandler;
|
|
||||||
finalization
|
|
||||||
DoneJSONHandler;
|
|
||||||
end.
|
|
||||||
|
|
||||||
|
|
@ -1,481 +0,0 @@
|
||||||
{
|
|
||||||
This file is part of the Free Component Library
|
|
||||||
|
|
||||||
JSON source lexical scanner
|
|
||||||
Copyright (c) 2007 by Michael Van Canneyt michael@freepascal.org
|
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
|
||||||
for details about the copyright.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
||||||
|
|
||||||
**********************************************************************}
|
|
||||||
{$mode objfpc}
|
|
||||||
{$h+}
|
|
||||||
|
|
||||||
unit xjsonscanner;
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses SysUtils, Classes;
|
|
||||||
|
|
||||||
resourcestring
|
|
||||||
SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
|
|
||||||
SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
|
|
||||||
SErrOpenString = 'string exceeds end of line';
|
|
||||||
|
|
||||||
type
|
|
||||||
|
|
||||||
TJSONToken = (
|
|
||||||
tkEOF,
|
|
||||||
tkWhitespace,
|
|
||||||
tkString,
|
|
||||||
tkNumber,
|
|
||||||
tkTrue,
|
|
||||||
tkFalse,
|
|
||||||
tkNull,
|
|
||||||
// Simple (one-character) tokens
|
|
||||||
tkComma, // ','
|
|
||||||
tkColon, // ':'
|
|
||||||
tkCurlyBraceOpen, // '{'
|
|
||||||
tkCurlyBraceClose, // '}'
|
|
||||||
tkSquaredBraceOpen, // '['
|
|
||||||
tkSquaredBraceClose, // ']'
|
|
||||||
tkIdentifier, // Any Javascript identifier
|
|
||||||
tkComment,
|
|
||||||
tkUnknown
|
|
||||||
);
|
|
||||||
|
|
||||||
EScannerError = class(EParserError);
|
|
||||||
|
|
||||||
TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
|
|
||||||
TJSONOptions = set of TJSONOption;
|
|
||||||
|
|
||||||
Const
|
|
||||||
DefaultOptions = [joUTF8];
|
|
||||||
|
|
||||||
Type
|
|
||||||
|
|
||||||
{ TJSONScanner }
|
|
||||||
|
|
||||||
TJSONScanner = class
|
|
||||||
private
|
|
||||||
FAllowComments: Boolean;
|
|
||||||
FSource : TStringList;
|
|
||||||
FCurRow: Integer;
|
|
||||||
FCurToken: TJSONToken;
|
|
||||||
FCurTokenString: string;
|
|
||||||
FCurLine: string;
|
|
||||||
TokenStr: PChar;
|
|
||||||
FOptions : TJSONOptions;
|
|
||||||
function GetCurColumn: Integer;
|
|
||||||
function GetO(AIndex: TJSONOption): Boolean;
|
|
||||||
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
|
|
||||||
protected
|
|
||||||
procedure Error(const Msg: string);overload;
|
|
||||||
procedure Error(const Msg: string; Const Args: array of Const);overload;
|
|
||||||
function DoFetchToken: TJSONToken;
|
|
||||||
public
|
|
||||||
constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
|
|
||||||
constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
|
|
||||||
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
|
|
||||||
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
|
|
||||||
destructor Destroy; override;
|
|
||||||
function FetchToken: TJSONToken;
|
|
||||||
|
|
||||||
|
|
||||||
property CurLine: string read FCurLine;
|
|
||||||
property CurRow: Integer read FCurRow;
|
|
||||||
property CurColumn: Integer read GetCurColumn;
|
|
||||||
|
|
||||||
property CurToken: TJSONToken read FCurToken;
|
|
||||||
property CurTokenString: string read FCurTokenString;
|
|
||||||
// Use strict JSON: " for strings, object members are strings, not identifiers
|
|
||||||
Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
|
|
||||||
// if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
|
|
||||||
Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
|
|
||||||
// Parsing options
|
|
||||||
Property Options : TJSONOptions Read FOptions Write FOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
|
||||||
TokenInfos: array[TJSONToken] of string = (
|
|
||||||
'EOF',
|
|
||||||
'Whitespace',
|
|
||||||
'String',
|
|
||||||
'Number',
|
|
||||||
'True',
|
|
||||||
'False',
|
|
||||||
'Null',
|
|
||||||
',',
|
|
||||||
':',
|
|
||||||
'{',
|
|
||||||
'}',
|
|
||||||
'[',
|
|
||||||
']',
|
|
||||||
'identifier',
|
|
||||||
'comment',
|
|
||||||
''
|
|
||||||
);
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
|
|
||||||
|
|
||||||
Var
|
|
||||||
O : TJSONOptions;
|
|
||||||
|
|
||||||
begin
|
|
||||||
O:=DefaultOptions;
|
|
||||||
if AUseUTF8 then
|
|
||||||
Include(O,joUTF8)
|
|
||||||
else
|
|
||||||
Exclude(O,joUTF8);
|
|
||||||
Create(Source,O);
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
|
|
||||||
Var
|
|
||||||
O : TJSONOptions;
|
|
||||||
|
|
||||||
begin
|
|
||||||
O:=DefaultOptions;
|
|
||||||
if AUseUTF8 then
|
|
||||||
Include(O,joUTF8)
|
|
||||||
else
|
|
||||||
Exclude(O,joUTF8);
|
|
||||||
Create(Source,O);
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
|
|
||||||
begin
|
|
||||||
FSource:=TStringList.Create;
|
|
||||||
FSource.LoadFromStream(Source);
|
|
||||||
FOptions:=AOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
|
|
||||||
begin
|
|
||||||
FSource:=TStringList.Create;
|
|
||||||
FSource.Text:=Source;
|
|
||||||
FOptions:=AOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TJSONScanner.Destroy;
|
|
||||||
begin
|
|
||||||
FreeAndNil(FSource);
|
|
||||||
Inherited;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function TJSONScanner.FetchToken: TJSONToken;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=DoFetchToken;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONScanner.Error(const Msg: string);
|
|
||||||
begin
|
|
||||||
raise EScannerError.Create(Msg);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
|
|
||||||
begin
|
|
||||||
raise EScannerError.CreateFmt(Msg, Args);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONScanner.DoFetchToken: TJSONToken;
|
|
||||||
|
|
||||||
function FetchLine: Boolean;
|
|
||||||
begin
|
|
||||||
Result:=FCurRow<FSource.Count;
|
|
||||||
if Result then
|
|
||||||
begin
|
|
||||||
FCurLine:=FSource[FCurRow];
|
|
||||||
TokenStr:=PChar(FCurLine);
|
|
||||||
Inc(FCurRow);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
FCurLine:='';
|
|
||||||
TokenStr:=nil;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
TokenStart, CurPos: PChar;
|
|
||||||
it : TJSONToken;
|
|
||||||
I : Integer;
|
|
||||||
OldLength, SectionLength, Index: Integer;
|
|
||||||
C : char;
|
|
||||||
S : String;
|
|
||||||
IsStar,EOC: Boolean;
|
|
||||||
|
|
||||||
begin
|
|
||||||
if TokenStr = nil then
|
|
||||||
if not FetchLine then
|
|
||||||
begin
|
|
||||||
Result := tkEOF;
|
|
||||||
FCurToken := Result;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
FCurTokenString := '';
|
|
||||||
|
|
||||||
case TokenStr[0] of
|
|
||||||
#0: // Empty line
|
|
||||||
begin
|
|
||||||
FetchLine;
|
|
||||||
Result := tkWhitespace;
|
|
||||||
end;
|
|
||||||
#9, ' ':
|
|
||||||
begin
|
|
||||||
Result := tkWhitespace;
|
|
||||||
repeat
|
|
||||||
Inc(TokenStr);
|
|
||||||
if TokenStr[0] = #0 then
|
|
||||||
if not FetchLine then
|
|
||||||
begin
|
|
||||||
FCurToken := Result;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
until not (TokenStr[0] in [#9, ' ']);
|
|
||||||
end;
|
|
||||||
'"','''':
|
|
||||||
begin
|
|
||||||
C:=TokenStr[0];
|
|
||||||
If (C='''') and (joStrict in Options) then
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
|
||||||
Inc(TokenStr);
|
|
||||||
TokenStart := TokenStr;
|
|
||||||
OldLength := 0;
|
|
||||||
FCurTokenString := '';
|
|
||||||
while not (TokenStr[0] in [#0,C]) do
|
|
||||||
begin
|
|
||||||
if (TokenStr[0]='\') then
|
|
||||||
begin
|
|
||||||
// Save length
|
|
||||||
SectionLength := TokenStr - TokenStart;
|
|
||||||
Inc(TokenStr);
|
|
||||||
// Read escaped token
|
|
||||||
Case TokenStr[0] of
|
|
||||||
'"' : S:='"';
|
|
||||||
'''' : S:='''';
|
|
||||||
't' : S:=#9;
|
|
||||||
'b' : S:=#8;
|
|
||||||
'n' : S:=#10;
|
|
||||||
'r' : S:=#13;
|
|
||||||
'f' : S:=#12;
|
|
||||||
'\' : S:='\';
|
|
||||||
'/' : S:='/';
|
|
||||||
'u' : begin
|
|
||||||
S:='0000';
|
|
||||||
For I:=1 to 4 do
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Case TokenStr[0] of
|
|
||||||
'0'..'9','A'..'F','a'..'f' :
|
|
||||||
S[i]:=Upcase(TokenStr[0]);
|
|
||||||
else
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
// WideChar takes care of conversion...
|
|
||||||
if (joUTF8 in Options) then
|
|
||||||
S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
|
|
||||||
else
|
|
||||||
S:=WideChar(StrToInt('$'+S));
|
|
||||||
end;
|
|
||||||
#0 : Error(SErrOpenString);
|
|
||||||
else
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
|
||||||
end;
|
|
||||||
SetLength(FCurTokenString, OldLength + SectionLength+1+Length(S));
|
|
||||||
if SectionLength > 0 then
|
|
||||||
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
|
|
||||||
Move(S[1],FCurTokenString[OldLength + SectionLength+1],Length(S));
|
|
||||||
Inc(OldLength, SectionLength+Length(S));
|
|
||||||
// Next char
|
|
||||||
// Inc(TokenStr);
|
|
||||||
TokenStart := TokenStr+1;
|
|
||||||
end;
|
|
||||||
if TokenStr[0] = #0 then
|
|
||||||
Error(SErrOpenString);
|
|
||||||
Inc(TokenStr);
|
|
||||||
end;
|
|
||||||
if TokenStr[0] = #0 then
|
|
||||||
Error(SErrOpenString);
|
|
||||||
SectionLength := TokenStr - TokenStart;
|
|
||||||
SetLength(FCurTokenString, OldLength + SectionLength);
|
|
||||||
if SectionLength > 0 then
|
|
||||||
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkString;
|
|
||||||
end;
|
|
||||||
',':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkComma;
|
|
||||||
end;
|
|
||||||
'0'..'9','.','-':
|
|
||||||
begin
|
|
||||||
TokenStart := TokenStr;
|
|
||||||
while true do
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
case TokenStr[0] of
|
|
||||||
'.':
|
|
||||||
begin
|
|
||||||
if TokenStr[1] in ['0'..'9', 'e', 'E'] then
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
repeat
|
|
||||||
Inc(TokenStr);
|
|
||||||
until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
|
|
||||||
end;
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
'0'..'9': ;
|
|
||||||
'e', 'E':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
if TokenStr[0] in ['-','+'] then
|
|
||||||
Inc(TokenStr);
|
|
||||||
while TokenStr[0] in ['0'..'9'] do
|
|
||||||
Inc(TokenStr);
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
SectionLength := TokenStr - TokenStart;
|
|
||||||
FCurTokenString:='';
|
|
||||||
SetString(FCurTokenString, TokenStart, SectionLength);
|
|
||||||
If (FCurTokenString[1]='.') then
|
|
||||||
FCurTokenString:='0'+FCurTokenString;
|
|
||||||
Result := tkNumber;
|
|
||||||
end;
|
|
||||||
':':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkColon;
|
|
||||||
end;
|
|
||||||
'{':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkCurlyBraceOpen;
|
|
||||||
end;
|
|
||||||
'}':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkCurlyBraceClose;
|
|
||||||
end;
|
|
||||||
'[':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkSquaredBraceOpen;
|
|
||||||
end;
|
|
||||||
']':
|
|
||||||
begin
|
|
||||||
Inc(TokenStr);
|
|
||||||
Result := tkSquaredBraceClose;
|
|
||||||
end;
|
|
||||||
'/' :
|
|
||||||
begin
|
|
||||||
if Not (joComments in Options) then
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
|
||||||
TokenStart:=TokenStr;
|
|
||||||
Inc(TokenStr);
|
|
||||||
Case Tokenstr[0] of
|
|
||||||
'/' : begin
|
|
||||||
SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
|
|
||||||
Inc(TokenStr);
|
|
||||||
FCurTokenString:='';
|
|
||||||
SetString(FCurTokenString, TokenStr, SectionLength);
|
|
||||||
Fetchline;
|
|
||||||
end;
|
|
||||||
'*' :
|
|
||||||
begin
|
|
||||||
IsStar:=False;
|
|
||||||
Inc(TokenStr);
|
|
||||||
TokenStart:=TokenStr;
|
|
||||||
Repeat
|
|
||||||
if (TokenStr[0]=#0) then
|
|
||||||
begin
|
|
||||||
SectionLength := (TokenStr - TokenStart);
|
|
||||||
S:='';
|
|
||||||
SetString(S, TokenStart, SectionLength);
|
|
||||||
FCurtokenString:=FCurtokenString+S;
|
|
||||||
if not fetchLine then
|
|
||||||
Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
|
|
||||||
TokenStart:=TokenStr;
|
|
||||||
end;
|
|
||||||
IsStar:=TokenStr[0]='*';
|
|
||||||
Inc(TokenStr);
|
|
||||||
EOC:=(isStar and (TokenStr[0]='/'));
|
|
||||||
Until EOC;
|
|
||||||
if EOC then
|
|
||||||
begin
|
|
||||||
SectionLength := (TokenStr - TokenStart-1);
|
|
||||||
S:='';
|
|
||||||
SetString(S, TokenStart, SectionLength);
|
|
||||||
FCurtokenString:=FCurtokenString+S;
|
|
||||||
Inc(TokenStr);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
|
||||||
end;
|
|
||||||
Result:=tkComment;
|
|
||||||
end;
|
|
||||||
'a'..'z','A'..'Z','_':
|
|
||||||
begin
|
|
||||||
TokenStart := TokenStr;
|
|
||||||
repeat
|
|
||||||
Inc(TokenStr);
|
|
||||||
until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
|
|
||||||
SectionLength := TokenStr - TokenStart;
|
|
||||||
FCurTokenString:='';
|
|
||||||
SetString(FCurTokenString, TokenStart, SectionLength);
|
|
||||||
for it := tkTrue to tkNull do
|
|
||||||
if CompareText(CurTokenString, TokenInfos[it]) = 0 then
|
|
||||||
begin
|
|
||||||
Result := it;
|
|
||||||
FCurToken := Result;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if (joStrict in Options) then
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
|
|
||||||
else
|
|
||||||
Result:=tkIdentifier;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
FCurToken := Result;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONScanner.GetCurColumn: Integer;
|
|
||||||
begin
|
|
||||||
Result := TokenStr - PChar(CurLine);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TJSONScanner.GetO(AIndex: TJSONOption): Boolean;
|
|
||||||
begin
|
|
||||||
Result:=AIndex in FOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJSONScanner.SetO(AIndex: TJSONOption; AValue: Boolean);
|
|
||||||
begin
|
|
||||||
If AValue then
|
|
||||||
Include(Foptions,AIndex)
|
|
||||||
else
|
|
||||||
Exclude(Foptions,AIndex)
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
@ -543,7 +543,7 @@
|
||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
|
<OtherUnitFiles Value="..\src"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<CodeGeneration>
|
||||||
|
|
|
||||||
|
|
@ -16,7 +16,7 @@ uses
|
||||||
forms, ComCtrls,
|
forms, ComCtrls,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
LazFileUtils, process, asyncprocess, ghashmap, ghashset, LCLIntf, strutils,
|
LazFileUtils, process, asyncprocess, ghashmap, ghashset, LCLIntf, strutils,
|
||||||
xfpjson;
|
fpjson;
|
||||||
|
|
||||||
const
|
const
|
||||||
exeExt = {$IFDEF WINDOWS} '.exe' {$ELSE} '' {$ENDIF};
|
exeExt = {$IFDEF WINDOWS} '.exe' {$ELSE} '' {$ENDIF};
|
||||||
|
|
@ -67,7 +67,7 @@ type
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// sugar for strings
|
// sugar for strings
|
||||||
TStringHelper = type helper for string
|
TCEStringHelper = type helper(TStringHelper) for string
|
||||||
function isEmpty: boolean;
|
function isEmpty: boolean;
|
||||||
function isNotEmpty: boolean;
|
function isNotEmpty: boolean;
|
||||||
function isBlank: boolean;
|
function isBlank: boolean;
|
||||||
|
|
@ -397,77 +397,77 @@ begin
|
||||||
exit(self <> nil);
|
exit(self <> nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.isEmpty: boolean;
|
function TCEStringHelper.isEmpty: boolean;
|
||||||
begin
|
begin
|
||||||
exit(self = '');
|
exit(self = '');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.isNotEmpty: boolean;
|
function TCEStringHelper.isNotEmpty: boolean;
|
||||||
begin
|
begin
|
||||||
exit(self <> '');
|
exit(self <> '');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.isBlank: boolean;
|
function TCEStringHelper.isBlank: boolean;
|
||||||
begin
|
begin
|
||||||
exit(ce_common.isBlank(self));
|
exit(ce_common.isBlank(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.extractFileName: string;
|
function TCEStringHelper.extractFileName: string;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.extractFileName(self));
|
exit(sysutils.extractFileName(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.extractFileExt: string;
|
function TCEStringHelper.extractFileExt: string;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.extractFileExt(self));
|
exit(sysutils.extractFileExt(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.extractFilePath: string;
|
function TCEStringHelper.extractFilePath: string;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.extractFilePath(self));
|
exit(sysutils.extractFilePath(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.extractFileDir: string;
|
function TCEStringHelper.extractFileDir: string;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.extractFileDir(self));
|
exit(sysutils.extractFileDir(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.stripFileExt: string;
|
function TCEStringHelper.stripFileExt: string;
|
||||||
begin
|
begin
|
||||||
exit(ce_common.stripFileExt(self));
|
exit(ce_common.stripFileExt(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.fileExists: boolean;
|
function TCEStringHelper.fileExists: boolean;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.FileExists(self));
|
exit(sysutils.FileExists(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.dirExists: boolean;
|
function TCEStringHelper.dirExists: boolean;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.DirectoryExists(self));
|
exit(sysutils.DirectoryExists(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.upperCase: string;
|
function TCEStringHelper.upperCase: string;
|
||||||
begin
|
begin
|
||||||
exit(sysutils.upperCase(self));
|
exit(sysutils.upperCase(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.length: integer;
|
function TCEStringHelper.length: integer;
|
||||||
begin
|
begin
|
||||||
exit(system.length(self));
|
exit(system.length(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.toInt: integer;
|
function TCEStringHelper.toInt: integer;
|
||||||
begin
|
begin
|
||||||
exit(strToInt(self));
|
exit(strToInt(self));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.toIntNoExcept(default: integer = -1): integer;
|
function TCEStringHelper.toIntNoExcept(default: integer = -1): integer;
|
||||||
begin
|
begin
|
||||||
exit(StrToIntDef(self, default));
|
exit(StrToIntDef(self, default));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStringHelper.normalizePath: string;
|
function TCEStringHelper.normalizePath: string;
|
||||||
begin
|
begin
|
||||||
exit(TrimFilename(self));
|
exit(TrimFilename(self));
|
||||||
end;
|
end;
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ unit ce_dastworx;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, process, xjsonscanner, xfpjson, xjsonparser, ce_common;
|
Classes, SysUtils, process, jsonscanner, fpjson, jsonparser, ce_common;
|
||||||
|
|
||||||
(**
|
(**
|
||||||
* Gets the module name and the imports of the source code located in
|
* Gets the module name and the imports of the source code located in
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ unit ce_dubproject;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, xfpjson, xjsonparser, xjsonscanner, process, strutils,
|
Classes, SysUtils, fpjson, jsonparser, jsonscanner, process, strutils,
|
||||||
LazFileUtils, RegExpr,
|
LazFileUtils, RegExpr,
|
||||||
ce_common, ce_interfaces, ce_observer, ce_dialogs, ce_processes,
|
ce_common, ce_interfaces, ce_observer, ce_dialogs, ce_processes,
|
||||||
ce_writableComponent, ce_compilers;
|
ce_writableComponent, ce_compilers;
|
||||||
|
|
@ -424,9 +424,6 @@ begin
|
||||||
//
|
//
|
||||||
FreeAndNil(fJSON);
|
FreeAndNil(fJSON);
|
||||||
parser := TJSONParser.Create(loader, [joIgnoreTrailingComma, joUTF8]);
|
parser := TJSONParser.Create(loader, [joIgnoreTrailingComma, joUTF8]);
|
||||||
//TODO-cfcl-json: remove etc/fcl-json the day they'll merge and rlz the version with 'Options'
|
|
||||||
//TODO-cfcl-json: track possible changes and fixes at http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/fcl-json/
|
|
||||||
//latest in etc = rev 34196.
|
|
||||||
try
|
try
|
||||||
try
|
try
|
||||||
fJSON := parser.Parse as TJSONObject;
|
fJSON := parser.Parse as TJSONObject;
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@ interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Graphics,
|
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Graphics,
|
||||||
Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, ComCtrls, xjsonparser, xfpjson,
|
Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, ComCtrls, jsonparser, fpjson,
|
||||||
ce_widget, ce_common, ce_interfaces, ce_observer, ce_dubproject, ce_sharedres,
|
ce_widget, ce_common, ce_interfaces, ce_observer, ce_dubproject, ce_sharedres,
|
||||||
ce_dsgncontrols;
|
ce_dsgncontrols;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,7 @@ interface
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls,
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls,
|
||||||
PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons,
|
PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons,
|
||||||
StdCtrls, process, xfpjson, typinfo, Unix, ListViewFilterEdit, SynEdit,
|
StdCtrls, process, fpjson, typinfo, Unix, ListViewFilterEdit, SynEdit,
|
||||||
ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
|
ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
|
||||||
ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf,
|
ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf,
|
||||||
ce_ddemangle, ce_writableComponent, EditBtn, strutils, ObjectInspector;
|
ce_ddemangle, ce_writableComponent, EditBtn, strutils, ObjectInspector;
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ unit ce_halstead;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, xfpjson, math,
|
Classes, SysUtils, fpjson, math,
|
||||||
ce_common, ce_observer, ce_interfaces, ce_dastworx, ce_writableComponent,
|
ce_common, ce_observer, ce_interfaces, ce_dastworx, ce_writableComponent,
|
||||||
ce_synmemo;
|
ce_synmemo;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -195,10 +195,7 @@ end;
|
||||||
|
|
||||||
function TLibraryItem.getModule(const value: string): TModuleInfo;
|
function TLibraryItem.getModule(const value: string): TModuleInfo;
|
||||||
begin
|
begin
|
||||||
//TODO-cFCL/LCL: use THashMap.GetValue from next FPC rlz
|
fModulesByName.GetValue(value, result);
|
||||||
result := nil;
|
|
||||||
if fModulesByName.contains(value) then
|
|
||||||
exit(fModulesByName.GetData(value));
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TLibraryItem.addModuleInfo: TModuleInfo;
|
function TLibraryItem.addModuleInfo: TModuleInfo;
|
||||||
|
|
@ -431,10 +428,7 @@ end;
|
||||||
|
|
||||||
function TLibraryManager.getLibraryByAlias(const value: string): TLibraryItem;
|
function TLibraryManager.getLibraryByAlias(const value: string): TLibraryItem;
|
||||||
begin
|
begin
|
||||||
//TODO-cFCL/LCL: use THashMap.GetValue from next FPC rlz
|
fItemsByAlias.GetValue(value, result);
|
||||||
result := nil;
|
|
||||||
if fItemsByAlias.contains(value) then
|
|
||||||
exit(fItemsByAlias.GetData(value));
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TLibraryManager.getLibraryByImport(const value: string): TLibraryItem;
|
function TLibraryManager.getLibraryByImport(const value: string): TLibraryItem;
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,7 @@ interface
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||||
Menus, ComCtrls, Buttons, LazFileUtils, fphttpclient, StdCtrls,
|
Menus, ComCtrls, Buttons, LazFileUtils, fphttpclient, StdCtrls,
|
||||||
xfpjson, xjsonparser,
|
fpjson, jsonparser,
|
||||||
ce_widget, ce_interfaces, ce_ceproject, ce_dmdwrap, ce_common, ce_dialogs,
|
ce_widget, ce_interfaces, ce_ceproject, ce_dmdwrap, ce_common, ce_dialogs,
|
||||||
ce_sharedres, process, ce_dubproject, ce_observer, ce_dlang, ce_libman,
|
ce_sharedres, process, ce_dubproject, ce_observer, ce_dlang, ce_libman,
|
||||||
ce_projutils, ce_dsgncontrols, ce_stringrange;
|
ce_projutils, ce_dsgncontrols, ce_stringrange;
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,7 @@ uses
|
||||||
StdCtrls, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls,
|
StdCtrls, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls,
|
||||||
Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process,
|
Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process,
|
||||||
{$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML, fphttpclient,
|
{$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML, fphttpclient,
|
||||||
xfpjson, xjsonparser, xjsonscanner,
|
fpjson, jsonparser, jsonscanner,
|
||||||
ce_common, ce_dmdwrap, ce_ceproject, ce_synmemo, ce_writableComponent,
|
ce_common, ce_dmdwrap, ce_ceproject, ce_synmemo, ce_writableComponent,
|
||||||
ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_ceprojeditor,
|
ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_ceprojeditor,
|
||||||
ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer,
|
ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer,
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ unit ce_symstring;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
ce_observer, ce_interfaces, ce_ceproject, ce_synmemo, ce_common,
|
ce_observer, sysutils, ce_interfaces, ce_ceproject, ce_synmemo, ce_common,
|
||||||
ce_stringrange;
|
ce_stringrange;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
@ -56,7 +56,7 @@ type
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Forms, SysUtils, Classes;
|
Forms, Classes;
|
||||||
var
|
var
|
||||||
symbolExpander: TCESymbolExpander;
|
symbolExpander: TCESymbolExpander;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue