1 unit uDBJson;
2
3 interface
4
5 {$HINTS OFF}
6
7 uses
8 SysUtils, Classes, Variants, DB, DBClient, SuperObject;
9
10 type
11 TTableJSon = class
12
13 private const
14 cstFieldType = 'FieldType';
15
16 const
17 cstFieldName = 'FieldName';
18
19 const
20 cstFieldSize = 'FieldSize';
21
22 const
23 cstJsonType = 'JsonType';
24
25 const
26 cstRequired = 'Required';
27
28 const
29 cstFieldIndex = 'FieldIndex';
30
31 const
32 cstCols = 'Cols';
33
34 const
35 cstData = 'Data';
36
37 public
38 class function DataSetToJson(DataSet: TDataSet): ISuperObject;
39 class function DataSetToJson2(DataSet: TDataSet): string;
40 class function CreateFieldByJson(Fields: TFieldDefs;
41 ColsJson: ISuperObject): Boolean;
42 class procedure ImportDataFromJSon(DataSet: TDataSet;
43 DataJson: ISuperObject);
44 class function JSonToClientDataset(CDS: TClientDataSet; Json: ISuperObject)
45 : Boolean;
46 class function GetValue(Json: ISuperObject; const Name: string): Variant;
47
48 class function CreateJsonValue(Json: ISuperObject; const Name: string;
49 const Value: Variant): Boolean;
50 class function CreateJsonValueByField(Json: ISuperObject;
51 Field: TField): Boolean;
52 class function GetValue2Field(Field: TField;
53 JsonValue: ISuperObject): Variant;
54 end;
55
56 implementation
57
58 uses TypInfo, encddecd;
59
60 { TTableJSon }
61
62 class function TTableJSon.JSonToClientDataset(CDS: TClientDataSet;
63 Json: ISuperObject): Boolean;
64 var
65 ColsJson: ISuperObject;
66 begin
67 Result := False;
68 if Json = nil then
69 Exit;
70 CDS.Close;
71 CDS.Data := Null;
72 // 创建字段
73 ColsJson := Json.O[cstCols];
74 CreateFieldByJson(CDS.FieldDefs, ColsJson);
75 if CDS.FieldDefs.Count > 0 then
76 CDS.CreateDataSet;
77 ImportDataFromJSon(CDS, Json.O[cstData]);
78 Result := True;
79 end;
80
81 class function TTableJSon.CreateFieldByJson(Fields: TFieldDefs;
82 ColsJson: ISuperObject): Boolean;
83 var
84 SubJson: ISuperObject;
85 ft: TFieldType;
86 begin
87 Result := False;
88 Fields.DataSet.Close;
89 Fields.Clear;
90 for SubJson in ColsJson do
91 begin
92 ft := TFieldType(GetEnumValue(TypeInfo(TFieldType),
93 'ft' + SubJson.S[cstFieldType]));
94 if ft = ftAutoInc then // 自增字段不能录入,必须更改
95 ft := ftInteger;
96 Fields.Add(SubJson.S[cstFieldName], ft, SubJson.I[cstFieldSize],
97 SubJson.B[cstRequired]);
98 end;
99 Result := True;
100 end;
101
102 class function TTableJSon.CreateJsonValue(Json: ISuperObject;
103 const Name: string; const Value: Variant): Boolean;
104 begin
105 Result := False;
106 Json.O[Name] := SO(Value);
107 Result := True;
108 end;
109
110 class function TTableJSon.CreateJsonValueByField(Json: ISuperObject;
111 Field: TField): Boolean;
112 begin
113 Result := False;
114 if Field Is TDateTimeField then
115 Json.O[Field.FieldName] := SO(Field.AsDateTime)
116 else if Field is TBlobField then
117 Json.S[Field.FieldName] := EncodeString(Field.AsString)
118 else
119 Json.O[Field.FieldName] := SO(Field.Value);
120 Result := True;
121 end;
122
123 class function TTableJSon.GetValue(Json: ISuperObject;
124 const Name: string): Variant;
125 begin
126 case Json.DataType of
127 stNull:
128 Result := Null;
129 stBoolean:
130 Result := Json.B[Name];
131 stDouble:
132 Result := Json.D[Name];
133 stCurrency:
134 Result := Json.C[Name];
135 stInt:
136 Result := Json.I[Name];
137 stString:
138 Result := Json.S[Name];
139 end;
140 end;
141
142 class function TTableJSon.GetValue2Field(Field: TField;
143 JsonValue: ISuperObject): Variant;
144 begin
145 if JsonValue.DataType = stNull then
146 Result := Null
147 else if Field is TDateTimeField then
148 Result := JavaToDelphiDateTime(JsonValue.AsInteger)
149 else if (Field is TIntegerField) or (Field is TLargeintField) then
150 Result := JsonValue.AsInteger
151 else if Field is TNumericField then
152 Result := JsonValue.AsDouble
153 else if Field is TBooleanField then
154 Result := JsonValue.AsBoolean
155 else if Field is TStringField then
156 Result := JsonValue.AsString
157 else if Field is TBlobField then
158 Result := DecodeString(JsonValue.AsString)
159 end;
160
161 class procedure TTableJSon.ImportDataFromJSon(DataSet: TDataSet;
162 DataJson: ISuperObject);
163 var
164 SubJson: ISuperObject;
165 iter: TSuperObjectIter;
166 begin
167 if not DataSet.Active then
168 DataSet.Open;
169 DataSet.DisableControls;
170 try
171 for SubJson in DataJson do
172 begin
173 DataSet.Append;
174 if ObjectFindFirst(SubJson, iter) then
175 begin
176 repeat
177 if DataSet.FindField(iter.Ite.Current.Name) <> nil then
178 DataSet.FindField(iter.Ite.Current.Name).Value :=
179 GetValue2Field(DataSet.FindField(iter.Ite.Current.Name),
180 iter.Ite.Current.Value);
181 until not ObjectFindNext(iter);
182 end;
183 DataSet.Post;
184 end;
185 finally
186 DataSet.EnableControls;
187 end;
188 end;
189
190 class function TTableJSon.DataSetToJson(DataSet: TDataSet): ISuperObject;
191 procedure GetFieldTypeInfo(Field: TField; var Fieldtyp, JsonTyp: string);
192 begin
193 Fieldtyp := GetEnumName(TypeInfo(TFieldType), ord(Field.DataType));
194 Delete(Fieldtyp, 1, 2);
195 if Field is TStringField then
196 JsonTyp := 'string'
197 else if Field is TDateTimeField then
198 JsonTyp := 'integer'
199 else if (Field is TIntegerField) or (Field is TLargeintField) then
200 JsonTyp := 'integer'
201 else if Field is TCurrencyField then
202 JsonTyp := 'currency'
203 else if Field is TNumericField then
204 JsonTyp := 'double'
205 else if Field is TBooleanField then
206 JsonTyp := 'boolean'
207 else
208 JsonTyp := 'variant';
209 end;
210
211 var
212 sj, aj, sj2: ISuperObject;
213 I: Integer;
214 Fieldtyp, JsonTyp: string;
215 List: TStringList;
216 begin
217 sj := SO();
218 // 创建列
219 aj := SA([]);
220 List := TStringList.Create;
221 try
222 List.Sorted := True;
223
224 for I := 0 to DataSet.FieldCount - 1 do
225 begin
226 sj2 := SO();
227 GetFieldTypeInfo(DataSet.Fields[I], Fieldtyp, JsonTyp);
228
229 sj2.S[cstFieldName] := DataSet.Fields[I].FieldName;
230 sj2.S[cstFieldType] := Fieldtyp;
231 sj2.S[cstJsonType] := JsonTyp;
232 sj2.I[cstFieldSize] := DataSet.Fields[I].Size;
233 sj2.B[cstRequired] := DataSet.Fields[I].Required;
234 sj2.I[cstFieldIndex] := DataSet.Fields[I].Index;
235 aj.AsArray.Add(sj2);
236 List.Add(DataSet.Fields[I].FieldName + '=' + JsonTyp);
237 end;
238 sj.O['Cols'] := aj;
239 // 创建数据集的数据
240 DataSet.DisableControls;
241
242 DataSet.First;
243 aj := SA([]);
244 while not DataSet.Eof do
245 begin
246 sj2 := SO();
247 for I := 0 to DataSet.FieldCount - 1 do
248 begin
249 if VarIsNull(DataSet.Fields[I].Value) then
250 sj2.O[DataSet.Fields[I].FieldName] := SO(Null)
251 else
252 begin
253 CreateJsonValueByField(sj2, DataSet.Fields[I]);
254 end;
255 end;
256 aj.AsArray.Add(sj2);
257 DataSet.Next;
258 end;
259 sj.O['Data'] := aj;
260 Result := sj;
261 finally
262 List.Free;
263 DataSet.EnableControls;
264 end;
265 end;
266
267 class function TTableJSon.DataSetToJson2(DataSet: TDataSet): string;
268 procedure GetFieldTypeInfo(Field: TField; var Fieldtyp, JsonTyp: string);
269 begin
270 Fieldtyp := GetEnumName(TypeInfo(TFieldType), ord(Field.DataType));
271 Delete(Fieldtyp, 1, 2);
272 if Field is TStringField then
273 JsonTyp := 'string'
274 else if Field is TDateTimeField then
275 JsonTyp := 'integer'
276 else if (Field is TIntegerField) or (Field is TLargeintField) then
277 JsonTyp := 'integer'
278 else if Field is TCurrencyField then
279 JsonTyp := 'currency'
280 else if Field is TNumericField then
281 JsonTyp := 'double'
282 else if Field is TBooleanField then
283 JsonTyp := 'boolean'
284 else
285 JsonTyp := 'variant';
286 end;
287
288 var
289 sj, aj, sj2: ISuperObject;
290 I: Integer;
291 Fieldtyp, JsonTyp: string;
292 List: TStringList;
293 begin
294 sj := SO();
295 // 创建列
296 aj := SA([]);
297 List := TStringList.Create;
298 try
299 List.Sorted := True;
300
301 for I := 0 to DataSet.FieldCount - 1 do
302 begin
303 sj2 := SO();
304 GetFieldTypeInfo(DataSet.Fields[I], Fieldtyp, JsonTyp);
305
306 sj2.S[cstFieldName] := DataSet.Fields[I].FieldName;
307 sj2.S[cstFieldType] := Fieldtyp;
308 sj2.S[cstJsonType] := JsonTyp;
309 sj2.I[cstFieldSize] := DataSet.Fields[I].Size;
310 sj2.B[cstRequired] := DataSet.Fields[I].Required;
311 sj2.I[cstFieldIndex] := DataSet.Fields[I].Index;
312 aj.AsArray.Add(sj2);
313 List.Add(DataSet.Fields[I].FieldName + '=' + JsonTyp);
314 end;
315 sj.O['Cols'] := aj;
316 // 创建数据集的数据
317 DataSet.DisableControls;
318
319 DataSet.First;
320 aj := SA([]);
321 while not DataSet.Eof do
322 begin
323 sj2 := SO();
324 for I := 0 to DataSet.FieldCount - 1 do
325 begin
326 if VarIsNull(DataSet.Fields[I].Value) then
327 sj2.O[DataSet.Fields[I].FieldName] := SO(Null)
328 else
329 begin
330 CreateJsonValueByField(sj2, DataSet.Fields[I]);
331 end;
332 end;
333 aj.AsArray.Add(sj2);
334 DataSet.Next;
335 end;
336 sj.O['Data'] := aj;
337 Result := sj.AsString;
338 finally
339 List.Free;
340 DataSet.EnableControls;
341 end;
342 end;
343
344 end.