?? unit1.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -