uxmlcommon.pas

抽象三层访问数据库示例

//节点路径形如:"aaa.bbb=XXX&filename=111|999;value=222.ccc&abc=xyz.ddd=888|777"
//1."."为路径分隔节点字符.上例中的aaa、bbb、ccc、ddd为节点名称
//2."&"后到下一个"."之前的字符为当前节点的属性匹配条件.上例中的"filename=111|999;value=222"为bbb节点的属性条件
//    其中"111|999"表示filename属性取值为111或者999都为匹配
//3.节点之后如有"="则表示其后的值为节点文本.上例中的"XXX"为bbb节点的文本条件，"888|777"为ddd节点的文本条件
//    其中"888|777"表示ddd的文本取值为888或者777都为匹配
//4.节点匹配可以即有文本值匹配，又有属性值匹配
//5.如果节点路径只有一个元素并且指定元素值时则必须在值之后加上一个"&"，如"ChileNodeName=ChileNodeValue&"

//属性匹配条件形如"filename=111|999;value=222".以分号分隔

//即"."分隔路径;"&"添加属性条件;";"分隔属性列表;"="分隔名称和值;"|"分隔值列表;
  Result := False;
  if NodePath <> '' then
    if Pos('&', NodePath) > 0 then
      Result := True
    else
      if (Pos('=', NodePath) > 0) or (Pos(';', NodePath) > 0) then
        Result := (Pos(PathDelimiter, NodePath) > 0)
      else
        Result := true;
end;

class function TXMLHelper.NodeValueEqual(XMLNode: IXMLNode;
  NodeValue: string): boolean;
var
  strSubNodeValue, strNodeValue: string;
  i: integer;
begin
  SetLastErrorInfo;
  Result := false;
  if XMLNode = nil then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('节点元素不存在。');
    exit;
  end;
  strNodeValue := GetNodeValue(XMLNode);
  for i := 0 to SubStrCount(NodeValue, '|') do
  begin
    strSubNodeValue := CopySubStr(NodeValue, i, '|');
    Result := (ParseIgnoreCase and (CompareText(strNodeValue, strSubNodeValue) = 0))
      or (strNodeValue = strSubNodeValue);
    if Result then
      break;
  end;
end;

class function TXMLHelper.NodeNameEqual(XMLNode: IXMLNode;
  NodeName: string): boolean;
var
  strNodeName: string;
  i: integer;
begin
  SetLastErrorInfo;
  Result := false;
  if XMLNode = nil then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('节点元素不存在。');
    exit;
  end;
  for i := 0 to SubStrCount(NodeName, '|') do
  begin
    strNodeName := CopySubStr(NodeName, i, '|');
    Result := (ParseIgnoreCase and (CompareText(strNodeName, VarToStrDef(XMLNode.NodeName, '')) = 0))
      or (strNodeName = VarToStrDef(XMLNode.NodeName, ''));
    if Result then
      break;
  end;
end;

class function TXMLHelper.NewXMLDocument(Version, Encoding,
  RootNodeName: string): XMLIntf.IXMLDocument;
begin
//Encoding: UTF-8|GBK|GB2312
  Result := XMLDoc.NewXMLDocument(Version);
  Result.Encoding := Encoding;
  if RootNodeName <> '' then
    Result.DocumentElement := Result.CreateNode(RootNodeName);
end;

class function TXMLHelper.XMLXSDValid(XSD, XML: WideString): boolean;
var
  SchemaDoc, XMLDocument: IXMLDOMDocument2;
  SchemaCache: IXMLDOMSchemaCollection;
  Error: IXMLDOMParseError;
begin
  SetLastErrorInfo;
  Result := false;
  try
    //加载XML
    XMLDocument := CoDOMDocument50.Create;
    XMLDocument.async := False;
    //XMLDocument.validateOnParse := true;
    if FileExists(XML) then
      XMLDocument.load(XML)
    else
      XMLDocument.loadXML(XML);
    //加载Schema
    SchemaDoc := CoDOMDocument50.Create;
    SchemaDoc.async := False;
    //SchemaDoc.validateOnParse := true;
    if FileExists(XSD) then
      SchemaDoc.load(XSD)
    else
      SchemaDoc.loadXML(XSD);
    SchemaCache := CoXMLSchemaCache50.Create;
    SchemaCache.addCollection(SchemaDoc.namespaces);
    SchemaCache.add('', SchemaDoc);
    XMLDocument.schemas := SchemaCache;
    Error := XMLDocument.validate;
    result := Error.errorCode = S_OK;
    if not result then
    begin
      SetLastErrorInfo(Error.reason);
      Exit;
    end;
  except
    on e: Exception do
    begin
      SetLastErrorInfo(e);
      Exit;
    end;
  end;
end;

class function TXMLHelper.CreateNode(XMLDocument: XMLIntf.IXMLDocument;
  const NodeName, NodeValue, Attributes: string): IXMLNode;
