Jelajahi Sumber

* TXMLConfig is now a true component

sg 24 tahun lalu
induk
melakukan
8145c87ba6
1 mengubah file dengan 112 tambahan dan 71 penghapusan
  1. 112 71
      fcl/xml/xmlcfg.pp

+ 112 - 71
fcl/xml/xmlcfg.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Component Library
     This file is part of the Free Component Library
 
 
     Implementation of TXMLConfig class
     Implementation of TXMLConfig class
-    Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
+    Copyright (c) 1999 - 2001 by Sebastian Guenther, [email protected]
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -25,7 +25,7 @@
 unit XMLCfg;
 unit XMLCfg;
 
 
 interface
 interface
-uses DOM, XMLRead, XMLWrite;
+uses Classes, DOM, XMLRead, XMLWrite;
 
 
 type
 type
 
 
@@ -34,12 +34,16 @@ type
    is the name of the value. The path components will be mapped to XML
    is the name of the value. The path components will be mapped to XML
    elements, the name will be an element attribute.}
    elements, the name will be an element attribute.}
 
 
-  TXMLConfig = class
+  TXMLConfig = class(TComponent)
+  private
+    FFilename: String;
+    procedure SetFilename(const AFilename: String);
   protected
   protected
     doc: TXMLDocument;
     doc: TXMLDocument;
-    FileName: String;
+    FModified: Boolean;
+    procedure Loaded; override;
   public
   public
-    constructor Create(const AFileName: String);
+    constructor Create(const AFilename: String);
     destructor Destroy; override;
     destructor Destroy; override;
     procedure Flush;    // Writes the XML file
     procedure Flush;    // Writes the XML file
     function  GetValue(const APath, ADefault: String): String;
     function  GetValue(const APath, ADefault: String): String;
@@ -48,6 +52,9 @@ type
     procedure SetValue(const APath, AValue: String);
     procedure SetValue(const APath, AValue: String);
     procedure SetValue(const APath: String; AValue: Integer);
     procedure SetValue(const APath: String; AValue: Integer);
     procedure SetValue(const APath: String; AValue: Boolean);
     procedure SetValue(const APath: String; AValue: Boolean);
+    property Modified: Boolean read FModified;
+  published
+    property Filename: String read FFilename write SetFilename;
   end;
   end;
 
 
 
 
@@ -58,41 +65,19 @@ implementation
 uses SysUtils;
 uses SysUtils;
 
 
 
 
-constructor TXMLConfig.Create(const AFileName: String);
-var
-  f: File;
-  cfg: TDOMElement;
+constructor TXMLConfig.Create(const AFilename: String);
 begin
 begin
-  FileName := AFileName;
-  Assign(f, AFileName);
-  {$I-}
-  Reset(f, 1);
-  {$I+}
-  if IOResult = 0 then begin
-    try
-      ReadXMLFile(doc, f);
-    except
-      on e: EXMLReadError do
-        WriteLn(StdErr, 'Warning: XML config parsing error: ', e.Message);
-    end;
-    Close(f);
-  end;
-
-  if not Assigned(doc) then
-    doc := TXMLDocument.Create;
-
-  cfg :=TDOMElement(doc.FindNode('CONFIG'));
-  if not Assigned(cfg) then begin
-    cfg := doc.CreateElement('CONFIG');
-    doc.AppendChild(cfg);
-  end;
+  inherited Create(nil);
+  SetFilename(AFilename);
 end;
 end;
 
 
 destructor TXMLConfig.Destroy;
 destructor TXMLConfig.Destroy;
 begin
 begin
-  Flush;
   if Assigned(doc) then
   if Assigned(doc) then
+  begin
+    Flush;
     doc.Free;
     doc.Free;
+  end;
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -100,35 +85,44 @@ procedure TXMLConfig.Flush;
 var
 var
   f: Text;
   f: Text;
 begin
 begin
-  Assign(f, FileName);
-  Rewrite(f);
-  WriteXMLFile(doc, f);
-  Close(f);
+  if Modified then
+  begin
+    AssignFile(f, Filename);
+    Rewrite(f);
+    try
+      WriteXMLFile(doc, f);
+    finally
+      CloseFile(f);
+    end;
+    FModified := False;
+  end;
 end;
 end;
 
 
 function TXMLConfig.GetValue(const APath, ADefault: String): String;
 function TXMLConfig.GetValue(const APath, ADefault: String): String;
 var
 var
-  node, subnode, attr: TDOMNode;
+  Node, Child, Attr: TDOMNode;
   i: Integer;
   i: Integer;
-  name, path: String;
+  NodePath: String;
 begin
 begin
