omnixmlproperties.pas

OmniXML源码

    if assigned(csNode) then begin
      childNode := childClass.Create(csNode);
      childNode.OwnerList := Self;
      xmlChildNodes.Add(childNode);
    end;
  until not assigned(csNode);
end; { TGpXMLList.Create }

{:Create standalone data object.
  @since   2002-12-26
}        
function TGpXMLList.CreateStandalone: TGpXMLData;
begin
  Result := xmlChildClass.Create;
end; { TGpXMLList.CreateStandalone }

{:Delete node from the list.
  @param   childNode Child node to be deleted.
}
procedure TGpXMLList.Delete(childNode: TGpXMLData);
var
  idx: integer;
begin
  idx := IndexOf(childNode);
  Assert(idx >= 0, 'Idx is <= 0 in TGpXMLList.Delete');
  if idx >= 0 then begin
    xmlNode.RemoveChild((xmlChildNodes[idx] as xmlChildClass).Node);
    xmlChildNodes.Delete(idx);
  end;
end; { TGpXMLList.Delete }

{:Destroy list.
}
destructor TGpXMLList.Destroy;
begin
  FreeAndNil(xmlChildNodes);
end; { TGpXMLList.Destroy }

{:Get idx-th child.
  @param   idx Index (0-based) of a child to be retrieved.
  @returns Child object.
}
function TGpXMLList.Get(idx: integer): TGpXMLData;
begin
  //Gp, 2002-12-26: I think this casting is not necessary as Get is only used from indexed accessors in derived classes which add this casting nevertheless
  Result := TGpXMLData(xmlChildNodes[idx]{ as xmlChildClass});
end; { TGpXMLList.Get }

{:Locate child node in the list.
  @param   childNode Child node to be located.
  @returns Index of the child node (0 based) or -1 if not found.
}
function TGpXMLList.IndexOf(childNode: TGpXMLData): integer;
var
  iChild: integer;
begin
  Result := -1;
  for iChild := 0 to Count-1 do begin
    if xmlChildNodes[iChild] = childNode then begin
      Result := iChild;
      break; //for
    end;
  end; //for
end; { TGpXMLList.IndexOf }

{ TGpXMLDoc }

{:Create a copy of the document.
  @param   doc Existing XML document object.
}
constructor TGpXMLDoc.Clone(doc: TGpXMLDoc);
begin
  Create(doc.RootTag);
  xmlXMLDoc.LoadXML(doc.XMLDoc.XML);
  CreateRootNode;
  RecreateChildren;
end; { TGpXMLDoc.Clone }

{:Create XML document object.
  @param   rootTag Name of the root tag.
}
constructor TGpXMLDoc.Create(rootTag: string);
begin
  xmlRootTag := rootTag;
  Reset;
end; { TGpXMLDoc.Create }

{:Create representation of the document that contains only persistent data.
  @since   2003-01-06
}        
function TGpXMLDoc.CreatePersistentClone: IXMLDocument;
begin
  if GetNodeAttrBool(xmlXMLDoc, CContainsVolatileAttr, false) or
     GetNodeAttrBool(xmlXMLDoc, CContainsPrivateAttr, false) then
  begin
    Result := CloneDocument(xmlXMLDoc, FilterNodes);
    Result.DocumentElement.Attributes.Clear;
  end
  else
    Result := xmlXMLDoc;
end; { TGpXMLDoc.CreatePersistentClone }

{:Create root node of the document if it doesn't already exist.
}
procedure TGpXMLDoc.CreateRootNode;
begin
  if not assigned(xmlXMLDoc.DocumentElement) then
    xmlXMLDoc.AppendChild(xmlXMLDoc.CreateElement(xmlRootTag));
  xmlNode := xmlXMLDoc.DocumentElement; 
end; { TGpXMLDoc.CreateRootNode }

function TGpXMLDoc.GetAsString: string;
var
  tmpDoc: IXMLDocument;
begin
  if GetNodeAttrBool(xmlXMLDoc, CContainsPrivateAttr, false) then
    tmpDoc := CloneDocument(xmlXMLDoc, FilterPrivateNodes)
  else
    tmpDoc := xmlXMLDoc;
  Result := XMLSaveToString(tmpDoc);
