\u6b64\u4ee3\u7801\u652f\u6301 Delphi 2007+\uff0c\u4f7f\u7528 QJSON \u505a\u4e3a\u5e8f\u5217\u5316\u7684\u652f\u6301\u5e93\u3002\u4f60\u53ef\u4ee5\u81ea\u5df1\u6539\u4e3a\u4f7f\u7528\u5176\u5b83\u7684 JSON\u5e93\uff08\u6ce8\uff1a\u6b64\u6587\u5199\u6cd5\u672a\u5b8c\u5584\uff0c\u4ec5\u4e3a\u793a\u610f\uff09\u3002<\/p>\n\n\n\n
uses typinfo, qjson, qstring;\n\ntype\n TComponentJsonHelper = class helper for TComponent\n protected\n procedure DoSaveToJson(AStream: TStream; AJson: TQJson);\n procedure DoLoadFromJson(AParent: TComponent; AJson: TQJson;\n ALoaded: TList);\n public\n procedure SaveToJson(AJson: TQJson);\n procedure LoadFromJson(AJson: TQJson);\n end;\n{ TComponentJsonHelper }\n\nprocedure TComponentJsonHelper.LoadFromJson(AJson: TQJson);\nvar\n ALoaded: TList;\n I: Integer;\nbegin\n ALoaded := TList.Create;\n GlobalNameSpace.BeginWrite;\n try\n DoLoadFromJson(nil, AJson, ALoaded);\n for I := 0 to ALoaded.Count - 1 do\n TComponent(ALoaded[I]).Loaded;\n Loaded;\n finally\n GlobalNameSpace.EndWrite;\n end;\nend;\n\nprocedure TComponentJsonHelper.DoLoadFromJson(AParent: TComponent;\n AJson: TQJson; ALoaded: TList);\ntype\n PComponentState = ^TComponentState;\nvar\n AChildPos: Integer;\n AList: TQJson;\n ACompState: PComponentState;\n function JsonToSet(AValues: TQJson): String;\n var\n I: Integer;\n begin\n Result := '[';\n for I := 0 to AValues.Count - 1 do\n begin\n if I = 0 then\n Result := AValues[I].AsString\n else\n Result := Result + ',' + AValues[I].AsString;\n end;\n Result := Result + ']';\n end;\n function PropByPath(var Instance: TObject; APath: String): PPropInfo;\n var\n AName: String;\n APos: Integer;\n begin\n AName := DecodeTokenW(APath, '.', #0, true, true);\n Result := GetPropInfo(Instance, AName);\n if (Length(APath) > 0) then\n begin\n if (Result.PropType^.Kind = tkClass) then\n begin\n Instance := TObject(GetOrdProp(Instance, Result));\n if Assigned(Instance) then\n Result := PropByPath(Instance, APath)\n else\n Result := nil;\n end\n else\n Result := nil;\n end;\n end;\n procedure LoadProps(ARootInstance: TObject; AProps: TQJson);\n var\n I: Integer;\n AProp: PPropInfo;\n APropJson: TQJson;\n AInstance: TObject;\n begin\n if not Assigned(ARootInstance) then\n Exit;\n for I := 0 to AProps.Count - 1 do\n begin\n APropJson := AProps[I];\n AInstance := ARootInstance;\n AProp := PropByPath(AInstance, APropJson.Name);\n if Assigned(AProp) then\n begin\n case AProp.PropType^.Kind of\n tkInteger:\n SetOrdProp(AInstance, AProp, APropJson.AsInteger);\n tkChar, tkWChar:\n begin\n if APropJson.IsString then\n SetOrdProp(AInstance, AProp, Ord(PChar(APropJson.AsString)^))\n else\n SetOrdProp(AInstance, AProp, APropJson.AsInteger);\n end;\n tkEnumeration:\n SetEnumProp(AInstance, AProp, APropJson.AsString);\n tkFloat:\n SetFloatProp(AInstance, AProp, APropJson.AsFloat);\n tkString, tkLString, tkWString, tkUString:\n SetStrProp(AInstance, AProp, APropJson.AsString);\n tkSet:\n SetSetProp(AInstance, AProp, JsonToSet(APropJson));\n tkClass:\n LoadProps(Pointer(GetOrdProp(AInstance, AProp)), APropJson);\n tkVariant:\n SetVariantProp(AInstance, AProp, APropJson.AsVariant);\n \/\/ tkArray,tkDynArray,tkRecord, tkInterface,tkClassRef,tkPointer, tkProcedure\n tkInt64:\n SetInt64Prop(AInstance, AProp, APropJson.AsInt64);\n end;\n end;\n end;\n end;\n\n procedure LoadChildren(AObjects: TQJson);\n var\n I: Integer;\n AChildComp: TComponent;\n AClass: TClass;\n AClassName: String;\n begin\n for I := 0 to AObjects.Count - 1 do\n begin\n AClassName := AObjects[I].ValueByName('ClassName', '');\n AClass := FindClass(AClassName);\n if AClass = TComponent then\n begin\n if Assigned(Owner) then\n AChildComp := TComponentClass(AClass).Create(Owner)\n else\n AChildComp := TComponentClass(AClass).Create(Self);\n AChildComp.DoLoadFromJson(Self, AObjects[I], ALoaded);\n end\n else\n raise EClassNotFound.CreateFmt('Class %s not found', [AClassName]);\n end;\n end;\n\nbegin\n ACompState := @ComponentState;\n ACompState^ := ACompState^ + [csLoading, csReading];\n try\n Name := AJson.ValueByName('Name', '');\n if AJson.HasChild('Props', AList) then\n LoadProps(Self, AList);\n if AJson.HasChild('Children', AList) then\n LoadChildren(AList);\n finally\n ACompState^ := ACompState^ - [csLoading, csReading];\n if Assigned(ALoaded) then\n ALoaded.Add(Self);\n end;\n if Assigned(AParent) then\n begin\n AChildPos := AJson.IntByName('ChildPos', -1);\n if AChildPos > 0 then\n AParent.SetChildOrder(Self, AChildPos);\n end;\nend;\n\nprocedure TComponentJsonHelper.DoSaveToJson(AStream: TStream; AJson: TQJson);\nvar\n Reader: TReader;\n ObjectName, PropName: string;\n\nprocedure ConvertValue(AItem: TQJson); forward;\n\n procedure ConvertHeader(AItem: TQJson);\n var\n ClassName: string;\n Flags: TFilerFlags;\n Position: Integer;\n begin\n Reader.ReadPrefix(Flags, Position);\n ClassName := Reader.ReadStr;\n ObjectName := Reader.ReadStr;\n AItem.Add('Name').AsString := Name;\n AItem.Add('ClassName').AsString := ClassName;\n if ffInherited in Flags then\n AItem.Add('InstanceType').AsString := 'inherited'\n else if ffInline in Flags then\n AItem.Add('InstanceType').AsString := 'inline'\n else\n AItem.Add('InstanceType').AsString := 'object';\n if ffChildPos in Flags then\n AItem.Add('ChildPos').AsInteger := Position;\n end;\n\n procedure ConvertBinary(AItem: TQJson);\n var\n Count: Integer;\n Buffer: TBytes;\n begin\n Reader.ReadValue;\n Reader.Read(Count, SizeOf(Count));\n SetLength(Buffer, Count);\n Reader.Read(Buffer, Count);\n AItem.AsBytes := Buffer;\n end;\n\nprocedure ConvertProperty(AItem: TQJson); forward;\n\n procedure ConvertValue(AItem: TQJson);\n const\n LineLength = 64;\n var\n S: String;\n begin\n case Reader.NextValue of\n vaList:\n begin\n Reader.ReadValue;\n AItem.DataType := jdtArray;\n while not Reader.EndOfList do\n ConvertValue(AItem.Add);\n end;\n vaInt8, vaInt16, vaInt32:\n AItem.AsInteger := Reader.ReadInteger;\n vaExtended, vaDouble:\n AItem.AsFloat := Reader.ReadFloat;\n vaSingle:\n AItem.AsFloat := Reader.ReadSingle;\n vaCurrency:\n AItem.AsFloat := Reader.ReadCurrency;\n vaDate:\n AItem.AsDateTime := Reader.ReadDate;\n vaWString, vaUTF8String, vaString, vaLString:\n AItem.AsString := Reader.ReadString;\n vaIdent:\n AItem.AsString := Reader.ReadIdent;\n vaFalse:\n AItem.AsBoolean := False;\n vaTrue:\n AItem.AsBoolean := true;\n vaNil, vaNull:\n AItem.ResetNull;\n vaBinary:\n ConvertBinary(AItem);\n vaSet:\n begin\n Reader.ReadValue;\n AItem.DataType := jdtArray;\n while true do\n begin\n S := Reader.ReadStr;\n if S = '' then\n Break;\n AItem.Add.AsString := S;\n end;\n end;\n vaCollection:\n begin\n Reader.ReadValue;\n AItem.DataType := jdtObject;\n while not Reader.EndOfList do\n begin\n with AItem.AddArray('items') do\n begin\n if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then\n ConvertValue(Add);\n end;\n Reader.CheckValue(vaList);\n while not Reader.EndOfList do\n ConvertProperty(AItem);\n end;\n Reader.ReadListEnd;\n end;\n vaInt64:\n AItem.AsInt64 := Reader.ReadInt64;\n else\n raise EReadError.CreateFmt('Can not read %s property %s',\n [ObjectName, PropName]);\n end;\n end;\n\n procedure ConvertProperty(AItem: TQJson);\n begin\n ConvertValue(AItem.Add(Reader.ReadStr));\n end;\n\n procedure ConvertObject(AItem: TQJson);\n var\n AObject, AList: TQJson;\n begin\n ConvertHeader(AItem);\n AList := AItem.Add('Props');\n while not Reader.EndOfList do\n ConvertProperty(AList);\n Reader.ReadListEnd;\n AList := AItem.Add('Children');\n AList.DataType := jdtObject;\n while not Reader.EndOfList do\n ConvertObject(AList);\n Reader.ReadListEnd;\n end;\n\nbegin\n Reader := TReader.Create(AStream, 4096);\n try\n Reader.ReadSignature;\n ConvertObject(AJson);\n finally\n Reader.Free;\n end;\nend;\n\nprocedure TComponentJsonHelper.SaveToJson(AJson: TQJson);\nvar\n AStream: TMemoryStream;\nbegin\n AStream := TMemoryStream.Create;\n try\n AStream.WriteComponent(Self);\n AStream.Position := 0;\n DoSaveToJson(AStream, AJson);\n finally\n FreeAndNil(AStream);\n end;\nend;<\/code><\/pre>\n\n\n\n\u4f7f\u7528\u793a\u4f8b\uff1a<\/p>\n\n\n\n
procedure TForm1.Button1Click(Sender: TObject);\nvar\n AJson: TQJson;\nbegin\n AJson := AcquireJson;\n try\n LabeledEdit1.SaveToJson(AJson);\n ShowMessage(AJson.AsJson);\n LabeledEdit1.EditLabel.Caption := 'Hello';\n LabeledEdit1.Text := '';\n Button2.Caption:='Json Converted';\n ShowMessage('from json');\n LabeledEdit1.LoadFromJson(AJson);\n finally\n ReleaseJson(AJson);\n end;\nend;<\/code><\/pre>\n\n\n\n\u5982\u4e0a\u9762\u7684\u793a\u4f8b\uff0c\u7531\u4e8e\u5199\u6210\u4e86 class helper\uff0c\u6240\u4ee5\u4fdd\u5b58\u5230 Json \u91cc\uff0c\u76f4\u63a5\u8c03\u7528\u7ec4\u4ef6\u5b9e\u4f8b\u7684 SaveToJson \u5c31\u53ef\u4ee5\u4e86\uff0c\u800c\u4ece Json \u4e2d\u6062\u590d\u5219\u76f4\u63a5\u8c03\u7528\u7ec4\u4ef6\u5b9e\u4f8b\u7684 LoadFromJson \u5c31\u53ef\u4ee5\u4e86\u3002<\/p>\n\n\n\n
\u4e0a\u9762\u7684\u4ee3\u7801\u52a0\u5165 C++Builder\uff0c\u7136\u540e\u53ef\u4ee5\u76f4\u63a5\u5f15\u7528\u3002<\/p>\n","protected":false},"excerpt":{"rendered":"
\u6b64\u4ee3\u7801\u652f\u6301 Delphi 2007+\uff0c\u4f7f […]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"closed","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"site-sidebar-layout":"default","site-content-layout":"","ast-site-content-layout":"default","site-content-style":"default","site-sidebar-style":"default","ast-global-header-display":"","ast-banner-title-visibility":"","ast-main-header-display":"","ast-hfb-above-header-display":"","ast-hfb-below-header-display":"","ast-hfb-mobile-header-display":"","site-post-title":"","ast-breadcrumbs-content":"","ast-featured-img":"","footer-sml-layout":"","ast-disable-related-posts":"","theme-transparent-header-meta":"","adv-header-id-meta":"","stick-header-meta":"","header-above-stick-meta":"","header-main-stick-meta":"","header-below-stick-meta":"","astra-migrate-meta-layouts":"default","ast-page-background-enabled":"default","ast-page-background-meta":{"desktop":{"background-color":"var(--ast-global-color-4)","background-image":"","background-repeat":"repeat","background-position":"center center","background-size":"auto","background-attachment":"scroll","background-type":"","background-media":"","overlay-type":"","overlay-color":"","overlay-opacity":"","overlay-gradient":""},"tablet":{"background-color":"","background-image":"","background-repeat":"repeat","background-position":"center center","background-size":"auto","background-attachment":"scroll","background-type":"","background-media":"","overlay-type":"","overlay-color":"","overlay-opacity":"","overlay-gradient":""},"mobile":{"background-color":"","background-image":"","background-repeat":"repeat","background-position":"center center","background-size":"auto","background-attachment":"scroll","background-type":"","background-media":"","overlay-type":"","overlay-color":"","overlay-opacity":"","overlay-gradient":""}},"ast-content-background-meta":{"desktop":{"background-color":"var(--ast-global-color-5)","background-image":"","background-repeat":"repeat","background-position":"center center","background-size":"auto","background-attachment":"scroll","background-type":"","background-media":"","overlay-type":"","overlay-color":"","overlay-opacity":"","overlay-gradient":""},"tablet":{"background-color":"var(--ast-global-color-5)","background-image":"","background-repeat":"repeat","background-position":"center center","background-size":"auto","background-attachment":"scroll","background-type":"","background-media":"","overlay-type":"","overlay-color":"","overlay-opacity":"","overlay-gradient":""},"mobile":{"background-color":"var(--ast-global-color-5)","background-image":"","background-repeat":"repeat","background-position":"center center","background-size":"auto","background-attachment":"scroll","background-type":"","background-media":"","overlay-type":"","overlay-color":"","overlay-opacity":"","overlay-gradient":""}},"footnotes":""},"categories":[69,8,9,603],"tags":[545,42],"class_list":["post-5283","post","type-post","status-publish","format-standard","hentry","category-c-builder","category-delphi","category-qdac","category-603","tag-dfm","tag-json"],"views":3563,"_links":{"self":[{"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts\/5283","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=5283"}],"version-history":[{"count":2,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts\/5283\/revisions"}],"predecessor-version":[{"id":5287,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts\/5283\/revisions\/5287"}],"wp:attachment":[{"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=5283"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=5283"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=5283"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}