unit1.pas

一款基于DELPHI环境的MVC框架

      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.