-  node := doc.DocumentElement;
-  path := APath;
-  while True do begin
-    i := Pos('/', path);
-    if i = 0 then break;
-    name := Copy(path, 1, i - 1);
-    path := Copy(path, i + 1, Length(path));
-    subnode := node.FindNode(name);
-    if not Assigned(subnode) then begin
+  Node := doc.DocumentElement;
+  NodePath := APath;
+  while True do
+  begin
+    i := Pos('/', NodePath);
+    if i = 0 then
+      break;
+    Child := Node.FindNode(Copy(NodePath, 1, i - 1));
+    NodePath := Copy(NodePath, i + 1, Length(NodePath));
+    if not Assigned(Child) then
+    begin
       Result := ADefault;
       Result := ADefault;
       exit;
       exit;
     end;
     end;
-    node := subnode;
+    Node := Child;
   end;
   end;
-  attr := node.Attributes.GetNamedItem(path);
-  if Assigned(attr) then
-    Result := attr.NodeValue
+  Attr := Node.Attributes.GetNamedItem(NodePath);
+  if Assigned(Attr) then
+    Result := Attr.NodeValue
   else
   else
     Result := ADefault;
     Result := ADefault;
 end;
 end;
@@ -159,34 +153,34 @@ end;
 
 
 procedure TXMLConfig.SetValue(const APath, AValue: String);
 procedure TXMLConfig.SetValue(const APath, AValue: String);
 var
 var
-  node, subnode, attr: TDOMNode;
+  Node, Child, Attr: TDOMNode;
   i: Integer;
   i: Integer;
-  name, path: String;
+  NodeName, NodePath: String;
 begin
 begin
-  node := doc.DocumentElement;
-  path := APath;
+  Node := Doc.DocumentElement;
+  NodePath := APath;
   while True do
   while True do
   begin
   begin
-    i := Pos('/', path);
+    i := Pos('/', NodePath);
     if i = 0 then
     if i = 0 then
       break;
       break;
-    name := Copy(path, 1, i - 1);
-    path := Copy(path, i + 1, Length(path));
-    subnode := node.FindNode(name);
-    if not Assigned(subnode) then
+    NodeName := Copy(NodePath, 1, i - 1);
+    NodePath := Copy(NodePath, i + 1, Length(NodePath));
+    Child := Node.FindNode(NodeName);
+    if not Assigned(Child) then
     begin
     begin
-      subnode := doc.CreateElement(name);
-      node.AppendChild(subnode);
+      Child := Doc.CreateElement(NodeName);
+      Node.AppendChild(Child);
     end;
     end;
-    node := subnode;
+    Node := Child;
   end;
   end;
-  TDOMElement(node).SetAttribute(path, AValue);
-{  attr := node.Attributes.GetNamedItem(path);
-  if not Assigned(attr) then begin
-    attr := doc.CreateAttribute(path);
-    node.Attributes.SetNamedItem(attr);
+
+  if (not Assigned(TDOMElement(Node).GetAttributeNode(NodePath))) or
+    (TDOMElement(Node)[NodePath] <> AValue) then
+  begin
+    TDOMElement(Node)[NodePath] := AValue;
+    FModified := True;
   end;
   end;
-  attr.NodeValue := AValue;}
 end;
 end;
 
 
 procedure TXMLConfig.SetValue(const APath: String; AValue: Integer);
 procedure TXMLConfig.SetValue(const APath: String; AValue: Integer);
@@ -202,13 +196,60 @@ begin
     SetValue(APath, 'False');
     SetValue(APath, 'False');
 end;
 end;
 
 
+procedure TXMLConfig.Loaded;
+begin
+  inherited Loaded;
+  if Length(Filename) > 0 then
+    SetFilename(Filename);		// Load the XML config file
+end;
+
+procedure TXMLConfig.SetFilename(const AFilename: String);
+var
+  f: File;
+  cfg: TDOMElement;
+begin
+  FFilename := AFilename;
+
+  if csLoading in ComponentState then
+    exit;
+
+  if Assigned(doc) then
+  begin
+    Flush;
+    doc.Free;
+  end;
+
+  AssignFile(f, AFileName);
+  {$I-}
+  Reset(f, 1);
+  {$I+}
+  if IOResult = 0 then
+    try
+      ReadXMLFile(doc, f);
+    finally
+      CloseFile(f);
+    end;
+
+  if not Assigned(doc) then
+    doc := TXMLDocument.Create;
+
+  cfg :=TDOMElement(doc.FindNode('CONFIG'));
+  if not Assigned(cfg) then begin
+    cfg := doc.CreateElement('CONFIG');
+    doc.AppendChild(cfg);
+  end;
+end;
+
 
 
 end.
 end.
 
 
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1.2.1  2000-07-29 14:20:54  sg
+  Revision 1.1.2.2  2001-04-08 11:19:57  sg
+  * TXMLConfig is now a true component
+
+  Revision 1.1.2.1  2000/07/29 14:20:54  sg
   * Modified the copyright notice to remove ambiguities
   * Modified the copyright notice to remove ambiguities
 
 
   Revision 1.1  2000/07/13 06:33:49  michael
   Revision 1.1  2000/07/13 06:33:49  michael