program Project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes,
SysUtils,
CustApp { you can add units after this },
jsonscanner,
fpjson,
jsonparser;
type
{ TMyTimeTest }
TMyTimeTest = class(TCustomApplication)
private
fFileData: string;
fPath1: string;
fPath2: string;
fFlag: boolean;
fStr1: string;
fStr2: string;
procedure SetPath1(path: string);
procedure SetPath2(path: string);
procedure SetFlag(flag: boolean);
procedure SetStr1(str1: string);
procedure SetStr2(str2: string);
protected
procedure DoRun; override;
public
JSONObject1, JSONObject2: TJSONObject;
JSONEnum1, JSONEnum2: TBaseJSONEnumerator;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
procedure WriteInfo;
procedure SetFileData;
procedure ParseAndSet;
procedure WriteInFile;
property Path1: string read fPath1 write SetPath1;
property Flag: boolean read fFlag write SetFlag;
property Str1: string read fStr1 write SetStr1;
property Str2: string read fStr2 write SetStr2;
end;
{ TMyTimeTest }
procedure TMyTimeTest.SetPath1(path: string);
begin
fPath1 := path;
end;
procedure TMyTimeTest.SetPath2(path: string);
begin
fPath2 := path;
end;
procedure TMyTimeTest.SetFlag(flag: boolean);
begin
fFlag := flag;
end;
procedure TMyTimeTest.SetStr1(str1: string);
begin
fStr1 := str1;
end;
procedure TMyTimeTest.SetStr2(str2: string);
begin
fStr2 := str2;
end;
procedure TMyTimeTest.SetFileData;
var
L: TStringList;
begin
//if str1 = '' then
// fPath1 := ParamStr(1)
//else
// fPath2 := ParamStr(2);
fPath1 := '/media/sf_Devices/u1.json';
fPath2 := '/media/sf_Devices/u2.json';
try
try
L := TStringList.Create;
L.LoadFromFile(fPath1);
if L <> nil then
begin
fFileData := L.Text;
Self.SetFlag(True);
if str1 = '' then
str1 := fFileData;
end;
finally
L.Free;
end;
except
ShowException(Exception.Create('1'));
Terminate;
Halt;
end;
//if str1 = '' then
// fPath1 := ParamStr(1)
//else
// fPath2 := ParamStr(2);
try
try
L := TStringList.Create;
L.LoadFromFile(fPath2);
if L <> nil then
begin
fFileData := L.Text;
Self.SetFlag(True);
if str2 = '' then
str2 := fFileData;
end;
finally
L.Free;
end;
except
ShowException(Exception.Create('1'));
Terminate;
Halt;
end;
end;
procedure TMyTimeTest.ParseAndSet;
var
JSONParser1, JSONParser2: TJSONParser;
JNestObject1, JNestObject2: TJSONObject;
JSONNestEnum1, JSONNestEnum2, JSONArrayEnum: TBaseJSONEnumerator;
i: integer;
begin
JSONParser1 := TJSONParser.Create(str1, DefaultOptions);
JSONParser2 := TJSONParser.Create(str2, DefaultOptions);
try
JSONObject1 := JSONParser1.Parse as TJSONObject;
JSONObject2 := JSONParser2.Parse as TJSONObject;
try
JSONEnum1 := JSONObject1.GetEnumerator;
JSONEnum2 := JSONObject2.GetEnumerator;
try
while JSONEnum1.MoveNext do
while JSONEnum2.MoveNext do
begin
if JSONEnum1.Current.Value.JSONType = jtObject then
begin
JNestObject1 := JSONEnum1.Current.Value as TJSONObject;
JNestObject2 := JSONObject2.Find(JSONEnum1.Current.Key) as TJSONObject;
try
JSONNestEnum1 := JNestObject1.GetEnumerator;
JSONNestEnum2 := JNestObject2.GetEnumerator;
while JSONNestEnum1.MoveNext do
while JSONNestEnum2.MoveNext do
begin
if JSONObject2.FindPath(JSONEnum1.Current.key + '.' + JSONNestEnum1.Current.Key) <> nil then
begin
if JSONNestEnum1.Current.Value.JSONType = jtString then
begin
JNestObject2.Strings[JSONNestEnum1.Current.Key] := JSONNestEnum1.Current.Value.AsString;
Break;
end
else if JSONNestEnum1.Current.Value.JSONType = jtNumber then
begin
JNestObject2.Integers[JSONNestEnum1.Current.Key] := JSONNestEnum1.Current.Value.AsInt64;
Break;
end
else if JSONNestEnum1.Current.Value.JSONType = jtBoolean then
begin
JNestObject2.Booleans[JSONNestEnum1.Current.Key] := JSONNestEnum1.Current.Value.AsBoolean;
Break;
end
else if JSONNestEnum1.Current.Value.JSONType = jtArray then
begin
JSONArrayEnum := TJSONArray(JSONNestEnum1.Current.Value).GetEnumerator;
JSONObject2.Arrays[JSONNestEnum1.Current.Key].Clear;
while JSONArrayEnum.MoveNext do
JSONObject2.Arrays[JSONNestEnum1.Current.key].Add(JSONArrayEnum.Current.Value);
//JSONObject2.Arrays[JSONNestEnum1.Current.Key] := (TJSONArray(JNestObject2.Items[2]));;
//for i:=0 to TJSONArray(JNestObject2.Items[2]).Count-1 do
end;
Break;
end;
end;
finally
FreeAndNil(JSONNestEnum1);
FreeAndNil(JSONNestEnum2);
end;
end
else if JSONObject2.FindPath(JSONEnum1.Current.Key) <> nil then
begin
if JSONEnum1.Current.Value.JSONType = jtString then
begin
JSONObject2.Strings[JSONEnum1.Current.Key] := JSONEnum1.Current.Value.AsString;
Break;
end
else if JSONEnum1.Current.Value.JSONType = jtNumber then
begin
JSONObject2.Integers[JSONEnum1.Current.Key] := JSONEnum1.Current.Value.AsInt64;
Break;
end
else if JSONEnum1.Current.Value.JSONType = jtBoolean then
begin
JSONObject2.Booleans[JSONEnum1.Current.Key] := JSONEnum1.Current.Value.AsBoolean;
Break;
end
else if JSONEnum1.Current.Value.JSONType = jtArray then
begin
JSONArrayEnum := TJSONArray(JSONEnum1.Current.Value).GetEnumerator;
JSONObject2.Arrays[JSONEnum1.Current.Key].Clear;
while JSONArrayEnum.MoveNext do
JSONObject2.Arrays[JSONEnum1.Current.key].Add(JSONArrayEnum.Current.Value);
Break;
end;
Break;
end;
Break;
end;
finally
FreeAndNil(JsonEnum1);
FreeAndNil(JsonEnum2);
end;
finally
//FreeAndNil(JsonObject1);
//FreeAndNil(JsonObject2);
end;
finally
FreeAndNil(JsonParser1);
FreeAndNil(JsonParser2);
end;
end;
procedure TMyTimeTest.WriteInFile;
var
L: TStringList;
begin
L := TStringList.Create;
try
L.Text := Trim(JSONObject2.FormatJSON);
L.SaveToFile(fPath2);
ShowException(Exception.Create('0'));
finally
L.Free;
JSONObject2.Free;
end;
end;
procedure TMyTimeTest.DoRun;
var
ErrorMsg: string;
begin
// parse parameters
if HasOption('h', 'help') then
begin
WriteHelp;
Terminate;
Exit;
end;
if HasOption('i', 'info') then
begin
WriteInfo;
Terminate;
Exit;
end;
// quick check parameters
ErrorMsg := CheckOptions('h', 'help');
if ErrorMsg <> '' then
begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
{ add your program here }
Self.SetFileData;
Self.SetFileData;
if flag = True then
begin
Self.ParseAndSet;
Self.WriteInFile;
end;
// stop program loop
Terminate;
end;
constructor TMyTimeTest.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException := True;
end;
destructor TMyTimeTest.Destroy;
begin
inherited Destroy;
end;
procedure TMyTimeTest.WriteHelp;
begin
{ add your help code here }
end;
procedure TMyTimeTest.WriteInfo;
begin
end;
var
Application: TMyTimeTest;
begin
Application := TMyTimeTest.Create(nil);
Application.Title := 'MyTimeTest';
Application.Run;
Application.Free;
end.
Recent
