CslJson.pas 7.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301
  1. //------------------------------------------------------------------------------
  2. // 类名: TCslJson
  3. //
  4. // 描述: 简单的Json字符串解析。
  5. // 为简化操作,该类对Json字符串的格式有一定的要求:
  6. // ①键名字不能重复;②键值全部是字符串。格式如下:
  7. // {"status":"true","msg":{"curr":"1","status2":"\u5ba1\u6838\u4e2d",
  8. // "name":"珠海纵横"}}
  9. //
  10. // 网上找过几个三方Json控件,基本不能用,有个叫lkJson的刚开始还不错,但
  11. // 随着需求的深入,发现问题越来越多:不能嵌套数组、不能用索引的方式遍历
  12. // 子结点(始终返回Null)、Delphi处理转义字符困难等问题。另外有些三方
  13. // Json控件(如superobject1.24)只支持Delphi XE等高版本, 表现为有些语法在
  14. // Delphi7中不支持、“Integer overflow”报错等。太多问题,无奈,自己写
  15. // 个简单的解析。有点山寨,但能解决问题。有空再写个专业的。
  16. //
  17. // 作者: Chenshilong, 2014-07-03
  18. //------------------------------------------------------------------------------
  19. unit CslJson;
  20. interface
  21. uses
  22. SysUtils, Classes, Dialogs;
  23. type
  24. TOVArr = array of array of string; // ObjectValuesArray
  25. TStrArr = array of string;
  26. TCslJson = class
  27. private
  28. FText: string;
  29. FOVArr: TOVArr;
  30. procedure SetText(const Value: string);
  31. function GetValue(const AField: string): string;
  32. // 处理转义字符的问题
  33. function Transfer(AStr: string): string;
  34. public
  35. property Text: string read FText write SetText;
  36. // 取指定键名字的键值。如果键值是个对象则返回{Object}
  37. // 键值带不带"号都能正确解析,一律返回字符串类型。键值为空不影响结果,
  38. // 没有类型转换、溢出等问题。
  39. property Value[const AField: string]: string read GetValue;
  40. // 如果指定键名字的键值是个对象,则把对象的每个属性值依次填入数组AArray中。
  41. // AArray数组下标任意,数组元素个数任意(不会溢出)
  42. procedure ChildValues(AField: string; var AArray: array of string);
  43. function ArrayText(AField: string): string; // Json二维数组对象序列化后的字符串值
  44. function ArrayElementCount(AField: string): Integer; // Json二维数组对象中元素个数
  45. function ArrayElementText(AField: string; AIndex: Integer): string; // Json二维数组的第AIndex个元素的字符串值
  46. function ArrayElementPropertyCount(AElementText: string): Integer; // Json二维数组的元素的键值对个数
  47. function ArrayValues(AField: string): TOVArr;
  48. procedure ValueStrings(AField: string; var AValue: TStrings);
  49. end;
  50. implementation
  51. { TcslJson }
  52. procedure TCslJson.SetText(const Value: string);
  53. begin
  54. FText := Value;
  55. end;
  56. function TCslJson.GetValue(const AField: string): string;
  57. var sF: string;
  58. iPos, iCur: Integer;
  59. begin
  60. Result := '';
  61. if AField = '' then Exit;
  62. sF := Format('"%s":', [AField]);
  63. iPos := POS(sF, FText);
  64. if iPos = 0 then Exit;
  65. iCur := iPos + Length(sF);
  66. iPos := iCur;
  67. while (FText[iCur] <> ',') and (FText[iCur] <> '}') do
  68. Inc(iCur);
  69. Result := Copy(FText, iPos, iCur - iPos);
  70. if Pos('{', Result) > 0 then
  71. begin
  72. Result := '{Object}';
  73. Exit;
  74. end;
  75. Result := StringReplace(Result, '"', '', [rfReplaceAll]);
  76. Result := Transfer(Result);
  77. end;
  78. procedure TCslJson.ChildValues(AField: string; var AArray: array of string);
  79. var sField, sText, sValue: string;
  80. iPos, iCur, i, j: Integer;
  81. vSL: TStringList;
  82. begin
  83. if AField = '' then Exit;
  84. sField := Format('"%s":', [AField]);
  85. iPos := POS(sField, FText);
  86. if iPos = 0 then Exit;
  87. iCur := iPos + Length(sField);
  88. iPos := iCur;
  89. while (FText[iCur] <> '}') do
  90. Inc(iCur);
  91. sText := Copy(FText, iPos, iCur - iPos);
  92. sText := StringReplace(sText, '{', '', []); // 去掉第一个"{"
  93. if Pos('{', sText) > 0 then // 证明还嵌套有子对象,不支持
  94. begin
  95. AArray[Low(AArray)] := '{Contain Sub Object}';
  96. Exit;
  97. end;
  98. // "curr":"1","status2":"\u5ba1\u6838\u4e2d","total":"1","name":"珠海纵横"
  99. vSL := TStringList.Create;
  100. try
  101. while Length(sText) > 0 do
  102. begin
  103. iPos := POS(':"', sText);
  104. iCur := iPos + 2;
  105. iPos := iCur;
  106. while (sText[iCur] <> '"') do
  107. Inc(iCur);
  108. sValue := Copy(sText, iPos, iCur - iPos);
  109. sValue := Transfer(sValue);
  110. vSL.Add(sValue);
  111. iCur := iCur + 2;
  112. sText := Copy(sText, iCur, Length(sText) - iCur + 1);
  113. end;
  114. // 这种方式保证数组下标任意,数组元素个数任意,不受限制
  115. j := 1;
  116. for i := Low(AArray) to High(AArray) do
  117. begin
  118. if J > vSL.Count then Break;
  119. AArray[i] := vSL[j - 1];
  120. Inc(j);
  121. end;
  122. finally
  123. vSL.Free;
  124. end;
  125. end;
  126. function TCslJson.Transfer(AStr: string): string;
  127. begin
  128. AStr := StringReplace(AStr, '\/', '\', [rfReplaceAll]); // 路径中的“\/”
  129. Result := AStr;
  130. end;
  131. function TCslJson.ArrayText(AField: string): string;
  132. var sField: string;
  133. iPos, iCur: Integer;
  134. begin
  135. Result := '';
  136. if AField = '' then Exit;
  137. sField := Format('"%s":[', [AField]);
  138. iPos := POS(sField, FText);
  139. if iPos = 0 then Exit;
  140. iCur := iPos + Length(sField);
  141. iPos := iCur;
  142. while (FText[iCur] <> ']') do
  143. Inc(iCur);
  144. Result := Copy(FText, iPos, iCur - iPos);
  145. end;
  146. function TCslJson.ArrayElementText(AField: string; AIndex: Integer): string;
  147. var sAT: string;
  148. iLen, i, iCount, iPos1, iPos2: Integer;
  149. begin
  150. Result := '';
  151. iCount := 0;
  152. iPos1 := 0;
  153. iPos2 := 0;
  154. sAT := ArrayText(AField);
  155. iLen := Length(sAT);
  156. for i := 1 to iLen do
  157. begin
  158. if sAT[i] = '{' then
  159. begin
  160. Inc(iCount);
  161. if iCount = AIndex then
  162. begin
  163. iPos1 := i;
  164. Break;
  165. end;
  166. end;
  167. end;
  168. for i := iPos1 to iLen do
  169. begin
  170. if sAT[i] = '}' then
  171. begin
  172. iPos2 := i;
  173. Break;
  174. end;
  175. end;
  176. Result := Copy(sAT, iPos1, iPos2 - iPos1 + 1);
  177. end;
  178. function TCslJson.ArrayElementCount(AField: string): Integer;
  179. var i, iLen: Integer;
  180. sAText: string;
  181. begin
  182. Result := 0;
  183. sAText := ArrayText(AField);
  184. iLen := Length(sAText);
  185. for i := 1 to iLen do
  186. begin
  187. if sAText[i] = '}' then
  188. Inc(Result);
  189. end;
  190. end;
  191. function TCslJson.ArrayElementPropertyCount(AElementText: string): Integer;
  192. var i, iLen: Integer;
  193. begin
  194. Result := 1;
  195. iLen := Length(AElementText);
  196. for i := 1 to iLen do
  197. begin
  198. if AElementText[i] = ',' then
  199. if (i < iLen) and (AElementText[i + 1] = '"') then
  200. Inc(Result);
  201. end;
  202. end;
  203. function TCslJson.ArrayValues(AField: string): TOVArr;
  204. var sText: string;
  205. iPos, iCur, i, j, iECount, iPCount: Integer;
  206. vSL: TStringList;
  207. begin
  208. Result := nil;
  209. if AField = '' then Exit;
  210. iECount := ArrayElementCount(AField);
  211. if iECount = 0 then Exit;
  212. iPCount := ArrayElementPropertyCount(ArrayElementText(AField, 1));
  213. SetLength(FOVArr, iECount, iPCount);
  214. vSL := TStringList.Create;
  215. try
  216. for i := 1 to iECount do
  217. begin
  218. sText := ArrayElementText(AField, i);
  219. vSL.Clear;
  220. while Length(sText) > 0 do
  221. begin
  222. iPos := POS(':"', sText);
  223. iCur := iPos + 2;
  224. iPos := iCur;
  225. while (sText[iCur] <> '"') do
  226. Inc(iCur);
  227. vSL.Add(Transfer(Copy(sText, iPos, iCur - iPos)));
  228. iCur := iCur + 2;
  229. sText := Copy(sText, iCur, Length(sText) - iCur + 1);
  230. end;
  231. for j := 0 to vSL.Count - 1 do
  232. begin
  233. FOVArr[i - 1, j] := vSL[j];
  234. end;
  235. end;
  236. finally
  237. vSL.Free;
  238. end;
  239. Result := FOVArr;
  240. end;
  241. procedure TCslJson.ValueStrings(AField: string; var AValue: TStrings);
  242. var
  243. sText: string;
  244. i, iECount: Integer;
  245. vSL: TStringList;
  246. begin
  247. AValue.Clear;
  248. if AField = '' then Exit;
  249. iECount := ArrayElementCount(AField);
  250. if iECount = 0 then Exit;
  251. for i := 1 to iECount do
  252. AValue.Add(ArrayElementText(AField, i));
  253. end;
  254. end.