D7XHshengfang/盛纺贸易管理/uJSONDB.pas
DESKTOP-E401PHE\Administrator 0cb161cfb3 ~
2025-04-30 23:58:03 +08:00

237 lines
6.1 KiB
ObjectPascal
Raw Permalink Blame History

unit uJSONDB;
interface
uses
SysUtils, Classes, Variants, DB, DBClient, SuperObject, Dialogs;
type
TJSONDB = class
private
class function getJsonFieldNames(res: ISuperObject): TStringList;
class function getJsonFieldValues(res: ISuperObject): TStringList;
public
class procedure JsonToClientDataSet(jsonArr: TSuperArray; dstCDS: TClientDataSet);
class function ClientDataSetToJSON(srcCDS: TClientDataSet): UTF8String;
end;
implementation
function GetToken(var astring: string; const fmt: array of char): string;
var
i, j: integer;
Found: Boolean;
begin
Found := false;
result := '';
astring := TrimLeft(astring);
if length(astring) = 0 then
exit;
i := 1;
while i <= length(astring) do
begin
Found := false;
if astring[i] <= #128 then
begin
for j := Low(fmt) to High(fmt) do
begin
if (astring[i] <> fmt[j]) then
continue;
Found := true;
break;
end;
if not Found then
i := i + 1;
end
else
i := i + 2;
if Found then
break;
end;
if Found then
begin
result := copy(astring, 1, i - 1);
delete(astring, 1, i);
end
else
begin
result := astring;
astring := '';
end;
end;
function GetFieldParams(PropName, Source: string): string;
var
S1, S2: string;
TmpParam: string;
AChar: string;
aValue, aPropName, aSource: string;
begin
Result := '';
if Source = '' then
Exit;
aSource := Source;
while aSource <> '' do
begin
aValue := GetToken(aSource, [',']);
aPropName := GetToken(aValue, [':']);
if CompareText(PropName, aPropName) <> 0 then
continue;
Result := aValue;
break;
end;
end;
//<2F>ÄjsonÈ¡µÃ™ÚλÃû·Q
class function TJSONDB.getJsonFieldNames(res: ISuperObject): TStringList;
var
i: Integer;
fieldList: TStringList;
fieldNames: string;
begin
try
fieldList := TStringList.Create;
fieldNames := res.AsObject.getNames.AsString;
fieldNames := StringReplace(fieldNames, '[', '', [rfReplaceAll, rfIgnoreCase]);
fieldNames := StringReplace(fieldNames, ']', '', [rfReplaceAll, rfIgnoreCase]);
fieldNames := StringReplace(fieldNames, '"', '', [rfReplaceAll, rfIgnoreCase]);
fieldList.Delimiter := ',';
fieldList.DelimitedText := fieldNames;
Result := fieldList;
finally
//fieldList.Free;
end;
end;
//<2F>ÄjsonÈ¡µÃ™Úλֵ
class function TJSONDB.getJsonFieldValues(res: ISuperObject): TStringList;
var
i: Integer;
fieldList: TStringList;
fieldValues: string;
begin
try
fieldList := TStringList.Create;
fieldValues := res.AsObject.getValues.AsString;
fieldValues := StringReplace(fieldValues, '[', '', [rfReplaceAll, rfIgnoreCase]);
fieldValues := StringReplace(fieldValues, ']', '', [rfReplaceAll, rfIgnoreCase]);
fieldValues := StringReplace(fieldValues, '"', '', [rfReplaceAll, rfIgnoreCase]);
fieldList.Delimiter := ',';
fieldList.DelimitedText := fieldValues;
Result := fieldList;
finally
//fieldList.Free;
end;
end;
//jsonÞDCDS
class procedure TJSONDB.JsonToClientDataSet(jsonArr: TSuperArray; dstCDS: TClientDataSet);
var
fieldList: TStringList;
valuesList: TStringList;
jsonSrc: string;
i, j: Integer;
begin
fieldList := getJsonFieldNames(SO[jsonArr[0].AsJson(False, False)]);
if (dstCDS.FieldCount = 0) then
begin
for i := 0 to fieldList.Count - 1 do
begin
dstCDS.FieldDefs.Add(fieldList[i], ftString, 100, False);
end;
dstCDS.CreateDataSet;
dstCDS.Close;
dstCDS.Open;
end;
try
dstCDS.DisableControls;
for i := 0 to jsonArr.Length - 1 do
begin
jsonSrc := SO[jsonArr[i].AsJson(False, False)].AsString;
jsonSrc := StringReplace(jsonSrc, '[', '', [rfReplaceAll, rfIgnoreCase]);
jsonSrc := StringReplace(jsonSrc, ']', '', [rfReplaceAll, rfIgnoreCase]);
jsonSrc := StringReplace(jsonSrc, '"', '', [rfReplaceAll, rfIgnoreCase]);
jsonSrc := StringReplace(jsonSrc, '{', '', [rfReplaceAll, rfIgnoreCase]);
jsonSrc := StringReplace(jsonSrc, '}', '', [rfReplaceAll, rfIgnoreCase]);
dstCDS.Append;
for j := 0 to fieldList.Count - 1 do
begin
if fieldList[j] = 'status' then
begin
if GetFieldParams(fieldList[j], jsonSrc) = '01' then
begin
dstCDS.FieldByName(fieldList[j]).AsString := '»ã¿îÐÐÒÑ»ã³ö';
end;
if GetFieldParams(fieldList[j], jsonSrc) = '02' then
begin
dstCDS.FieldByName(fieldList[j]).AsString := 'ÖÐתÐÐÒÑÖÐת';
end;
if GetFieldParams(fieldList[j], jsonSrc) = '03' then
begin
dstCDS.FieldByName(fieldList[j]).AsString := 'ÖÐתÐд¦ÀíÖÐ';
end;
if GetFieldParams(fieldList[j], jsonSrc) = '04' then
begin
dstCDS.FieldByName(fieldList[j]).AsString := 'ÖÐתÐÐÒÑÍË»Ø';
end;
if GetFieldParams(fieldList[j], jsonSrc) = '06' then
begin
dstCDS.FieldByName(fieldList[j]).AsString := 'ÊÕ¿îÐÐÒÑÈëÕË';
end;
end
else
dstCDS.FieldByName(fieldList[j]).AsString := GetFieldParams(fieldList[j], jsonSrc);
end;
dstCDS.Post;
end;
finally
dstCDS.EnableControls;
end;
end;
//ClientDataSetÞDJSON
class function TJSONDB.ClientDataSetToJSON(srcCDS: TClientDataSet): UTF8String;
var
i, j: Integer;
keyValue: string;
jsonList: TStringList;
jsonResult: string;
begin
if not srcCDS.Active then
srcCDS.Open;
try
jsonList := TStringList.Create;
srcCDS.DisableControls;
srcCDS.First;
while not srcCDS.Eof do
begin
keyValue := '';
for i := 0 to srcCDS.FieldDefs.Count - 1 do
begin
keyValue := keyValue + Format('"%s":"%s",', [srcCDS.Fields[i].FieldName, srcCDS.Fields[i].AsString]);
end;
jsonList.Add(Format('{%s}', [Copy(keyValue, 0, Length(keyValue) - 1)]));
srcCDS.Next;
end;
for i := 0 to jsonList.Count - 1 do
begin
jsonResult := jsonResult + jsonList[i] + ',';
end;
Result := Utf8Encode(Format('[%s]', [Copy(jsonResult, 0, Length(jsonResult) - 1)]));
finally
srcCDS.EnableControls;
jsonList.Free;
end;
end;
end.