unit1.pas

EmbeddedWB_D5-D2009_Version_14.67.8 最新版本,开发WEB浏览器.

    begin
      if fXmlParser.CurPartType = ptXmlProlog then
      begin
        Result := true;
        exit;
      end;
    end;
  end;

  function GetXmlTag(const TagName: string): boolean;
  begin
    Result := false;
    while fXmlParser.Scan() do
    begin
      if ((fXmlParser.CurPartType = ptStartTag)
        or (fXmlParser.CurPartType = ptEmptyTag))
        and (fXmlParser.CurName = TagName) then
      begin
        Result := true;
        Exit;
      end;
    end;
  end;

  function GetXmlData(): boolean;
  begin
    Result := false;
    while fXmlParser.Scan() do
    begin
      if ((fXmlParser.CurPartType = ptContent) or (fXmlParser.CurPartType = ptCData)) then
      begin
        Result := true;
        exit;
      end
    end;
  end;

begin
  OD := TOpenDialog.Create(Self);
  with OD do
  begin
    Title := 'Load XML file';
    Filter := 'XML files (*.xml)|*.XML';
    DefaultExt := 'xml';
  end;
  if OD.Execute then
  begin
    edtPath.Text := OD.Filename;
    Caption := 'XML creator : ' + OD.Filename;
    UpdateComponents();
    ParseInit(OD.Filename);
    try
      if not GetXmlHead() then exit;
      if not GetXmlTag('Updates') then Exit;
      if not GetXmlTag('Details') then Exit;
      if not GetXmlTag('ApplicationName') then Exit;
      if not GetXmlData() then Exit;
      edtName.Text := fXmlParser.CurContent;
      if not GetXmlTag('Author') then Exit;
      if not GetXmlData() then Exit;
      edtAuthor.Text := fXmlParser.CurContent;
      if not GetXmlTag('Company') then Exit;
      if not GetXmlData() then Exit;
      edtCompany.Text := fXmlParser.CurContent;
      if not GetXmlTag('Version') then Exit;
      if not GetXmlData() then Exit;
      edtVersion.Text := fXmlParser.CurContent;
      if not GetXmlTag('ChangeLog') then Exit;
      while GetXmlTag('Info') do
      begin
        for i := 0 to fXmlParser.CurAttr.Count - 1 do
        begin
          Node := TNvpNode(fXmlParser.CurAttr[i]);
          if Node.Name = 'Text' then
            memInfo.Lines.Add(Node.Value)
        end;
      end;
      fXmlParser.StartScan;
      i := 0;
      if not GetXmlTag('Instructions') then Exit;
      while GetXmlTag('File') do
      begin
        if (FXmlParser.CurAttr.Count > 0) then
        begin
          inc(i);
          SetAttr('Name', Container);
          stgrInst.Cells[1, i] := Container;
          SetAttr('Destination', Container);
          stgrInst.Cells[2, i] := Container;
          SetAttr('Terminate', Container);
          stgrInst.Cells[3, i] := Container;
        end;
      end;
    finally
      UpdateControls(OD.FileName);
      OD.Free;
    end;
  end;
end;

procedure Tform1.ParseInit(XmlFile: string);
begin
  fXmlParser := TXmlParser.Create;
  with fXmlParser do
  begin
    LoadFromFile(PChar(XmlFile));
    Normalize := True;
    StartScan;
  end;
end;

procedure Tform1.btnCreateXMLClick(Sender: TObject);
var
  SD: TSaveDialog;
  i: integer;
  MS: TMemoryStream;
  st: string;
  procedure WriteString(const str: string);
  begin
    if str <> '' then
      MS.Write(str[1], Length(str));
  end;