begin
  SetLastErrorInfo;
  if XMLDocument = nil then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('不能为无效XML实例建立新节点');
    exit;
  end;
  if NodeName = '' then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('不能建立空名称的节点');
    exit;
  end;
  Result := XMLDocument.CreateNode(NodeName);
  if NodeValue <> '' then
    Result.NodeValue := NodeValue;
  if Attributes <> '' then
    AddAttributes(Result, Attributes);
end;

class procedure TXMLHelper.AddAttributes(XMLNode: IXMLNode;
  const Attributes: string);
var
  i: integer;
  strAttName, strAttValue: string;
begin
  SetLastErrorInfo;
  if XMLNode = nil then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('不能为无效XML节点实例添加/修改属性');
    exit;
  end;
  if Attributes = '' then
    Exit;
  for i := 0 to SubStrCount(Attributes) do
  begin
    strAttName := CopySubStr(Attributes, i);
    strAttValue := CopySubStr(strAttName, 1, '=');
    strAttName := CopySubStr(strAttName, 0, '=');
    if strAttName = '' then
      Continue;
    XMLNode.Attributes[strAttName] := strAttValue;
  end;
end;

class function TXMLHelper.CreateNode(ParentNode: IXMLNode; const NodeName,
  NodeValue, Attributes: string): IXMLNode;
begin
  SetLastErrorInfo;
  if ParentNode = nil then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('不能为无效父节点实例建立新节点');
    exit;
  end;
  Result := CreateNode(ParentNode.OwnerDocument, NodeName,
    NodeValue, Attributes);
  ParentNode.ChildNodes.Add(Result);
end;

class function TXMLHelper.LoadXMLData(var XMLDocument: XMLIntf.IXMLDocument;
  XMLData: WideString; AutoCheckLastError: Boolean): boolean;
begin
  Result :=  false;
  XMLDocument := nil;
  if XMLData = '' then
  begin
    SetLastErrorInfo('空XML文件。');
    exit;
  end;
  //检查传入的是否是XML文件
  if FileExists(XMLData) then
  begin
    Result := Self.LoadXMLDocument(XMLDocument, XMLData, AutoCheckLastError);
    Exit;
  end;
  if AutoCheckLastError and not GetRaiseException then
    if GetLastErrorCode < 0 then
      exit;
  try
    XMLDocument := XMLDoc.LoadXMLData(XMLData);
    Result := true;
  except
    on e: Exception do
    begin
      XMLDocument := nil;
      SetLastErrorInfo('不能解析XML文件。'#13#10'%s', [e.Message]);
    end;
  end;
end;

class function TXMLHelper.LoadXMLDocument(var XMLDocument: XMLIntf.IXMLDocument;
  XMLFile: string; AutoCheckLastError: Boolean): boolean;
begin
  Result :=  false;
  XMLDocument := nil;
  if (XMLFile = '') or not FileExists(XMLFile) then
  begin
    SetLastErrorInfo('无效或者不存在的XML文件。');
    exit;
  end;
  if AutoCheckLastError and not GetRaiseException then
    if GetLastErrorCode < 0 then
      exit;
  try
    XMLDocument := XMLDoc.LoadXMLDocument(XMLFile);
    Result := True;
  except
    on e: Exception do
    begin
      XMLDocument := nil;
      SetLastErrorInfo('不能解析XML文件。'#13#10'%s', [e.Message]);
    end;
  end;
end;

class function TXMLHelper.AttributeEqual(XMLNode: IXMLNode; AttributeName,
  AttributeValue: string): boolean;
var
  strSubAttributeValue, strAttributeValue: string;
  i: integer;
begin
  SetLastErrorInfo;
  Result := false;
  if XMLNode = nil then
  begin
    if not GetParseIgnoreError then
      SetLastErrorInfo('节点元素不存在。');
    exit;
  end;
  if not HasAttribute(XMLNode, AttributeName) then
    exit;
  strAttributeValue := GetNodeAttributeValue(XMLNode, AttributeName);
  for i := 0 to SubStrCount(AttributeValue, '|') do
  begin
    strSubAttributeValue := CopySubStr(AttributeValue, i, '|');
    Result := (ParseIgnoreCase and (CompareText(strAttributeValue, strSubAttributeValue) = 0))
      or (strAttributeValue = strSubAttributeValue);
    if Result then
      break;
  end;
end;

class function TXMLHelper.DeleteChildNode(XMLNode: IXMLNode;
  const NodeName, NodeValue, Attributes: string): Boolean;
var
  XMLChildNode: IXMLNode;
begin
  XMLChildNode := GetChildNode(XMLNode, NodeName, NodeValue, Attributes);
  Result := XMLChildNode <> nil;
  if Result then
    XMLNode.ChildNodes.Delete(XMLNode.ChildNodes.IndexOf(XMLChildNode));
end;

class function TXMLHelper.DeleteNodeAttributes(XMLNode: IXMLNode;
  const Attributes: string): Boolean;
begin

end;

initialization
  ParseIgnoreError := true;
  ParseIgnoreCase := true;

end.