end; { TGpXMLDoc.GetAsString }

{:Return DocumentElement.
}
function TGpXMLDoc.GetXMLRoot: IXMLElement;
begin
  Result := xmlXMLDoc.DocumentElement;
end; { TGpXMLDoc.GetXMLRoot }

{:Load XML document from the persistent storage.
  @param   fileName Name of the external XML file.
  @returns False if file exists but document cannot be loaded. In that case,
           LastError property contains error message.
}
function TGpXMLDoc.LoadFromFile(const fileName: string): boolean;
begin
  xmlLastError := '';
  if not FileExists(fileName) then begin
    Reset;
    Result := true;
  end
  else begin
    try
      Result := XMLLoadFromFile(xmlXMLDoc, fileName);
      if not Result then
        xmlLastError := sXMLfileIsCorrupt;
    except
      on E: Exception do begin
        xmlLastError := E.Message;
        Result := false;
      end;
    end;
  end;
  if Result then begin
    CreateRootNode;
    RecreateChildren;
  end;
end; { TGpXMLDoc.LoadFromFile }

{$IFDEF MSWINDOWS}
{:Load XML document from the registry key.
  @param   rootKey Root registry key.
  @param   key     Registry key.
  @param   value   Registry value containing the string representation of the
                   XML document.
  @returns False if document cannot be loaded. In that case, LastError property
           contains error message.
}
function TGpXMLDoc.LoadFromRegistry(rootKey: HKEY; const key,
  value: string): boolean;
begin
  xmlLastError := '';
  try
    Result := XMLLoadFromRegistry(xmlXMLDoc, rootKey, key, value);
    if not Result then
      xmlLastError := sXMLfileIsCorrupt;
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
  if Result then begin
    CreateRootNode;
    RecreateChildren;
  end;
end; { TGpXMLDoc.LoadFromRegistry }

{:Save XML document to the registry key.
  @param   rootKey Root registry key.
  @param   key     Registry key.
  @param   value   Registry value to contain the string representation of the
                   XML document.
  @returns False if document cannot be saved. In that case, LastError property
           contains error message.
}
function TGpXMLDoc.SaveToRegistry(rootKey: HKEY; const key, value: string;
  outputFormat: TOutputFormat): boolean;
var
  tmpXMLDoc: IXMLDocument;
begin
  xmlLastError := '';
  try
    tmpXMLDoc := CreatePersistentClone;
    Result := XMLSaveToRegistry(tmpXMLDoc, rootKey, key, value, outputFormat);
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
end; { TGpXMLDoc.SaveToRegistry }
{$ENDIF}

{:Load XML document from the stream (from the current position).
  @param   stream Input stream.
  @returns False if document cannot be loaded. In that case, LastError property
           contains error message.
}
function TGpXMLDoc.LoadFromStream(stream: TStream): boolean;
begin
  xmlLastError := '';
  try
    Result := XMLLoadFromStream(xmlXMLDoc,stream);
    if not Result then
      xmlLastError := sXMLfileIsCorrupt;
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
  if Result then begin
    CreateRootNode;
    RecreateChildren;
  end;
end; { TGpXMLDoc.LoadFromStream }

{:Load XML document from the string.
  @param   dataString XML document.
  @returns False if document cannot be loaded. In that case, LastError property
           contains error message.
}
function TGpXMLDoc.LoadFromString(const dataString: string): boolean;
begin
  xmlLastError := '';
  try
    Result := XMLLoadFromString(xmlXMLDoc,dataString);
    if not Result then
      xmlLastError := sXMLfileIsCorrupt;
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
  if Result then begin
    CreateRootNode;
    RecreateChildren;
  end;
end; { TGpXMLDoc.LoadFromString }

{:Recreate owned children objects. Do-nothing. Derived classes will typically
  override this method.
}
procedure TGpXMLDoc.RecreateChildren;
begin
end; { TGpXMLDoc.RecreateChildren }

