\u5e94\u7fa4\u53cb\u7684\u8981\u6c42\uff0c\u7f16\u5199\u4e86\u4e00\u4e2a\u89e3\u6790 DFM \u6587\u4ef6\u683c\u5f0f\uff0c\u5c06\u5176\u8f6c\u6362\u4e3a JSON \u683c\u5f0f\u7684\u51fd\u6570\uff0c\u9700\u8981\u5f15\u7528 QJSON \u548c QString \u5355\u5143\u3002\u4ee3\u7801\u5206\u4eab\u7ed9\u5927\u5bb6\uff0c\u4f9b\u5927\u5bb6\u53c2\u8003\uff1a<\/p>\n
function DFM2Json(AFileName: String): TQJson;\r\nvar\r\n ADFMStream, ATemp: TMemoryStream;\r\n I: Integer;\r\n AObjNode: TQJson;\r\nconst\r\n SSpace: PWideChar = ' '#9;\r\n SColon: PWideChar = ':';\r\n SNull: WideChar = #0;\r\n function IsTextDFM(S: PAnsiChar): Boolean;\r\n begin\r\n Result := (AnsiStrLComp(S, 'object', 6) = 0) or\r\n (AnsiStrLComp(S, 'inherited', 9) = 0);\r\n end;\r\n procedure DecodeObject(ALine: PWideChar; var AObjName, AObjClass: QStringW);\r\n begin\r\n SkipUntilW(ALine, SSpace);\r\n AObjName := Trim(DecodeTokenW(ALine, SColon, SNull, True));\r\n AObjClass := Trim(ALine);\r\n end;\r\n function DecodeDFMString(S: QStringW): QStringW;\r\n var\r\n ps, pd: PWideChar;\r\n V: Int64;\r\n begin\r\n if Length(S) > 0 then\r\n begin\r\n ps := PWideChar(S);\r\n SetLength(Result, Length(S));\r\n pd := PWideChar(Result);\r\n while ps^ <> #0 do\r\n begin\r\n if ps^ = '#' then\r\n begin\r\n Inc(ps);\r\n if ParseInt(ps, V) > 0 then\r\n begin\r\n pd^ := WideChar(V);\r\n Inc(pd);\r\n end;\r\n end\r\n else if ps^ = '''' then\r\n begin\r\n Inc(ps);\r\n while ps^ <> '''' do\r\n begin\r\n pd^ := ps^;\r\n Inc(pd);\r\n Inc(ps);\r\n end;\r\n Inc(ps);\r\n end\r\n else\r\n begin\r\n break;\r\n end;\r\n end;\r\n SetLength(Result, pd - PWideChar(Result));\r\n end\r\n else\r\n Result := '';\r\n end;\r\n\r\n procedure DecodePropAndChildren(AParent: TQJson; var ps: PWideChar;\r\n AIsCollection: Boolean);\r\n var\r\n ALine, AName, AValue: QStringW;\r\n pl, pv: PWideChar;\r\n ATemp: TQJson;\r\n ACharset: Longint;\r\n AProps: TQJson;\r\n AChildren: TQJson;\r\n const\r\n SObject: PWideChar = 'object';\r\n SInline: PWideChar = 'inline';\r\n SEnd: PWideChar = 'end';\r\n SEqual: PWideChar = '=';\r\n SNull: WideChar = #0;\r\n SItem: PWideChar = 'item';\r\n SBracket: PWideChar = ')';\r\n begin\r\n AProps := AParent;\r\n AChildren := nil;\r\n repeat\r\n ALine := DecodeLineW(ps);\r\n pl := PWideChar(ALine);\r\n SkipSpaceW(pl);\r\n SkipSpaceW(ps);\r\n if StartWithW(pl, SObject, True) or StartWithW(pl, SInline, True) then\r\n begin\r\n DecodeObject(pl, AName, AValue);\r\n DecodePropAndChildren(AParent.Add(AName, jdtObject), ps, False);\r\n end\r\n else if StartWithW(pl, SEnd, True) then\r\n Exit\r\n else \/\/ Property line\r\n begin\r\n AName := Trim(DecodeTokenW(pl, SEqual, SNull, True));\r\n AValue := Trim(pl);\r\n pv := PWideChar(AValue);\r\n if (pv^ = '''') or (pv^ = '#') then\r\n begin\r\n AProps.ForcePath(AName).AsString := DecodeDFMString(AValue);\r\n end\r\n else if pv^ = '<' then\r\n begin\r\n Inc(pv);\r\n SkipSpaceW(pv);\r\n if pv^ <> '>' then\r\n begin\r\n ATemp := TQJson.Create;\r\n ATemp.DataType := jdtArray;\r\n try\r\n SkipSpaceW(ps);\r\n while StartWithW(ps, SItem, True) do\r\n begin\r\n SkipLineW(ps);\r\n DecodePropAndChildren(ATemp.Add, ps, True);\r\n end;\r\n SkipSpaceW(ps);\r\n if ps^ = '>' then\r\n SkipLineW(ps);\r\n finally\r\n if ATemp.Count > 0 then\r\n AProps.Add(AName).Assign(ATemp);\r\n FreeObject(ATemp);\r\n end;\r\n end;\r\n end\r\n else if pv^ = '(' then \/\/ Strings\r\n begin\r\n AValue := '';\r\n while ps^ <> #0 do\r\n begin\r\n ALine := Trim(DecodeLineW(ps));\r\n if Length(AValue) > 0 then\r\n AValue := AValue + SLineBreak + DecodeDFMString(ALine)\r\n else\r\n AValue := DecodeDFMString(ALine);\r\n if (ps^ = ')') or EndWithW(ALine, SBracket, True) then\r\n break;\r\n end;\r\n SkipSpaceW(ps);\r\n if ps^ = ')' then\r\n SkipLineW(ps);\r\n SkipSpaceW(ps);\r\n if Length(AValue) > 0 then\r\n AProps.ForcePath(AName).AsString := AValue;\r\n end\r\n else\r\n AProps.ForcePath(AName).Value := AValue;\r\n end;\r\n until Length(ALine) = 0;\r\n end;\r\n\r\n procedure DoConvert(AText: QStringW);\r\n var\r\n p: PWideChar;\r\n AObjectName, ARootClass: QStringW;\r\n const\r\n SObject: PWideChar = 'object ';\r\n SInherited: PWideChar = 'inherited ';\r\n begin\r\n if Length(AText) > 0 then\r\n begin\r\n p := PWideChar(AText);\r\n if StartWithW(p, SObject, True) or StartWithW(p, SInherited, True) then\r\n begin\r\n Result := TQJson.Create;\r\n try\r\n DecodeObject(PWideChar(DecodeLineW(p)), AObjectName, ARootClass);\r\n DecodePropAndChildren(Result.Add(ARootClass, jdtObject), p, False);\r\n finally\r\n if Result.Count = 0 then\r\n FreeAndNil(Result);\r\n end;\r\n end;\r\n end;\r\n end;\r\n\r\nbegin\r\n ADFMStream := TMemoryStream.Create;\r\n try\r\n ADFMStream.LoadFromFile(AFileName);\r\n if PCardinal(ADFMStream.Memory)^ = $30465054 then\r\n begin\r\n ATemp := TMemoryStream.Create;\r\n ATemp.CopyFrom(ADFMStream, 0);\r\n ATemp.Position := 0;\r\n ADFMStream.Size := 0;\r\n ObjectBinaryToText(ATemp, ADFMStream);\r\n FreeAndNil(ATemp);\r\n ADFMStream.Position := 0;\r\n DoConvert(LoadTextW(ADFMStream));\r\n end\r\n else if IsTextDFM(ADFMStream.Memory) then\r\n DoConvert(LoadTextW(ADFMStream));\r\n finally\r\n FreeObject(ADFMStream);\r\n end;\r\nend;<\/pre>\n\u7528\u6cd5\uff1a<\/p>\n
procedure TForm1.Button1Click(Sender: TObject);\r\nvar\r\n AJson: TQJson;\r\nbegin\r\n if OpenDialog1.Execute then\r\n begin\r\n AJson := DFM2Json(OpenDialog1.FileName);\r\n if AJson <> nil then\r\n begin\r\n Memo1.Lines.Text := AJson.AsString;\r\n FreeAndNil(AJson);\r\n end;\r\n end;\r\nend;<\/pre>\n\u4e00\u4e2a\u8f6c\u6362\u7ed3\u679c\u793a\u4f8b\uff1a<\/p>\n
{\r\n \"TForm1\":{\r\n \"Left\":446,\r\n \"Top\":185,\r\n \"Caption\":\"Form1\",\r\n \"ClientHeight\":394,\r\n \"ClientWidth\":545,\r\n \"Color\":\"clBtnFace\",\r\n \"Font\":{\r\n \"Charset\":\"DEFAULT_CHARSET\",\r\n \"Color\":\"clWindowText\",\r\n \"Height\":-11,\r\n \"Name\":\"Tahoma\",\r\n \"Style\":[]\r\n },\r\n \"OldCreateOrder\":false,\r\n \"PixelsPerInch\":96,\r\n \"TextHeight\":13,\r\n \"Label1\":{\r\n \"Left\":288,\r\n \"Top\":64,\r\n \"Width\":75,\r\n \"Height\":20,\r\n \"Caption\":\"\u6d4b\u8bd5LAB\",\r\n \"Font\":{\r\n \"Charset\":\"GB2312_CHARSET\",\r\n \"Color\":\"clBlue\",\r\n \"Height\":-20,\r\n \"Name\":\"\u5b8b\u4f53\",\r\n \"Style\":\"[fsBold]\"\r\n },\r\n \"ParentFont\":false\r\n },\r\n \"Edit1\":{\r\n \"Left\":16,\r\n \"Top\":56,\r\n \"Width\":169,\r\n \"Height\":29,\r\n \"Font\":{\r\n \"Charset\":\"GB2312_CHARSET\",\r\n \"Color\":\"clWindowText\",\r\n \"Height\":-21,\r\n \"Name\":\"\u5b8b\u4f53\",\r\n \"Style\":\"[fsBold]\"\r\n },\r\n \"ParentFont\":false,\r\n \"TabOrder\":0,\r\n \"Text\":\"Edit1\"\r\n }\r\n }\r\n}<\/pre>\n <\/p>\n","protected":false},"excerpt":{"rendered":"
\u5e94\u7fa4\u53cb\u7684\u8981\u6c42\uff0c\u7f16\u5199\u4e86\u4e00\u4e2a\u89e3\u6790 DFM \u6587 […]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","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,7,21],"tags":[545],"class_list":["post-3483","post","type-post","status-publish","format-standard","hentry","category-c-builder","category-delphi","category-qjson","category-misc","tag-dfm"],"views":10978,"_links":{"self":[{"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts\/3483","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=3483"}],"version-history":[{"count":8,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts\/3483\/revisions"}],"predecessor-version":[{"id":3559,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=\/wp\/v2\/posts\/3483\/revisions\/3559"}],"wp:attachment":[{"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=3483"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=3483"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/blog.qdac.cc\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=3483"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}