mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-02 21:07:21 +01:00
+ fixes from Guenther Sebastian
This commit is contained in:
michael
parent
135990affc
commit
cb1f7d4994
@ -1,9 +1,9 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1998 (c) 1999 Sebastian Günther (sguenther@gmx.de)
|
||||
Copyright (c) 1999 Sebastian Guenther (sguenther@gmx.de)
|
||||
|
||||
Implementation of DOM document class
|
||||
Implementation of DOM level 1 interfaces
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
@ -15,7 +15,7 @@
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
more or less DOM conformant class library for FreePascal
|
||||
more or less DOM level 1 conformant class library for FreePascal
|
||||
}
|
||||
|
||||
{$MODE objfpc}
|
||||
@ -302,6 +302,7 @@ type
|
||||
|
||||
// Extensions to DOM interface:
|
||||
constructor Create; virtual;
|
||||
function CreateEntity(const data: DOMString): TDOMEntity;
|
||||
procedure SetDocumentElement(ADocumentElement: TDOMElement);
|
||||
end;
|
||||
|
||||
@ -940,6 +941,12 @@ begin
|
||||
raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
|
||||
end;
|
||||
|
||||
function TDOMDocument.CreateEntity(const data: DOMString): TDOMEntity;
|
||||
begin
|
||||
Result := TDOMEntity.Create(Self);
|
||||
Result.FNodeValue := data;
|
||||
end;
|
||||
|
||||
function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
|
||||
var
|
||||
i: Integer;
|
||||
@ -1155,9 +1162,9 @@ end;
|
||||
|
||||
constructor TDOMCDATASection.Create(AOwner: TDOMDocument);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FNodeType := CDATA_SECTION_NODE;
|
||||
FNodeName := '#cdata-section';
|
||||
inherited Create(AOwner);
|
||||
end;
|
||||
|
||||
|
||||
@ -1221,7 +1228,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-07-09 08:35:09 michael
|
||||
Revision 1.2 1999-07-09 21:05:49 michael
|
||||
+ fixes from Guenther Sebastian
|
||||
|
||||
Revision 1.1 1999/07/09 08:35:09 michael
|
||||
+ Initial implementation by Sebastian Guenther
|
||||
|
||||
}
|
||||
|
||||
@ -28,6 +28,11 @@ uses DOM, xmlread, xmlwrite;
|
||||
|
||||
type
|
||||
|
||||
{"APath" is the path and name of a value: A XML configuration file is
|
||||
hierarchical. "/" is the path delimiter, the part after the last "/"
|
||||
is the name of the value. The path components will be mapped to XML
|
||||
elements, the name will be an element attribute.}
|
||||
|
||||
TXMLConfig = class
|
||||
protected
|
||||
doc: TXMLDocument;
|
||||
@ -35,7 +40,7 @@ type
|
||||
public
|
||||
constructor Create(AFileName: String);
|
||||
destructor Destroy; override;
|
||||
procedure Flush;
|
||||
procedure Flush; // Writes the XML file
|
||||
function GetValue(APath, ADefault: String): String;
|
||||
function GetValue(APath: String; ADefault: Integer): Integer;
|
||||
function GetValue(APath: String; ADefault: Boolean): Boolean;
|
||||
@ -45,6 +50,8 @@ type
|
||||
end;
|
||||
|
||||
|
||||
// =======================================================
|
||||
|
||||
implementation
|
||||
|
||||
uses sysutils;
|
||||
@ -175,7 +182,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-07-09 08:35:09 michael
|
||||
Revision 1.2 1999-07-09 21:05:50 michael
|
||||
+ fixes from Guenther Sebastian
|
||||
|
||||
Revision 1.1 1999/07/09 08:35:09 michael
|
||||
+ Initial implementation by Sebastian Guenther
|
||||
|
||||
}
|
||||
|
||||
@ -21,11 +21,18 @@ unit xmlread;
|
||||
|
||||
interface
|
||||
|
||||
uses DOM;
|
||||
uses classes, DOM;
|
||||
|
||||
function ReadXMLFile(const AFileName: String): TXMLDocument;
|
||||
function ReadXMLFile(var f: File): TXMLDocument;
|
||||
function ReadDTDFile(var f: File): TXMLDocument;
|
||||
function ReadXMLFile(var f: TStream): TXMLDocument;
|
||||
|
||||
function ReadDTDFile(const AFileName: String): TXMLDocument;
|
||||
function ReadDTDFile(var f: File): TXMLDocument;
|
||||
function ReadDTDFile(var f: TStream): TXMLDocument;
|
||||
|
||||
|
||||
// =======================================================
|
||||
|
||||
implementation
|
||||
|
||||
@ -61,17 +68,17 @@ type
|
||||
function ExpectName: String; // [5]
|
||||
procedure ExpectAttValue(attr: TDOMAttr); // [10]
|
||||
function ExpectPubidLiteral: String; // [12]
|
||||
function ParseComment: Boolean; // [15]
|
||||
function ParseComment(AOwner: TDOMNode): Boolean; // [15]
|
||||
function ParsePI: Boolean; // [16]
|
||||
procedure ExpectProlog; // [22]
|
||||
function ParseEq: Boolean; // [25]
|
||||
procedure ExpectEq;
|
||||
procedure ParseMisc; // [27]
|
||||
procedure ParseMisc(AOwner: TDOMNode); // [27]
|
||||
function ParseMarkupDecl: Boolean; // [29]
|
||||
function ParseElement(owner: TDOMNode): Boolean; // [39]
|
||||
procedure ExpectElement(owner: TDOMNode);
|
||||
function ParseReference: Boolean; // [67]
|
||||
procedure ExpectReference;
|
||||
function ParseElement(AOwner: TDOMNode): Boolean; // [39]
|
||||
procedure ExpectElement(AOwner: TDOMNode);
|
||||
function ParseReference(AOwner: TDOMNode): Boolean; // [67]
|
||||
procedure ExpectReference(AOwner: TDOMNode);
|
||||
function ParsePEReference: Boolean; // [69]
|
||||
function ParseExternalID: Boolean; // [75]
|
||||
procedure ExpectExternalID;
|
||||
@ -85,7 +92,6 @@ type
|
||||
|
||||
procedure TXMLReader.RaiseExc(descr: String);
|
||||
begin
|
||||
WriteLn('Throwing exception: ', descr);
|
||||
raise Exception.Create('In XML reader: ' + descr);
|
||||
end;
|
||||
|
||||
@ -123,7 +129,10 @@ end;
|
||||
|
||||
function TXMLReader.CheckFor(s: PChar): Boolean;
|
||||
begin
|
||||
if buf[0] = #0 then exit(False);
|
||||
if buf[0] = #0 then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
if StrLComp(buf, s, StrLen(s)) = 0 then begin
|
||||
Inc(buf, StrLen(s));
|
||||
Result := True;
|
||||
@ -150,13 +159,15 @@ begin
|
||||
ExpectProlog;
|
||||
LastNodeBeforeDoc := doc.LastChild;
|
||||
ExpectElement(doc);
|
||||
ParseMisc;
|
||||
ParseMisc(doc);
|
||||
|
||||
{
|
||||
if buf[0] <> #0 then begin
|
||||
WriteLn('=== Unparsed: ===');
|
||||
//WriteLn(buf);
|
||||
WriteLn(StrLen(buf), ' chars');
|
||||
end;
|
||||
}
|
||||
|
||||
Result := doc;
|
||||
end;
|
||||
@ -165,8 +176,10 @@ end;
|
||||
function TXMLReader.GetName(var s: String): Boolean; // [5]
|
||||
begin
|
||||
s := '';
|
||||
if not (buf[0] in (Letter + ['_', ':'])) then
|
||||
exit(False);
|
||||
if not (buf[0] in (Letter + ['_', ':'])) then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
s := buf[0];
|
||||
Inc(buf);
|
||||
@ -196,7 +209,7 @@ begin
|
||||
Inc(buf);
|
||||
s := '';
|
||||
while not CheckFor(strdel) do
|
||||
if not ParseReference then begin
|
||||
if not ParseReference(attr) then begin
|
||||
s := s + buf[0];
|
||||
Inc(buf);
|
||||
end else begin
|
||||
@ -224,11 +237,18 @@ begin
|
||||
RaiseExc('Expected quotation marks');
|
||||
end;
|
||||
|
||||
function TXMLReader.ParseComment: Boolean; // [15]
|
||||
function TXMLReader.ParseComment(AOwner: TDOMNode): Boolean; // [15]
|
||||
var
|
||||
comment: String;
|
||||
begin
|
||||
if CheckFor('<!--') then begin
|
||||
comment := '';
|
||||
while (buf[0] <> #0) and (buf[1] <> #0) and
|
||||
((buf[0] <> '-') or (buf[1] <> '-')) do Inc(buf);
|
||||
((buf[0] <> '-') or (buf[1] <> '-')) do begin
|
||||
comment := comment + buf[0];
|
||||
Inc(buf);
|
||||
end;
|
||||
AOwner.AppendChild(doc.CreateComment(comment));
|
||||
ExpectString('-->');
|
||||
Result := True;
|
||||
end else
|
||||
@ -302,7 +322,7 @@ begin
|
||||
end;
|
||||
|
||||
// Check for "Misc*"
|
||||
ParseMisc;
|
||||
ParseMisc(doc);
|
||||
|
||||
// Check for "(doctypedecl Misc*)?"
|
||||
if CheckFor('<!DOCTYPE') then begin
|
||||
@ -318,7 +338,7 @@ begin
|
||||
ExpectString(']');
|
||||
SkipWhitespace;
|
||||
end;
|
||||
ParseMisc;
|
||||
ParseMisc(doc);
|
||||
end;
|
||||
|
||||
end;
|
||||
@ -349,11 +369,11 @@ end;
|
||||
// Parse "Misc*":
|
||||
// Misc ::= Comment | PI | S
|
||||
|
||||
procedure TXMLReader.ParseMisc; // [27]
|
||||
procedure TXMLReader.ParseMisc(AOwner: TDOMNode); // [27]
|
||||
begin
|
||||
repeat
|
||||
SkipWhitespace;
|
||||
until not (ParseComment or ParsePI);
|
||||
until not (ParseComment(AOwner) or ParsePI);
|
||||
end;
|
||||
|
||||
function TXMLReader.ParseMarkupDecl: Boolean; // [29]
|
||||
@ -397,7 +417,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
|
||||
begin
|
||||
if CheckFor('<!ELEMENT') then begin
|
||||
ExpectWhitespace;
|
||||
WriteLn('Element decl: ', ExpectName);
|
||||
ExpectName;
|
||||
ExpectWhitespace;
|
||||
|
||||
// Get contentspec [46]
|
||||
@ -500,20 +520,25 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
|
||||
end;
|
||||
|
||||
function ParseEntityDecl: Boolean; // [70]
|
||||
var
|
||||
NewEntity: TDOMEntity;
|
||||
|
||||
function ParseEntityValue: Boolean; // [9]
|
||||
var
|
||||
strdel: array[0..1] of Char;
|
||||
begin
|
||||
if (buf[0] <> '''') and (buf[0] <> '"') then exit(False);
|
||||
if (buf[0] <> '''') and (buf[0] <> '"') then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
strdel[0] := buf[0];
|
||||
strdel[1] := #0;
|
||||
Inc(buf);
|
||||
while not CheckFor(strdel) do
|
||||
if ParsePEReference then
|
||||
else if ParseReference then
|
||||
else if ParseReference(NewEntity) then
|
||||
else
|
||||
RaiseExc('Expected reference or PE reference');
|
||||
RaiseExc('Expected entity or PE reference');
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -522,7 +547,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
|
||||
ExpectWhitespace;
|
||||
if CheckFor('%') then begin // [72]
|
||||
ExpectWhitespace;
|
||||
ExpectName;
|
||||
NewEntity := doc.CreateEntity(ExpectName);
|
||||
ExpectWhitespace;
|
||||
// Get PEDef [74]
|
||||
if ParseEntityValue then
|
||||
@ -572,7 +597,8 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
|
||||
begin
|
||||
Result := False;
|
||||
while ParseElementDecl or ParseAttlistDecl or ParseEntityDecl or
|
||||
ParseNotationDecl or ParsePI or ParseComment or SkipWhitespace do Result := True;
|
||||
ParseNotationDecl or ParsePI or ParseComment(doc) or SkipWhitespace do
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TXMLReader.ProcessDTD(ABuf: PChar): TXMLDocument; // [1]
|
||||
@ -582,16 +608,18 @@ begin
|
||||
doc := TXMLDocument.Create;
|
||||
ParseMarkupDecl;
|
||||
|
||||
{
|
||||
if buf[0] <> #0 then begin
|
||||
WriteLn('=== Unparsed: ===');
|
||||
//WriteLn(buf);
|
||||
WriteLn(StrLen(buf), ' chars');
|
||||
end;
|
||||
}
|
||||
|
||||
Result := doc;
|
||||
end;
|
||||
|
||||
function TXMLReader.ParseElement(owner: TDOMNode): Boolean; // [39] [40] [44]
|
||||
function TXMLReader.ParseElement(AOwner: TDOMNode): Boolean; // [39] [40] [44]
|
||||
var
|
||||
NewElem: TDOMElement;
|
||||
|
||||
@ -616,9 +644,16 @@ var
|
||||
end;
|
||||
|
||||
function ParseCDSect: Boolean; // [18]
|
||||
var
|
||||
cdata: String;
|
||||
begin
|
||||
if CheckFor('<![CDATA[') then begin
|
||||
while not CheckFor(']]>') do Inc(buf);
|
||||
cdata := '';
|
||||
while not CheckFor(']]>') do begin
|
||||
cdata := cdata + buf[0];
|
||||
Inc(buf);
|
||||
end;
|
||||
NewElem.AppendChild(doc.CreateCDATASection(cdata));
|
||||
Result := True;
|
||||
end else
|
||||
Result := False;
|
||||
@ -635,11 +670,12 @@ begin
|
||||
if CheckFor('<') then begin
|
||||
if not GetName(name) then begin
|
||||
buf := oldpos;
|
||||
exit(False);
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
NewElem := doc.CreateElement(name);
|
||||
owner.AppendChild(NewElem);
|
||||
AOwner.AppendChild(NewElem);
|
||||
|
||||
SkipWhitespace;
|
||||
IsEmpty := False;
|
||||
@ -662,7 +698,8 @@ begin
|
||||
if not IsEmpty then begin
|
||||
// Get content
|
||||
while SkipWhitespace or ParseCharData or ParseCDSect or ParsePI or
|
||||
ParseComment or ParseElement(NewElem) or ParseReference do;
|
||||
ParseComment(NewElem) or ParseElement(NewElem) or
|
||||
ParseReference(NewElem) do;
|
||||
|
||||
// Get ETag [42]
|
||||
ExpectString('</');
|
||||
@ -676,9 +713,9 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TXMLReader.ExpectElement(owner: TDOMNode);
|
||||
procedure TXMLReader.ExpectElement(AOwner: TDOMNode);
|
||||
begin
|
||||
if not ParseElement(owner) then
|
||||
if not ParseElement(AOwner) then
|
||||
RaiseExc('Expected element');
|
||||
end;
|
||||
|
||||
@ -692,18 +729,20 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TXMLReader.ParseReference: Boolean; // [67] [68] [69]
|
||||
function TXMLReader.ParseReference(AOwner: TDOMNode): Boolean; // [67] [68]
|
||||
begin
|
||||
if (buf[0] <> '&') and (buf[0] <> '%') then exit(False);
|
||||
Inc(buf);
|
||||
ExpectName;
|
||||
if not CheckFor('&') then begin
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
AOwner.AppendChild(doc.CreateEntityReference(ExpectName));
|
||||
ExpectString(';');
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TXMLReader.ExpectReference;
|
||||
procedure TXMLReader.ExpectReference(AOwner: TDOMNode);
|
||||
begin
|
||||
if not ParseReference then
|
||||
if not ParseReference(AOwner) then
|
||||
RaiseExc('Expected reference ("&Name;" or "%Name;")');
|
||||
end;
|
||||
|
||||
@ -788,17 +827,49 @@ var
|
||||
BufSize: LongInt;
|
||||
begin
|
||||
BufSize := FileSize(f) + 1;
|
||||
if BufSize <= 1 then exit(nil);
|
||||
if BufSize <= 1 then begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
reader := TXMLReader.Create;
|
||||
GetMem(buf, BufSize);
|
||||
BlockRead(f, buf^, BufSize - 1);
|
||||
buf[BufSize - 1] := #0;
|
||||
reader := TXMLReader.Create;
|
||||
Result := reader.ProcessXML(buf);
|
||||
FreeMem(buf, BufSize);
|
||||
reader.Free;
|
||||
end;
|
||||
|
||||
function ReadXMLFile(var f: TStream): TXMLDocument;
|
||||
var
|
||||
reader: TXMLReader;
|
||||
buf: PChar;
|
||||
begin
|
||||
if f.Size = 0 then begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
GetMem(buf, f.Size + 1);
|
||||
f.Read(buf^, f.Size);
|
||||
buf[f.Size] := #0;
|
||||
reader := TXMLReader.Create;
|
||||
Result := reader.ProcessXML(buf);
|
||||
FreeMem(buf, f.Size + 1);
|
||||
reader.Free;
|
||||
end;
|
||||
|
||||
function ReadXMLFile(const AFileName: String): TXMLDocument;
|
||||
var
|
||||
stream: TFileStream;
|
||||
begin
|
||||
stream := TFileStream.Create(AFileName, fmOpenRead);
|
||||
Result := ReadXMLFile(stream);
|
||||
stream.Free;
|
||||
end;
|
||||
|
||||
|
||||
function ReadDTDFile(var f: File): TXMLDocument;
|
||||
var
|
||||
reader: TXMLReader;
|
||||
@ -806,24 +877,57 @@ var
|
||||
BufSize: LongInt;
|
||||
begin
|
||||
BufSize := FileSize(f) + 1;
|
||||
if BufSize <= 1 then exit(nil);
|
||||
if BufSize <= 1 then begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
reader := TXMLReader.Create;
|
||||
GetMem(buf, BufSize + 1);
|
||||
BlockRead(f, buf^, BufSize - 1);
|
||||
buf[BufSize - 1] := #0;
|
||||
reader := TXMLReader.Create;
|
||||
Result := reader.ProcessDTD(buf);
|
||||
FreeMem(buf, BufSize);
|
||||
reader.Free;
|
||||
end;
|
||||
|
||||
function ReadDTDFile(var f: TStream): TXMLDocument;
|
||||
var
|
||||
reader: TXMLReader;
|
||||
buf: PChar;
|
||||
begin
|
||||
if f.Size = 0 then begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
GetMem(buf, f.Size + 1);
|
||||
f.Read(buf^, f.Size);
|
||||
buf[f.Size] := #0;
|
||||
reader := TXMLReader.Create;
|
||||
Result := reader.ProcessDTD(buf);
|
||||
FreeMem(buf, f.Size + 1);
|
||||
reader.Free;
|
||||
end;
|
||||
|
||||
function ReadDTDFile(const AFileName: String): TXMLDocument;
|
||||
var
|
||||
stream: TFileStream;
|
||||
begin
|
||||
stream := TFileStream.Create(AFileName, fmOpenRead);
|
||||
Result := ReadDTDFile(stream);
|
||||
stream.Free;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-07-09 10:42:50 michael
|
||||
Revision 1.3 1999-07-09 21:05:51 michael
|
||||
+ fixes from Guenther Sebastian
|
||||
|
||||
Revision 1.2 1999/07/09 10:42:50 michael
|
||||
* Removed debug statements
|
||||
|
||||
Revision 1.1 1999/07/09 08:35:09 michael
|
||||
|
||||
@ -15,18 +15,28 @@
|
||||
**********************************************************************}
|
||||
|
||||
{$MODE objfpc}
|
||||
{$H+}
|
||||
|
||||
unit xmlwrite;
|
||||
|
||||
interface
|
||||
|
||||
uses DOM;
|
||||
uses classes, DOM;
|
||||
|
||||
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
|
||||
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
|
||||
procedure WriteXMLFile(doc: TXMLDocument; var AStream: TStream);
|
||||
|
||||
|
||||
// =======================================================
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
// -------------------------------------------------------
|
||||
// Writers for the different node types
|
||||
// -------------------------------------------------------
|
||||
|
||||
procedure WriteElement(node: TDOMNode); forward;
|
||||
procedure WriteAttribute(node: TDOMNode); forward;
|
||||
procedure WriteText(node: TDOMNode); forward;
|
||||
@ -42,9 +52,9 @@ procedure WriteNotation(node: TDOMNode); forward;
|
||||
|
||||
|
||||
type
|
||||
TWriteProc = procedure(node: TDOMNode);
|
||||
TWriteNodeProc = procedure(node: TDOMNode);
|
||||
const
|
||||
WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteProc =
|
||||
WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
|
||||
(WriteElement, WriteAttribute, WriteText, WriteCDATA, WriteEntityRef,
|
||||
WriteEntity, WritePI, WriteComment, WriteDocument, WriteDocumentType,
|
||||
WriteDocumentFragment, WriteNotation);
|
||||
@ -55,8 +65,46 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------
|
||||
// Text file and TStream support
|
||||
// -------------------------------------------------------
|
||||
|
||||
type
|
||||
TOutputProc = procedure(s: String);
|
||||
|
||||
var
|
||||
f: ^Text;
|
||||
stream: TStream;
|
||||
wrt, wrtln: TOutputProc;
|
||||
|
||||
|
||||
procedure Text_Write(s: String);
|
||||
begin
|
||||
Write(f^, s);
|
||||
end;
|
||||
|
||||
procedure Text_WriteLn(s: String);
|
||||
begin
|
||||
WriteLn(f^, s);
|
||||
end;
|
||||
|
||||
procedure Stream_Write(s: String);
|
||||
begin
|
||||
stream.WriteAnsiString(s);
|
||||
end;
|
||||
|
||||
procedure Stream_WriteLn(s: String);
|
||||
begin
|
||||
stream.WriteAnsiString(s + #10);
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------
|
||||
// Indent handling
|
||||
// -------------------------------------------------------
|
||||
|
||||
var
|
||||
|
||||
indent: String;
|
||||
|
||||
|
||||
@ -70,28 +118,34 @@ begin
|
||||
indent := Copy(indent, 1, Length(indent) - 2);
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------
|
||||
// Node writers implementations
|
||||
// -------------------------------------------------------
|
||||
|
||||
|
||||
procedure WriteElement(node: TDOMNode);
|
||||
var
|
||||
i: Integer;
|
||||
attr, child: TDOMNode;
|
||||
begin
|
||||
Write(f^, Indent, '<', node.NodeName);
|
||||
wrt(Indent + '<' + node.NodeName);
|
||||
for i := 0 to node.Attributes.Length - 1 do begin
|
||||
attr := node.Attributes.Item[i];
|
||||
Write(f^, ' ', attr.NodeName, '="', attr.NodeValue, '"');
|
||||
wrt(' ' + attr.NodeName + '="' + attr.NodeValue + '"');
|
||||
end;
|
||||
child := node.FirstChild;
|
||||
if child = nil then
|
||||
WriteLn(f^, '/>')
|
||||
wrtln('/>')
|
||||
else begin
|
||||
WriteLn(f^, '>');
|
||||
wrtln('>');
|
||||
IncIndent;
|
||||
repeat
|
||||
WriteNode(child);
|
||||
child := child.NextSibling;
|
||||
until child = nil;
|
||||
DecIndent;
|
||||
WriteLn(f^, Indent, '</', node.NodeName, '>');
|
||||
wrtln(Indent + '</' + node.NodeName + '>');
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -102,17 +156,17 @@ end;
|
||||
|
||||
procedure WriteText(node: TDOMNode);
|
||||
begin
|
||||
WriteLn('WriteText');
|
||||
wrt(node.NodeValue);
|
||||
end;
|
||||
|
||||
procedure WriteCDATA(node: TDOMNode);
|
||||
begin
|
||||
WriteLn('WriteCDATA');
|
||||
wrtln('<![CDATA[' + node.NodeValue + ']]>');
|
||||
end;
|
||||
|
||||
procedure WriteEntityRef(node: TDOMNode);
|
||||
begin
|
||||
WriteLn('WriteEntityRef');
|
||||
wrt('&' + node.NodeValue + ';');
|
||||
end;
|
||||
|
||||
procedure WriteEntity(node: TDOMNode);
|
||||
@ -127,7 +181,7 @@ end;
|
||||
|
||||
procedure WriteComment(node: TDOMNode);
|
||||
begin
|
||||
WriteLn('WriteComment');
|
||||
Write('<!--', node.NodeValue, '-->');
|
||||
end;
|
||||
|
||||
procedure WriteDocument(node: TDOMNode);
|
||||
@ -151,17 +205,16 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
|
||||
procedure RootWriter(doc: TXMLDocument);
|
||||
var
|
||||
child: TDOMNode;
|
||||
begin
|
||||
f := @AFile;
|
||||
Write(f^, '<?xml version="');
|
||||
if doc.XMLVersion <> '' then Write(f^, doc.XMLVersion)
|
||||
else Write(f^, '1.0');
|
||||
Write(f^, '"');
|
||||
if doc.Encoding <> '' then Write(f^, ' encoding="', doc.Encoding, '"');
|
||||
WriteLn(f^, '?>');
|
||||
wrt('<?xml version="');
|
||||
if doc.XMLVersion <> '' then wrt(doc.XMLVersion)
|
||||
else wrt('1.0');
|
||||
wrt('"');
|
||||
if doc.Encoding <> '' then wrt(' encoding="' + doc.Encoding + '"');
|
||||
wrtln('?>');
|
||||
|
||||
indent := '';
|
||||
|
||||
@ -173,12 +226,45 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------
|
||||
// Interface implementation
|
||||
// -------------------------------------------------------
|
||||
|
||||
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
|
||||
begin
|
||||
f := @AFile;
|
||||
wrt := @Text_Write;
|
||||
wrtln := @Text_WriteLn;
|
||||
RootWriter(doc);
|
||||
end;
|
||||
|
||||
procedure WriteXMLFile(doc: TXMLDocument; var AStream: TStream);
|
||||
begin
|
||||
stream := AStream;
|
||||
wrt := @Stream_Write;
|
||||
wrtln := @Stream_WriteLn;
|
||||
RootWriter(doc);
|
||||
end;
|
||||
|
||||
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
|
||||
var
|
||||
stream: TFileStream;
|
||||
begin
|
||||
stream := TFileStream.Create(AFileName, fmCreate);
|
||||
WriteXMLFile(doc, stream);
|
||||
stream.Free;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-07-09 08:35:09 michael
|
||||
Revision 1.2 1999-07-09 21:05:53 michael
|
||||
+ fixes from Guenther Sebastian
|
||||
|
||||
Revision 1.1 1999/07/09 08:35:09 michael
|
||||
+ Initial implementation by Sebastian Guenther
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user