paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 13:39:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

* the units DOM, XMLRead and XMLWrite now compile with Delphi without

Browse Source 
modifications as well
This commit is contained in:
sg 2003-01-15 21:59:55 +00:00
parent 3967f76cdd
commit 7b1d508f3a
3 changed files with 181 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
fcl/xml/dom.pp
View File

@ -3,7 +3,7 @@
This file is part of the Free Component Library
Implementation of DOM interfaces
Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org
Copyright (c) 1999-2003 by Sebastian Guenther, sg@freepascal.org
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -38,25 +38,6 @@ uses SysUtils, Classes;
type
TDOMImplementation = class;
TDOMDocumentFragment = class;
TDOMDocument = class;
TDOMNode = class;
TDOMNodeList = class;
TDOMNamedNodeMap = class;
TDOMCharacterData = class;
TDOMAttr = class;
TDOMElement = class;
TDOMText = class;
TDOMComment = class;
TDOMCDATASection = class;
TDOMDocumentType = class;
TDOMNotation = class;
TDOMEntity = class;
TDOMEntityReference = class;
TDOMProcessingInstruction = class;
// -------------------------------------------------------
// DOMString
// -------------------------------------------------------
@ -72,7 +53,6 @@ type
// DOMException
// -------------------------------------------------------
const
// DOM Level 1 exception codes:
@ -184,6 +164,24 @@ const
type
TDOMImplementation = class;
TDOMDocumentFragment = class;
TDOMDocument = class;
TDOMNode = class;
TDOMNodeList = class;
TDOMNamedNodeMap = class;
TDOMCharacterData = class;
TDOMAttr = class;
TDOMElement = class;
TDOMText = class;
TDOMComment = class;
TDOMCDATASection = class;
TDOMDocumentType = class;
TDOMNotation = class;
TDOMEntity = class;
TDOMEntityReference = class;
TDOMProcessingInstruction = class;
TRefClass = class
protected
RefCounter: LongInt;
@ -229,10 +227,11 @@ type
function RemoveChild(OldChild: TDOMNode): TDOMNode; virtual;
function AppendChild(NewChild: TDOMNode): TDOMNode; virtual;
function HasChildNodes: Boolean; virtual;
function CloneNode(deep: Boolean): TDOMNode;
function CloneNode(deep: Boolean): TDOMNode; overload;
// Extensions to DOM interface:
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; virtual;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; virtual;
function FindNode(const ANodeName: DOMString): TDOMNode;
end;
@ -376,13 +375,13 @@ type
TXMLDocument = class(TDOMDocument)
public
// These fields are extensions to the DOM interface:
XMLVersion, Encoding, StylesheetType, StylesheetHRef: DOMString;
function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
function CreateProcessingInstruction(const target, data: DOMString):
TDOMProcessingInstruction; override;
function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
// Extensions to DOM interface:
XMLVersion, Encoding, StylesheetType, StylesheetHRef: DOMString;
end;
@ -399,7 +398,8 @@ type
constructor Create(AOwner: TDOMDocument);
public
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
property Name: DOMString read FNodeName;
property Specified: Boolean read FSpecified;
property Value: DOMString read GetNodeValue write SetNodeValue;
@ -418,7 +418,8 @@ type
constructor Create(AOwner: TDOMDocument); virtual;
public
destructor Destroy; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
property TagName: DOMString read FNodeName;
function GetAttribute(const name: DOMString): DOMString;
procedure SetAttribute(const name, value: DOMString);
@ -443,7 +444,8 @@ type
protected
constructor Create(AOwner: TDOMDocument);
public
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
function SplitText(offset: LongWord): TDOMText;
end;
@ -456,7 +458,8 @@ type
protected
constructor Create(AOwner: TDOMDocument);
public
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
end;
@ -468,7 +471,8 @@ type
protected
constructor Create(AOwner: TDOMDocument);
public
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
end;
@ -482,7 +486,8 @@ type
constructor Create(AOwner: TDOMDocument);
public
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
property Name: DOMString read FNodeName;
property Entities: TDOMNamedNodeMap read FEntities;
property Notations: TDOMNamedNodeMap read FEntities;
@ -499,7 +504,8 @@ type
constructor Create(AOwner: TDOMDocument);
public
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
overload; override;
property PublicID: DOMString read FPublicID;
property SystemID: DOMString read FSystemID;
end;
@ -936,8 +942,11 @@ var
i: Integer;
begin
for i := 0 to Count - 1 do
if Item[i].NodeName = name then
exit(Item[i]);
begin
Result := Item[i];
if Result.NodeName = name then
exit;
end;
Result := nil;
end;
@ -1501,7 +1510,11 @@ end.
{
$Log$
Revision 1.11 2002-12-11 21:06:07 sg
Revision 1.12 2003-01-15 21:59:55 sg
* the units DOM, XMLRead and XMLWrite now compile with Delphi without
modifications as well
Revision 1.11 2002/12/11 21:06:07 sg
* Small cleanups
* Replaced htmldoc unit with dom_html unit
* Added SAX parser framework and SAX HTML parser

186
fcl/xml/xmlread.pp
View File

@ -3,7 +3,7 @@
This file is part of the Free Component Library
XML reading routines.
Copyright (c) 1999-2002 by Sebastian Guenther, sg@freepascal.org
Copyright (c) 1999-2003 by Sebastian Guenther, sg@freepascal.org
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -14,8 +14,6 @@
**********************************************************************}
{$MODE objfpc}
{$H+}
unit XMLRead;
@ -29,22 +27,25 @@ type
procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: File);
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
overload;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: File); overload;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream); overload;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream;
const AFilename: String);
const AFilename: String); overload;
procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File);
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
overload;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File); overload;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream); overload;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream;
const AFilename: String);
const AFilename: String); overload;
procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File);
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
overload;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File); overload;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream); overload;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream;
const AFilename: String);
const AFilename: String); overload;
// =======================================================
@ -184,7 +185,7 @@ begin
GetMem(s2, Length(s) + 1);
StrLCopy(s2, buf, Length(s));
s3 := StrPas(s2);
FreeMem(s2, Length(s) + 1);
FreeMem(s2);
RaiseExc('Expected "' + s + '", found "' + s3 + '"');
end;
Inc(buf, Length(s));
@ -213,8 +214,6 @@ begin
end;
procedure TXMLReader.ProcessXML(ABuf: PChar; AFilename: String); // [1]
var
LastNodeBeforeDoc: TDOMNode;
begin
buf := ABuf;
BufStart := ABuf;
@ -222,20 +221,11 @@ begin
doc := TXMLReaderDocument.Create;
ExpectProlog;
LastNodeBeforeDoc := doc.LastChild;
ExpectElement(doc);
ParseMisc(doc);
if buf[0] <> #0 then
RaiseExc('Text after end of document element found');
{
if buf[0] <> #0 then begin
WriteLn('=== Unparsed: ===');
//WriteLn(buf);
WriteLn(StrLen(buf), ' chars');
end;
}
end;
procedure TXMLReader.ProcessFragment(AOwner: TDOMNode; ABuf: PChar;
@ -350,7 +340,7 @@ var
begin
if CheckFor('<?') then begin
StrLCopy(checkbuf, buf, 3);
if UpCase(StrPas(checkbuf)) = 'XML' then
if UpperCase(StrPas(checkbuf)) = 'XML' then
RaiseExc('"<?xml" processing instruction not allowed here');
ExpectName;
if SkipWhitespace then
@ -1030,13 +1020,19 @@ begin
exit;
GetMem(buf, BufSize);
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
Reader.ProcessXML(buf, Filerec(f).name);
FreeMem(buf, BufSize);
ADoc := TXMLDocument(Reader.doc);
Reader.Free;
try
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
try
Reader.ProcessXML(buf, TFileRec(f).name);
ADoc := TXMLDocument(Reader.doc);
finally
Reader.Free;
end;
finally
FreeMem(buf);
end;
end;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream;
@ -1050,13 +1046,19 @@ begin
exit;
GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
Reader.ProcessXML(buf, AFilename);
FreeMem(buf, f.Size + 1);
ADoc := TXMLDocument(Reader.doc);
Reader.Free;
try
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
try
Reader.ProcessXML(buf, AFilename);
ADoc := TXMLDocument(Reader.doc);
finally
Reader.Free;
end;
finally
FreeMem(buf);
end;
end;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
@ -1066,7 +1068,7 @@ end;
procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
var
Stream: TFileStream;
Stream: TStream;
begin
ADoc := nil;
Stream := TFileStream.Create(AFilename, fmOpenRead);
@ -1089,13 +1091,19 @@ begin
exit;
GetMem(buf, BufSize);
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
Reader.Doc := AParentNode.OwnerDocument;
Reader.ProcessFragment(AParentNode, buf, Filerec(f).name);
FreeMem(buf, BufSize);
Reader.Free;
try
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
try
Reader.Doc := AParentNode.OwnerDocument;
Reader.ProcessFragment(AParentNode, buf, TFileRec(f).name);
finally
Reader.Free;
end;
finally
FreeMem(buf);
end;
end;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream;
@ -1108,13 +1116,19 @@ begin
exit;
GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
Reader.Doc := AParentNode.OwnerDocument;
Reader.ProcessFragment(AParentNode, buf, AFilename);
FreeMem(buf, f.Size + 1);
Reader.Free;
try
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
Reader.Doc := AParentNode.OwnerDocument;
try
Reader.ProcessFragment(AParentNode, buf, AFilename);
finally
Reader.Free;
end;
finally
FreeMem(buf);
end;
end;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
@ -1124,7 +1138,7 @@ end;
procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
var
Stream: TFileStream;
Stream: TStream;
begin
Stream := TFileStream.Create(AFilename, fmOpenRead);
try
@ -1143,16 +1157,23 @@ var
begin
ADoc := nil;
BufSize := FileSize(f) + 1;
if BufSize <= 1 then exit;
if BufSize <= 1 then
exit;
GetMem(buf, BufSize + 1);
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
Reader.ProcessDTD(buf, Filerec(f).name);
FreeMem(buf, BufSize);
ADoc := TXMLDocument(Reader.doc);
Reader.Free;
GetMem(buf, BufSize);
try
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
try
Reader.ProcessDTD(buf, TFileRec(f).name);
ADoc := TXMLDocument(Reader.doc);
finally
Reader.Free;
end;
finally
FreeMem(buf);
end;
end;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream;
@ -1162,16 +1183,23 @@ var
buf: PChar;
begin
ADoc := nil;
if f.Size = 0 then exit;
if f.Size = 0 then
exit;
GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
Reader.ProcessDTD(buf, AFilename);
FreeMem(buf, f.Size + 1);
ADoc := TXMLDocument(Reader.doc);
Reader.Free;
try
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
try
Reader.ProcessDTD(buf, AFilename);
ADoc := TXMLDocument(Reader.doc);
finally
Reader.Free;
end;
finally
FreeMem(buf);
end;
end;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
@ -1181,14 +1209,14 @@ end;
procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);
var
stream: TFileStream;
Stream: TStream;
begin
ADoc := nil;
stream := TFileStream.Create(AFilename, fmOpenRead);
Stream := TFileStream.Create(AFilename, fmOpenRead);
try
ReadDTDFile(ADoc, stream, AFilename);
ReadDTDFile(ADoc, Stream, AFilename);
finally
stream.Free;
Stream.Free;
end;
end;
@ -1198,7 +1226,11 @@ end.
{
$Log$
Revision 1.7 2002-09-21 19:22:38 sg
Revision 1.8 2003-01-15 21:59:55 sg
* the units DOM, XMLRead and XMLWrite now compile with Delphi without
modifications as well
Revision 1.7 2002/09/21 19:22:38 sg
* Added procedures to process XML fragments only (e.g. for merging them
into an existing DOM document)

37
fcl/xml/xmlwrite.pp
View File

@ -3,7 +3,7 @@
This file is part of the Free Component Library
XML writing routines
Copyright (c) 1999-2002 by Sebastian Guenther, sg@freepascal.org
Copyright (c) 1999-2003 by Sebastian Guenther, sg@freepascal.org
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -17,20 +17,17 @@
unit XMLWrite;
{$MODE objfpc}
{$H+}
interface
uses Classes, DOM;
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
procedure WriteXML(Node: TDOMNode; const AFileName: String);
procedure WriteXML(Node: TDOMNode; var AFile: Text);
procedure WriteXML(Node: TDOMNode; AStream: TStream);
procedure WriteXML(Node: TDOMNode; const AFileName: String); overload;
procedure WriteXML(Node: TDOMNode; var AFile: Text); overload;
procedure WriteXML(Node: TDOMNode; AStream: TStream); overload;
// ===================================================================
@ -62,9 +59,15 @@ type
const
WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
{$IFDEF FPC}
(@WriteElement, @WriteAttribute, @WriteText, @WriteCDATA, @WriteEntityRef,
@WriteEntity, @WritePI, @WriteComment, @WriteDocument, @WriteDocumentType,
@WriteDocumentFragment, @WriteNotation);
{$ELSE}
(WriteElement, WriteAttribute, WriteText, WriteCDATA, WriteEntityRef,
WriteEntity, WritePI, WriteComment, WriteDocument, WriteDocumentType,
WriteDocumentFragment, WriteNotation);
{$ENDIF}
procedure WriteNode(node: TDOMNode);
begin
@ -99,14 +102,16 @@ end;
procedure Stream_Write(s: String);
begin
if Length(s) > 0 then
stream.Write(s[1], Length(s));
Stream.Write(s[1], Length(s));
end;
procedure Stream_WriteLn(s: String);
const
LF: Char = #10;
begin
if Length(s) > 0 then
stream.Write(s[1], Length(s));
stream.WriteByte(10);
Stream.Write(s[1], Length(s));
Stream.Write(LF, 1);
end;
@ -420,7 +425,11 @@ end.
{
$Log$
Revision 1.10 2002-11-30 16:04:34 sg
Revision 1.11 2003-01-15 21:59:55 sg
* the units DOM, XMLRead and XMLWrite now compile with Delphi without
modifications as well
Revision 1.10 2002/11/30 16:04:34 sg
* Stream parameters are not "var" anymore (stupid copy&paste bug)
Revision 1.9 2002/09/20 11:36:51 sg