我一直都在寻找各种业务功能的最简单写法，用减法的模式来开发软件。如果有比我的写法更简单的方法，请留言告知 我是怀疑泛型数组 setlength后会不会清零，弄了个小demo，不知道为什么我会有这个想法，难道是我看数据结构入魔了，记得记录指针需要另类释放问题。 记不清了 脑袋完蛋了 上demo ，事实证明setlengt
分类：QJSON
Qjson中把json字符串，当做子节点的方法
我一直都在寻找各种业务功能的最简单写法，用减法的模式来开发软件。如果有比我的写法更简单的方法，请留言告知。
|
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 |
procedure TForm4.btn2Click(Sender: TObject); const //外部的一个Json做子节点 AJsonStr = '{"name":"奥巴马","age":18}'; var MyQj: TQJson; begin MyQj := TQJson.Create; try MyQj.Add('country', '美国'); MyQj.Add('address', '华盛顿'); //美国有很多人，奥巴马是其中一员，而奥巴马的信息可能来自一个Json字符串， //我们需要把这个Json字符串当做一个子节点插入进来. with MyQj.AddArray('person') do begin Add.AsObject := AJsonStr; end; Memo1.Lines.Clear; Memo1.Lines.Add(MyQj.AsJson); finally MyQj.Free; end; end; |
qjson中把记录或类型或泛型数组转换为json字符串
我一直都在寻找各种业务功能的最简单写法，用减法的模式来开发软件。如果有比我的写法更简单的方法，请留言告知。
|
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 |
unit Unit4; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; type TForm4 = class(TForm) btn1: TButton; Memo1: TMemo; lbl1: TLabel; btn2: TButton; procedure btn1Click(Sender: TObject); procedure btn2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; /// <summary> /// 新手留意，一定要定义在implementation关键词的上方. /// </summary> type TRenLei = record name: string; age: Integer; sex: Boolean; end; var Form4: TForm4; implementation {$R *.dfm} uses qjson; procedure TForm4.btn1Click(Sender: TObject); var ARenLei: TRenLei; MyQj: TQJson; begin MyQj := TQJson.Create; try //这个例子比较好理解 ARenLei.name := '奥巴马'; ARenLei.age := 1; ARenLei.sex := True; MyQj.FromRecord<TRenLei>(ARenLei); Memo1.Lines.Clear; Memo1.Lines.Add(MyQj.AsJson); finally MyQj.Free; end; end; procedure TForm4.btn2Click(Sender: TObject); var RenLeiArray: TArray<TRenLei>; MyQj: TQJson; begin MyQj := TQJson.Create; try SetLength(RenLeiArray,2); with RenLeiArray[0] do begin name := '拜登'; age := 1; sex := True; end; with RenLeiArray[1] do begin name := '希拉里'; age := 2; sex := False; end; //这里不是很好理解了，我也不理解，这里用TArray<TRenLei>就可以把泛型数组转换为Json，谁知道原理的请下方留言。 MyQj.FromRecord<TArray<TRenLei>>(RenLeiArray); Memo1.Lines.Clear; Memo1.Lines.Add(MyQj.AsJson); finally MyQj.Free; end; end; end. |
[QJSON] 更新：修正了一处内存访问越界的问题
【问题描述】 该问题是由于 JsonCat 函数在计算需要的内存空间时，考虑不周造成的。新版修正了这一问题。 【严重程度】 高 【推荐程序】 高 【特别感谢】 熊猫叔叔
[QJSON] 更新：修正了 IOS 64 无法编译的问题
【问题描述】 该问题是由于 IOS 64 编译器未正确分区 TStream.Seek，不知道如何调用引起的。修正的代码强制进行了类型转换，以让其正确识别。 【严重程度】 低（仅影响IOS64） 【推荐级别】 可选 【特别感谢】 wealsh
[QMsgPack/QJson] 更新：修正了修改结点名字时，没有重新计算结点名称哈希值的问题
【问题描述】 该问题是由于 DoNodeNameChanged 的重载里，Rehash 子函数在查找结点原来的哈希记录时，使用了错误的哈希表对象引起的。 【严重程度】 高 【影响范围】 使用 TQHashedJson 和 TQHashedMsgPack 的用户 【推荐级别】 歌德 【特别感谢】 QQ
[QJSON] 常见问题及解答
1、如何创建根结点为数组类型的JSON对象？ 直接设置根结点的 DataType 为 jdtArray 即可。然后数组的子元素只需要挨个调用 Add 添加即可。 2、如何遍历 JSON 子结点的信息？ QJson 的 Count 属性记录了数组或对象的子结点数量，然后您可以使用正常的循环来遍历子元素，如： [crayo
[QJSON+QMsgPack] 更新：修正了 ItemByPath 对特定数组路径的支持问题
【问题描述】 对于根结点为数组类型的 JSON 或 MessagePack 对象，使用 ItemByPath 访问时，无法得到正确的返回值。以 JSON 为例，下面的 JSON 结构：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
[ [ { "name": "1" }, { "name": "2" } ], [ { "name": "3" }, { "name": "4" } ] ] |
如果试图以路径”[0]\[0]\name”来
[QJSON+QMsgPack] 修正了 TQHashedJSON 和 TQHashedMsgPack 释放时的Bug
【问题描述】 该问题是由于先释放了内部的哈希表对象，而父类再释放时调用 Clear 时再次引用该对象造成的。 【严重级别】 高 【推荐程度】 中 【特别感谢】 QQ
[QJson+QWorker] 更新：两点小更新
【更新说明】 1、QWorker 将 MsgWaitForEvent 函数公开出来，以便其它模块使用； 2、QJson 将 SetValue.DetectValue 函数的检测方式做了下变更，直接调用 TryParseValue 而不是 ParseValue ，以避免在调试时由于检测不到合适的类型而抛出异常。 【更新级
DFM->JSON 格式转换
应群友的要求，编写了一个解析 DFM 文件格式，将其转换为 JSON 格式的函数，需要引用 QJSON 和 QString 单元。代码分享给大家，供大家参考：
|
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 |
function DFM2Json(AFileName: String): TQJson; var ADFMStream, ATemp: TMemoryStream; I: Integer; AObjNode: TQJson; const SSpace: PWideChar = ' '#9; SColon: PWideChar = ':'; SNull: WideChar = #0; function IsTextDFM(S: PAnsiChar): Boolean; begin Result := (AnsiStrLComp(S, 'object', 6) = 0) or (AnsiStrLComp(S, 'inherited', 9) = 0); end; procedure DecodeObject(ALine: PWideChar; var AObjName, AObjClass: QStringW); begin SkipUntilW(ALine, SSpace); AObjName := Trim(DecodeTokenW(ALine, SColon, SNull, True)); AObjClass := Trim(ALine); end; function DecodeDFMString(S: QStringW): QStringW; var ps, pd: PWideChar; V: Int64; begin if Length(S) > 0 then begin ps := PWideChar(S); SetLength(Result, Length(S)); pd := PWideChar(Result); while ps^ <> #0 do begin if ps^ = '#' then begin Inc(ps); if ParseInt(ps, V) > 0 then begin pd^ := WideChar(V); Inc(pd); end; end else if ps^ = '''' then begin Inc(ps); while ps^ <> '''' do begin pd^ := ps^; Inc(pd); Inc(ps); end; Inc(ps); end else begin break; end; end; SetLength(Result, pd - PWideChar(Result)); end else Result := ''; end; procedure DecodePropAndChildren(AParent: TQJson; var ps: PWideChar; AIsCollection: Boolean); var ALine, AName, AValue: QStringW; pl, pv: PWideChar; ATemp: TQJson; ACharset: Longint; AProps: TQJson; AChildren: TQJson; const SObject: PWideChar = 'object'; SInline: PWideChar = 'inline'; SEnd: PWideChar = 'end'; SEqual: PWideChar = '='; SNull: WideChar = #0; SItem: PWideChar = 'item'; SBracket: PWideChar = ')'; begin AProps := AParent; AChildren := nil; repeat ALine := DecodeLineW(ps); pl := PWideChar(ALine); SkipSpaceW(pl); SkipSpaceW(ps); if StartWithW(pl, SObject, True) or StartWithW(pl, SInline, True) then begin DecodeObject(pl, AName, AValue); DecodePropAndChildren(AParent.Add(AName, jdtObject), ps, False); end else if StartWithW(pl, SEnd, True) then Exit else // Property line begin AName := Trim(DecodeTokenW(pl, SEqual, SNull, True)); AValue := Trim(pl); pv := PWideChar(AValue); if (pv^ = '''') or (pv^ = '#') then begin AProps.ForcePath(AName).AsString := DecodeDFMString(AValue); end else if pv^ = '<' then begin Inc(pv); SkipSpaceW(pv); if pv^ <> '>' then begin ATemp := TQJson.Create; ATemp.DataType := jdtArray; try SkipSpaceW(ps); while StartWithW(ps, SItem, True) do begin SkipLineW(ps); DecodePropAndChildren(ATemp.Add, ps, True); end; SkipSpaceW(ps); if ps^ = '>' then SkipLineW(ps); finally if ATemp.Count > 0 then AProps.Add(AName).Assign(ATemp); FreeObject(ATemp); end; end; end else if pv^ = '(' then // Strings begin AValue := ''; while ps^ <> #0 do begin ALine := Trim(DecodeLineW(ps)); if Length(AValue) > 0 then AValue := AValue + SLineBreak + DecodeDFMString(ALine) else AValue := DecodeDFMString(ALine); if (ps^ = ')') or EndWithW(ALine, SBracket, True) then break; end; SkipSpaceW(ps); if ps^ = ')' then SkipLineW(ps); SkipSpaceW(ps); if Length(AValue) > 0 then AProps.ForcePath(AName).AsString := AValue; end else AProps.ForcePath(AName).Value := AValue; end; until Length(ALine) = 0; end; procedure DoConvert(AText: QStringW); var p: PWideChar; AObjectName, ARootClass: QStringW; const SObject: PWideChar = 'object '; SInherited: PWideChar = 'inherited '; begin if Length(AText) > 0 then begin p := PWideChar(AText); if StartWithW(p, SObject, True) or StartWithW(p, SInherited, True) then begin Result := TQJson.Create; try DecodeObject(PWideChar(DecodeLineW(p)), AObjectName, ARootClass); DecodePropAndChildren(Result.Add(ARootClass, jdtObject), p, False); finally if Result.Count = 0 then FreeAndNil(Result); end; end; end; end; begin ADFMStream := TMemoryStream.Create; try ADFMStream.LoadFromFile(AFileName); if PCardinal(ADFMStream.Memory)^ = $30465054 then begin ATemp := TMemoryStream.Create; ATemp.CopyFrom(ADFMStream, 0); ATemp.Position := 0; ADFMStream.Size := 0; ObjectBinaryToText(ATemp, ADFMStream); FreeAndNil(ATemp); ADFMStream.Position := 0; DoConvert(LoadTextW(ADFMStream)); end else if IsTextDFM(ADFMStream.Memory) then DoConvert(LoadTextW(ADFMStream)); finally FreeObject(ADFMStream); end; end; |
用法：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
procedure TForm1.Button1Click(Sender: TObject); var AJson: TQJson; begin if OpenDialog1.Execute then begin AJson := DFM2Json(OpenDialog1.FileName); if AJson <> nil then begin Memo1.Lines.Text := AJson.AsString; FreeAndNil(AJson); end; end; end; |
一个转换结果示例：
[QJSON] 更新:保存 JSON 中的注释
QJSON 新版中增加了对注释保存的支持，早先版本的 QJSON 对于注释会自动跳过，不会保存注释的内容。但这一功能在 StrictJson 为 true 时不会支持，以兼容更多的解析器。 QJSON 中，注释的保存通过 CommentStyle 属性来控制： jcsIgnore : 忽略掉注释，保存时不会保存注释的内
[QJSON] 更新：使用 Equals 来判定两个 JSON 的内容是否一致
QJSON 新版重新实现了一个 Equals 函数，来判定两个 JSON 对象的内容是否一致。用法也很简单： JSON1.Equals(JSON2); 两个JSON的对象的内容，如果完全一致，则返回 True ，存在不一致的内容，则返回 False。 这里，所谓的一致是指：名称、类型和值三者皆相同，如下面的JSON对象
[QJSON] 使用 QJSON 的一些函数时的注意事项
QJSON 推出已经有相当一段时间了，经过这么多版本的更新，到了该回顾一下的时候。今天这篇文章算是一个简单的总结回顾，对大家使用 QJSON 过程中遇到的常见问题做一个简单的小结。 1、Add 系列函数 Add 系列函数用于添加一个子结点，它有 n 个重载的版本，最让大家疑惑的是下面的这个重载： [crayon-5bf
[QJSON] 更新：增加多个函数
【更新说明】 + 增加函数 Sort 来支持对子结点排序 + 增加 RevertOrder 反转子结点顺序 + 增加 ExchangeOrder 交互子结点顺序 + 增加 ContainsName 判断子结点中是否有指定名称的子结点 + 增加 ContainsValue 判断子结点中是否有指定值的子结点 + 增加 Ex
QJSON 更新 – 增加使用Base64编码二进制数据的默认支持
【更新说明】 新增函数 EncodeJsonBinaryAsBase64 直接用来支持你在 AsBytes 、 ValueFromStream、ValueFromFile 赋值时，二进制编码为字符串时的处理方式。如果你不需要，只需要调用 EncodeJsonBinaryAsHex 就可以恢复原始的十六进制编码方式。 【
重要更新 – QString 中 ParseNumeric 的一个低级错误影响QJson/QXML/QMsgPack
【问题描述】 该问题是由于解析浮点数字时，直接使用 ParseInt 解析浮点数的整数部分，因此在解析 -0.xxx 这种浮点数据时，会出现错误的解析结果。 【更新级别】 立即 【严重程度】 高 【特别感谢】 YZ
重要更新 – 请 QXML、QJson、QMsgPack、QLog、QWorker 用户更新
【问题描述】 该问题是由于 TQStringCatHelperW.Cat 函数在连接字符串时，计算需要的内存缓冲区大小不正确，可能造成构造较长的结果字符串时结果不正确，甚至可能出现 Access Volition 错误。问题发生在下面两个函数：
|
1 2 |
function TQStringCatHelperW.Cat(p: PQCharW; len: Integer): TQStringCatHelperW; function TQStringCatHelperW.Cat(c: QCharW): TQStringCatHelperW; |
两个函数
QJson 更新 – 修正了 AsInteger/AsInt64/AsFloat 不兼容十六进制字符串的问题
【问题描述】 下面的 JSON 字符串：
|
1 2 3 |
{ "color":"$FF0000" } |
如果对 color 使用 AsInteger / AsInt64 / AsFloat 访问时，会提示不是有效的数字。 【严重程度】 中 【更新级别】 可选 【特别感谢】 阿木
QJSON 更新 – 修正了 JSON 结点名称为空字符串时，无法解析的问题
【问题描述】 JSON 标准中，允许结点的名称为任意数量的Unicode字符，俺没理解上去，限制了名称长度不为0，改过来。 【更新级别】 可选 【严重程度】 中 【特别感谢】 Synopse 的作者在其博客上的反馈