xmlblocks.pas

Delphi XML & XPATH源代码

  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if Assigned(TreeView) and (TreeView = AComponent) then
      TreeView := nil;
  end;
end;

{ Fill the tree view with nodes corresponding to the document's nodes }
function TXBBTreeView.ProcessDocument(const Document: IDOMDocument):
  IDOMDocument;

  { Recursively add nodes to the tree while stepping through the DOM structure }
  procedure PopulateTree(Node: IDOMNode; Parent: TTreeNode);
  var
    DisplayName: string;
    Index: Integer;
    NewNode: TTreeNode;
  begin
    if not (TXBBNodeType(Node.NodeType - 1) in ShowNodes) then
      Exit;
    case Node.NodeType of
      DOCUMENT_NODE:       DisplayName := 'Document';
      TEXT_NODE,
      CDATA_SECTION_NODE,
      COMMENT_NODE:        DisplayName := Node.NodeValue;
      else                 DisplayName := Node.NodeName;
    end;
    NewNode := TreeView.Items.AddChildObject(Parent, DisplayName,
      TXBBNodePointer.Create(Node));
    { Select images based on node type }
    NewNode.ImageIndex    := Node.NodeType - 1;
    NewNode.SelectedIndex := NewNode.ImageIndex;
    if Assigned(Node.Attributes) then
      for Index := 0 to Node.Attributes.Length - 1 do
        PopulateTree(Node.Attributes.Item[Index], NewNode);
    for Index := 0 to Node.ChildNodes.Length - 1 do
      PopulateTree(Node.ChildNodes.Item[Index], NewNode);
  end;

begin
  if not Assigned(TreeView) then
    Exit;
  TreeView.Items.BeginUpdate;
  ClearTree;
  PopulateTree(Document, nil);
  TreeView.Items.EndUpdate;
  Result := Document;
end;

procedure TXBBTreeView.SetTreeView(Value: TTreeView);
begin
  ClearTree;
  FTreeView := Value;
end;

{ TXBBMemo --------------------------------------------------------------------}

{ Initialise and optionally set the memo to fill }
constructor TXBBMemo.Create(AOwner: TComponent; const Memo: TMemo = nil);
begin
  inherited Create(AOwner);
  FMemo := Memo;
end;

{ Tidy up if attached components are deleted }
procedure TXBBMemo.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if Assigned(Memo) and (Memo = AComponent) then
      Memo := nil;
  end;
end;

{ Copy the DOM as text into the memo }
function TXBBMemo.ProcessDocument(const Document: IDOMDocument): IDOMDocument;
var
  Stream: TMemoryStream;
begin
  if not Assigned(Memo) then
    Exit;
  Memo.Lines.Clear;
  Stream := TMemoryStream.Create;
  try
    (Document as IDOMPersist).SaveToStream(Stream);
    Stream.Position := 0;
    Memo.Lines.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
  Result := Document;
end;

{ TXBBStringGrid --------------------------------------------------------------}

constructor TXBBStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSingleNode := True;
end;

{ Initialise and set the string grid to fill }
constructor TXBBStringGrid.Create(AOwner: TComponent;
  const StringGrid: TStringGrid);
begin
  Create(AOwner);
  FStringGrid := StringGrid;
end;

{ Tidy up if attached components are deleted }
procedure TXBBStringGrid.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if Assigned(StringGrid) and (StringGrid = AComponent) then
      StringGrid := nil;
  end;
end;

{ Fill a string grid with values from the DOM }
function TXBBStringGrid.ProcessDocument(const Document: IDOMDocument):
  IDOMDocument;

  { Compile the text content of a node - down to one level below }
  function GetText(Node: IDOMNode): string;
  var
    Index: Integer;
  begin
    Result := Node.NodeValue;
    for Index := 0 to Node.ChildNodes.Length - 1 do
      Result := Result + Node.ChildNodes.Item[Index].NodeValue + ' ';
  end;

  { Present the DOM, i.e. the nodes beneath the document element,
    in two columns: one for the node name, one for its value }
  procedure DoSingleNode;
  var
    Element: IDOMElement;
    Node: IDOMNode;
    Index: Integer;
  begin
    with StringGrid do
    begin
      Element     := Document.DocumentElement;
      ColCount    := 2;
      RowCount    := Element.ChildNodes.Length + 1;
      FixedCols   := 0;
      FixedRows   := 1;
      Cells[0, 0] := 'Element';
      Cells[1, 0] := 'Value';
      for Index := 0 to Element.ChildNodes.Length - 1 do
      begin
        Node                := Element.ChildNodes.Item[Index];
        Cells[0, Index + 1] := Node.NodeName;
        Cells[1, Index + 1] := GetText(Node);
      end;
    end;
  end;

  { Present the DOM, i.e. the nodes beneath the document element,
    in multiple columns. This assumes that the document element
    contains multiple instances of the same type of element.
    Each row is then one of these elements, and each column is
    one of its sub-elements. }
  procedure DoMultipleNodes;
  var
    Element: IDOMElement;
    Node, Node2: IDOMNode;
    Index, Index2, Column: Integer;
    Text: string;
  begin
    with StringGrid do
    begin
      Element      := Document.DocumentElement;
      ColCount     := 2;
      RowCount     := Max(2, Element.ChildNodes.Length + 1);
      FixedCols    := 1;
      FixedRows    := 1;
      Cells[0, 0]  := '#';
      Cells[1, 0]  := '#text';
      Cells[0, 1]  := '';
      Cells[1, 1]  := '';
      ColWidths[0] := 20;
      ColWidths[1] := 20;
      for Index := 0 to Element.ChildNodes.Length - 1 do
      begin
        Node := Element.ChildNodes.Item[Index];
        Rows[Index + 1].Text := '';
        Cells[0, Index + 1]  := IntToStr(Index + 1);
        for Index2 := 0 to Node.ChildNodes.Length - 1 do
        begin
          Node2 := Node.ChildNodes.Item[Index2];
          Text  := GetText(Node2);
          for Column := 1 to ColCount - 1 do
            if Node2.NodeName = Cells[Column, 0] then
              Break;
          ColCount                 := Max(ColCount, Column + 1);
          Cells[Column, 0]         := Node2.NodeName;
          Cells[Column, Index + 1] := Text;
          ColWidths[Column]        :=
            Max(20, Min(ColWidths[Column], Canvas.TextWidth(Text)));
        end;
      end;
    end;
  end;

begin
  if not Assigned(StringGrid) then
    Exit;
  if SingleNode then
    DoSingleNode
  else
    DoMultipleNodes;
  Result := Document;
end;

{ TXBBWebBrowser --------------------------------------------------------------}

{ Initialise and set the Web browser to write to }
constructor TXBBWebBrowser.Create(AOwner: TComponent;
  const WebBrowser: TWebBrowser);
begin
  Create(AOwner);
  FWebBrowser := WebBrowser;
end;

{ Tidy up if attached components are deleted }
procedure TXBBWebBrowser.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if Assigned(WebBrowser) and (WebBrowser = AComponent) then
      WebBrowser := nil;
  end;
end;

{ Copy the DOM contents into the Web browser }
function TXBBWebBrowser.ProcessDocument(const Document: IDOMDocument):
  IDOMDocument;
var
  TempStream: TMemoryStream;
  StreamAdapter: TStreamAdapter;
begin
  if not Assigned(WebBrowser) then
    Exit;
  TempStream := TMemoryStream.Create;
  try
    (Document as IDOMPersist).saveToStream(TempStream);
    TempStream.Position := 0;
    StreamAdapter := TStreamAdapter.Create(TempStream);
    if WebBrowser.Document = nil then
      WebBrowser.Navigate('about:blank');
    (WebBrowser.Document as IPersistStreamInit).Load(StreamAdapter);
  finally
    TempStream.Free;
  end;
  Result := Document;
end;

{ TXBBComponentCreate ---------------------------------------------------------}

destructor TXBBComponentCreate.Destroy;
begin
  if Assigned(FComponent) and not (csDestroying in FComponent.ComponentState) then
    FComponent.Free;
  inherited Destroy;
end;

{ Create a new component from the DOM contents }
function TXBBComponentCreate.ProcessDocument(const Document: IDOMDocument):
  IDOMDocument;
var
  Stream: TStringStream;

  { Reconstruct DFM contents from DOM nodes }
  procedure RebuildDFM(Element: IDOMElement; Stream: TStringStream;
    Indent: string);
  var
    Index: Integer;
    Name, Value: string;
    FirstCh: Char;

    { Reconstruct a binary value - segment into 64 character blocks }
    procedure RebuildBinary(Indent: string);
    var
      Index: Integer;
    begin
      Stream.WriteString(Indent + Name + ' = ' + FirstCh + #13#10);
      Indent := Indent + '  ';
      Index  := 2;
      repeat
        Stream.WriteString(Indent + Copy(Value, Index, 64) + #13#10);
        Inc(Index, 64);
      until Index > Length(Value);
    end;

    { Reconstruct a multi-line value - separate at vertical bars }
    procedure RebuildList(Indent, Header: string);
    var
      Start, Finish: Integer;
    begin
      Stream.WriteString(Indent + Name + ' =' + Header + #13#10);
      Indent := Indent + '  ';
      Start  := 2;
      Finish := 1;
      repeat
        repeat
          if Value[Finish] = '''' then
            { Skip over string values }
            repeat
              Inc(Finish);
            until Value[Finish] = '''';
          Inc(Finish);
        until (Finish > Length(Value)) or (Value[Finish] = '|');
        Stream.WriteString(Indent + Copy(Value, Start, Finish - Start) + #13#10);
        Start := Finish + 1;
      until Start > Length(Value);
    end;

  begin
    Name  := Element.GetAttribute('name');
    Value := Element.GetAttribute('value');
    if Element.NodeName = 'object' then
      Stream.WriteString(Indent + 'object ' + Name + ': ' +
        Element.GetAttribute('type') + #13#10)
    else if Element.NodeName = 'property' then
    begin
      if Value = '' then
        Value := '<';
      FirstCh := Value[1];
      case FirstCh of
        '<': Stream.WriteString(Indent + Name + ' = ' + FirstCh + #13#10);
        '{': RebuildBinary(Indent);
        '(': RebuildList(Indent, ' (');
        '|': RebuildList(Indent, '');
        else Stream.WriteString(Indent + Name + ' = ' + Value + #13#10);
      end;
    end
    else if Element.NodeName = 'item' then
    begin
      if Element.ChildNodes.Length > 0 then
        Stream.WriteString(Indent + 'item'#13#10);
    end;
    for Index := 0 to Element.ChildNodes.Length - 1 do
      if Element.ChildNodes.Item[Index].NodeType = ELEMENT_NODE then
        RebuildDFM(Element.ChildNodes.Item[Index] as IDOMElement,
          Stream, Indent + '  ');
    if Element.NodeName = 'object' then
      Stream.WriteString(Indent + 'end'#13#10)
    else if (Element.NodeName = 'property') and (FirstCh = '<') then
      Stream.WriteString(Indent + '>'#13#10)
    else if Element.NodeName = 'item' then
    begin
      if Element.ChildNodes.Length > 0 then
        Stream.WriteString(Indent + 'end'#13#10);
    end;
  end;

  { De-serialise from text to component }
  function StreamToComponent(Stream: TStream): TComponent;
  var
    MemStream: TMemoryStream;
  begin
    MemStream := TMemoryStream.Create;
    try
      Stream.Seek(0, soFromBeginning);
      ObjectTextToBinary(Stream, MemStream);
      MemStream.Seek(0, soFromBeginning);
      Result := MemStream.ReadComponent(nil);
    finally
      MemStream.Free;
    end;
  end;

begin
  FreeAndNil(FComponent);
  if Document.DocumentElement.NodeName <> 'component' then
    raise EXBBException.Create('XML document does not contain a component description');
  Stream := TStringStream.Create('');
  try
    RebuildDFM(Document.DocumentElement, Stream, '');
    FComponent := StreamToComponent(Stream);
  finally
    Stream.Free;
  end;
  Result := Document;
end;

initialization
  { Set up the default set of images for nodes in a tree view }
  DefaultNodeImages := TImageList.CreateSize(16, 16);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'DOCUMENT', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'ELEMENT_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'ATTRIBUTE_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'TEXT_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'CDATA_SECTION_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'ENTITY_REFERENCE_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'ENTITY_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'PROCESSING_INSTRUCTION_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'COMMENT_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'DOCUMENT_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'DOCUMENT_TYPE_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'DOCUMENT_FRAGMENT_NODE', clFuchsia);
  DefaultNodeImages.ResourceLoad(rtBitmap, 'NOTATION_NODE', clFuchsia);
finalization
  DefaultNodeImages.Free;
end.