1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228
| unit jsonadapter;
interface
uses
System.SysUtils,
System.Classes,
System.Json,
Data.DB;
type
EDataTypeCoersion = class(Exception); //- Can't alter data-type for existing field definition.
EDataTypeUnsupported = class(Exception); //- Can't support data-type from json data. (objects and arrays)
EUnknownDataType = class(Exception); //- Unable to determine data type from json data.
type
TJSONDatasetAdapter = class(TComponent)
private
fJSON: TStrings;
fDatasetRef: TDataset;
procedure SetDatasetRef(const Value: TDataset);
procedure setJSON(const Value: TStrings);
procedure SetFieldDefs(a: TJSONArray);
procedure InsertData(a: TJSONArray);
public
constructor Create( aOwner: TComponent ); override;
destructor Destroy; override;
public
procedure UpdateDataset;
published
property JSON: TStrings read fJSON write setJSON;
property Dataset: TDataset read fDatasetRef write SetDatasetRef;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('REST Client', [TJSONDatasetAdapter]);
end;
{ TJSONDatasetAdapter }
constructor TJSONDatasetAdapter.Create(aOwner: TComponent);
begin
inherited Create( aOwner );
fJSON := TStringList.Create;
fJSON.Text := '[]';
fDatasetRef := nil;
end;
destructor TJSONDatasetAdapter.Destroy;
begin
fJSON.DisposeOf;
fDatasetRef := nil;
inherited Destroy;
end;
procedure TJSONDatasetAdapter.SetDatasetRef(const Value: TDataset);
begin
fDatasetRef := Value;
UpdateDataset;
end;
procedure TJSONDatasetAdapter.setJSON(const Value: TStrings);
begin
if not assigned(value) then begin
fJSON.Clear;
exit;
end;
fJSON.Assign(Value);
UpdateDataset;
end;
procedure TJSONDatasetAdapter.SetFieldDefs( a: TJSONArray );
var
o: TJSONObject;
e: TJSONPairEnumerator;
p: TJSONPair;
v: TJSONValue;
n: string;
idx: uint32;
FieldDef: TFieldDef;
begin
if a.Count<1 then begin
exit;
end;
//- Loop through data to determine data-types.
for idx := 0 to pred(a.Count) do begin
v := a.Items[idx];
if not (v is TJSONObject) then begin
exit;
end;
o := v as TJSONObject;
try
e := o.GetEnumerator;
if not e.MoveNext then begin
exit;
end;
repeat
p := e.GetCurrent;
if not assigned(p) then continue;
//- Get the name of the field, and ensure we have a field def.
n := Lowercase(Trim(p.JsonString.ToString));
n := StringReplace(n,'"','',[rfReplaceAll]);
FieldDef := nil;
if fDatasetRef.FieldDefs.IndexOf(n)>=0 then begin
FieldDef := fDatasetRef.FieldDefs.Find(n);
end;
if not assigned(FieldDef) then begin
FieldDef := fDatasetRef.FieldDefs.AddFieldDef;
FieldDef.Name := n;
end;
//- Determine the type of field.
v := p.JsonValue;
if v is TJSONString then begin
if (FieldDef.DataType=TFieldType.ftUnknown) then begin
FieldDef.DataType := TFieldType.ftString;
end;
end else if v is TJSONNumber then begin
if (FieldDef.DataType=TFieldType.ftUnknown) then begin
FieldDef.DataType := TFieldType.ftFloat;
end else if (FieldDef.DataType <> TFieldType.ftFloat) then begin
raise EDataTypeCoersion.Create('');
end;
end else if v is TJSONBool then begin
if (FieldDef.DataType=TFieldType.ftUnknown) then begin
FieldDef.DataType := TFieldType.ftBoolean;
end else if (FieldDef.DataType<>ftBoolean) then begin
raise EDataTypeCoersion.Create('');
end;
end else if v is TJSONNull then begin
//- Do nothing, another record may indicate data type.
end else if v is TJSONObject then begin
raise EDataTypeUnsupported.Create('');
end else if v is TJSONArray then begin
raise EDataTypeUnsupported.Create('');
end;
until not e.MoveNext;
finally
o := nil;
end;
end;
//- Ensure that all field defs have known data types.
if fDatasetRef.FieldDefs.Count<1 then begin
exit;
end;
for idx := 0 to pred(fDatasetRef.FieldDefs.Count) do begin
if fDatasetRef.FieldDefs[idx].DataType=TFieldType.ftUnknown then begin
raise EUnknownDataType.Create('field: '+fDatasetRef.FieldDefs[idx].Name);
end;
end;
end;
procedure TJSONDatasetAdapter.InsertData( a: TJSONArray );
var
idx: uint32;
idy: uint32;
v: TJSONValue;
o: TJSONObject;
FieldName: string;
begin
if fDatasetRef.FieldDefs.Count<1 then begin
exit;
end;
if a.Count<1 then begin
exit;
end;
for idx := 0 to pred(a.Count) do begin
v := a.Items[idx];
if not (v is TJSONObject) then continue; //[ Exception here? ]
o := v as TJSONObject;
fDatasetRef.Insert;
for idy := 0 to pred(fDatasetRef.FieldDefs.Count) do begin
FieldName := fDatasetRef.FieldDefs[idy].Name;
v := o.GetValue(FieldName);
if assigned(v) then begin
if v is TJSONString then begin
fDatasetRef.FieldByName(FieldName).AsString := TJSONString(v).Value;
end else begin
fDatasetRef.FieldByName(FieldName).AsString := v.ToJSON;
end;
end;
end;
fDatasetRef.Post;
end;
end;
procedure TJSONDatasetAdapter.UpdateDataset;
var
o: TJSONObject;
a: TJSONArray;
v: TJSONValue;
begin
if not assigned(fDatasetRef) then begin
exit;
end;
fDatasetRef.Active := False;
fDatasetRef.FieldDefs.Clear;
try
// o := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes('{ "data": '+fJSON.Text+'}'),0) as TJSONObject;
o := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes('{ "data": '+fJSON.Text+'}'),0) as TJSONObject; // à tester
except
on E: Exception do begin
exit;
end;
end;
if not assigned(o) then begin
exit;
end;
v := o.GetValue('data');
if not assigned(v) then begin
exit;
end;
if not (v is TJSONArray) then begin
exit;
end;
a := v as TJSONArray;
if a.Count=0 then begin
exit;
end;
SetFieldDefs(a);
fDatasetRef.Active := True;
InsertData(a);
end;
end. |
Partager