superobject 序列数据集

  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.