{:Reset XML document to an empty state containing only root node.
}
procedure TGpXMLDoc.Reset;
begin
  xmlXMLDoc := CreateXMLDoc;
  CreateRootNode;
  RecreateChildren;
end; { TGpXMLDoc.Reset }

{:Save XML document to the persistent storage.
  @param   fileName Name of the external XML file.
  @returns False if document cannot be saved. In that case, LastError
           property contains error message.
}
function TGpXMLDoc.SaveToFile(const fileName: string;
  outputFormat: TOutputFormat): boolean;
var
  tmpXMLDoc: IXMLDocument;
begin
  xmlLastError := '';
  try
    tmpXMLDoc := CreatePersistentClone;
    XMLSaveToFile(tmpXMLDoc, fileName, outputFormat);
    Result := true;
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
end; { TGpXMLDoc.SaveToFile}

{:Save XML document to the stream at the current position.
  @param   stream Output stream.
  @returns False if document cannot be saved. In that case, LastError
           property contains error message.
}
function TGpXMLDoc.SaveToStream(stream: TStream;
  outputFormat: TOutputFormat): boolean;
var
  tmpXMLDoc: IXMLDocument;
begin
  xmlLastError := '';
  try
    tmpXMLDoc := CreatePersistentClone;
    XMLSaveToStream(tmpXMLDoc, stream, outputFormat);
    Result := true;
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
end; { TGpXMLDoc.SaveToStream }

{:Save XML document to the string.
  @param   stream (out) XML document.
  @returns False if document cannot be saved. In that case, LastError property
           contains error message.
}
function TGpXMLDoc.SaveToString(var dataString: string;
  outputFormat: TOutputFormat): boolean;
var
  tmpXMLDoc: IXMLDocument;
begin
  xmlLastError := '';
  try
    tmpXMLDoc := CreatePersistentClone;
    dataString := XMLSaveToString(tmpXMLDoc, outputFormat);
    Result := true;
  except
    on E: Exception do begin
      xmlLastError := E.Message;
      Result := false;
    end;
  end;
end; { TGpXMLDoc.SaveToString }

procedure TGpXMLDoc.SetAsString(const Value: string);
begin
  LoadFromString(Value);
end; { TGpXMLDoc.SetAsString }

{ TGpXMLDocList }

function TGpXMLDocList.Add: TGpXMLData;
begin
  Result := xmlList.Add;
end; { TGpXMLDocList.Add }

procedure TGpXMLDocList.Clear;
begin
  xmlList.Clear;
end; { TGpXMLDocList.Clear }

function TGpXMLDocList.Count: integer;
begin
  Result := xmlList.Count;
end; { TGpXMLDocList.Count }

constructor TGpXMLDocList.Create(rootTag, listTag, childTag: string;
  childClass: TGpXMLDataClass);
begin
  xmlListTag := listTag;
  xmlChildTag := childTag;
  xmlChildClass := childClass;
  inherited Create(rootTag);
end; { TGpXMLDocList.Create }

procedure TGpXMLDocList.Delete(childNode: TGpXMLData);
begin
  xmlList.Delete(childNode);
end; { TGpXMLDocList.Delete }

destructor TGpXMLDocList.Destroy;
begin
  FreeAndNil(xmlList);
  inherited;
end; { TGpXMLDocList.Destroy }

function TGpXMLDocList.Get(idx: integer): TGpXMLData;
begin
  Result := xmlList.Get(idx);
end; { TGpXMLDocList.Get }

function TGpXMLDocList.GetNode: IXMLNode;
begin
  Result := xmlList.Node;
end; { TGpXMLDocList.GetNode }

function TGpXMLDocList.IndexOf(childNode: TGpXMLData): integer;
begin
  Result := xmlList.IndexOf(childNode);
end; { TGpXMLDocList.IndexOf }

procedure TGpXMLDocList.RecreateChildren;
begin
  FreeAndNil(xmlList);
  xmlList := TGpXMLList.Create(XMLRoot, xmlListTag, xmlChildTag, xmlChildClass);
end; { TGpXMLDocList.RecreateChildren }

end.