begin
  edtPath.Text := '';
  MS := TMemoryStream.Create();
  try
    WriteString('<?xml version="1.0" encoding="windows-1252"?>'#13#10);
    WriteString('<Updates>'#13#10);
    WriteString('   <Details>'#13#10);
    WriteString(#9'<ApplicationName>' + edtName.Text + '</ApplicationName>'#13#10);
    WriteString(#9'<Author>' + edtAuthor.Text + '</Author>'#13#10);
    WriteString(#9'<Company>' + edtCompany.Text + '</Company>'#13#10);
    WriteString(#9'<Version>' + edtVersion.Text + '</Version>'#13#10);
    WriteString('   </Details>'#13#10);
    WriteString('   <ChangeLog>'#13#10);
    for i := 1 to memInfo.Lines.Count - 1 do
    begin
      if cbNumerator.Checked then
        st := IntToStr(i) + '. ' + memInfo.Lines.Strings[i] + ''
      else
        st := memInfo.Lines.Strings[i] + '';
      WriteString(#9 + '<Info Text=" ' + st + '"/>' + #13#10);
    end;
    WriteString('   </ChangeLog>'#13#10);
    WriteString('   <Instructions>'#13#10);
    for i := 1 to stgrInst.RowCount - 1 do
    begin
      if stgrInst.Cells[1, 1] <> '' then
      begin
        if stgrInst.Cells[1, i] <> '' then
        begin
          if ((stgrInst.Cells[3, i] = 'yes') or (stgrInst.Cells[3, i] = 'no')) then
          begin
            WriteString(#9'<File Name=" ' + stgrInst.Cells[1, i] + '" ' +
              'Destination="' + stgrInst.Cells[2, i] + '" ' +
              'Terminate="' + stgrInst.Cells[3, i] + '"' + '/>'#13#10)
          end
          else
          begin
            MessageDlg('The Terminame field must contain "yes" or "no" only.'
              , mtError, [mbCancel], 0);
          end;
        end;
      end
      else
      begin
        MessageDlg('You must enter at least one file to update :).'
          , mtError, [mbCancel], 0);
        Exit;
      end;
    end;
    WriteString('   </Instructions>'#13#10);
    WriteString('</Updates>'#13#10);

    SD := TSaveDialog.Create(Self);
    with SD do
    begin
      Title := 'Save XML file';
      DefaultExt := 'xml';
      Filter := 'XML files (*.xml)|*.XML';
      FileName := 'Updates.xml';
      if cbOverWrite.Checked then
        Options := [ofHideReadOnly, ofEnableSizing, ofOverWritePrompt];
    end;
    if SD.Execute then
    begin
      ms.SaveToFile(SD.FileName);
      UpdateControls(SD.FileName);
      UpdateComponents();
      ShowMessage('You have ceated the proper XML file.' + #10 + #13 +
        'The file is stored in: ' + #10 + #13 + edtPath.Text + #10 + #13 +
        'Now, upload the file to the web site remote folder using ftp.');
    end;
  finally
    EmbeddedWB1.LoadFromStream(MS);
    ms.Free();
  end;
end;

procedure Tform1.SetAttr(AttrName: string; var st: string);
var
  Node: TNvpNode;
begin
  Node := FXmlParser.CurAttr.Node(AttrName);
  if Node <> nil then
    st := Node.Value;
end;

procedure Tform1.XmlScanner1CData(Sender: TObject; Content: string);
begin
  Content := StringReplace(Content, #13, ' ', [rfReplaceAll]);
  Content := StringReplace(Content, #10, '', [rfReplaceAll]);
  TreeView.Items.AddChild(CurNode, Content);
end;

procedure Tform1.XmlScanner1Comment(Sender: TObject; Comment: string);
begin
  TreeView.Items.AddChild(CurNode, 'Comment');
end;

procedure Tform1.XmlScanner1Content(Sender: TObject; Content: string);
begin
  Content := StringReplace(Content, #13, ' ', [rfReplaceAll]);
  Content := StringReplace(Content, #10, '', [rfReplaceAll]);
  TreeView.Items.AddChild(CurNode, Content);
end;

procedure Tform1.XmlScanner1DtdRead(Sender: TObject; RootElementName: string);
begin
  TreeView.Items.AddChild(CurNode, 'DTD: ' + RootElementName);
end;

procedure Tform1.XmlScanner1EmptyTag(Sender: TObject; TagName: string;
  Attributes: TAttrList);
var
  i: integer;
begin
  CurNode := TreeView.Items.AddChild(CurNode, 'Element "' + TagName + '" (Empty)');
  for i := 0 to Attributes.Count - 1 do
    TreeView.Items.AddChild(CurNode, '  * Attribute ' + Attributes.Name(i) + '=' + Attributes.Value(i));
  CurNode := CurNode.Parent;
end;

procedure Tform1.XmlScanner1EndTag(Sender: TObject; TagName: string);
begin
  if CurNode <> nil then
    CurNode := CurNode.Parent;
end;

procedure Tform1.XmlScanner1PI(Sender: TObject; Target, Content: string;
  Attributes: TAttrList);
begin
  TreeView.Items.AddChild(CurNode, 'Processing Instruction: ' + Content);
end;

procedure Tform1.XmlScanner1StartTag(Sender: TObject; TagName: string;
  Attributes: TAttrList);
var
  i: integer;
begin
  CurNode := TreeView.Items.AddChild(CurNode, 'Element "' + TagName + '"');
  for i := 0 to Attributes.Count - 1 do
    TreeView.Items.AddChild(CurNode, '  * Attribute ' + Attributes.Name(i) + '=' + Attributes.Value(i));
end;

procedure TForm1.XmlScanner1XmlProlog(Sender: TObject; XmlVersion,
  Encoding: string; Standalone: Boolean);
begin
  TreeView.Items.AddChild(CurNode, 'XML Prolog: Version=' + XmlVersion + ' Encoding=' + Encoding);
end;

procedure Tform1.Button1Click(Sender: TObject);
begin
  TreeView.FullExpand;
end;

procedure Tform1.Button2Click(Sender: TObject);
begin
  TreeView.FullCollapse;
end;

procedure Tform1.FormResize(Sender: TObject);
begin
  with stgrInst do
  begin
    ColWidths[1] := Round(100 * Self.Width / 580);
    ColWidths[2] := Round(335 * Self.Width / 580);
  end;
end;

procedure Tform1.SpeedButton3Click(Sender: TObject);
begin
  edtName.Text := '';
  edtVersion.Text := '';
  edtCompany.Text := '';
  edtAuthor.Text := '';
  HideControls();
end;

procedure Tform1.SpeedButton1Click(Sender: TObject);
begin
  memInfo.Lines.Clear;
  HideControls();
end;

procedure Tform1.SpeedButton2Click(Sender: TObject);
var
  i, j: integer;
begin
  for i := 1 to stgrInst.RowCount - 1 do
    for j := 1 to stgrInst.ColCount - 1 do
      stgrInst.Cells[j, i] := '';
  HideControls();
end;



end.