pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Less hints and warnings (mostly UTF8-UTF16 related). Cosmetic changes.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4983 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-15 23:25:07 +00:00
parent 841534c2cc
commit 0fa334b610
12 changed files with 350 additions and 299 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -1,7 +1,7 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 307 Left = 301
Height = 600 Height = 600
Top = 312 Top = 177
Width = 900 Width = 900
Caption = 'Turbo Power VisualPlanIt Demo' Caption = 'Turbo Power VisualPlanIt Demo'
ClientHeight = 580 ClientHeight = 580

2
components/tvplanit/source/laz_visualplanit.lpk
View File

@ -8,8 +8,6 @@
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="../source"/>
<OtherUnitFiles Value="../source"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>

49
components/tvplanit/source/vpbase.pas
View File

@ -105,7 +105,10 @@ type
private private
seFilePos : Longint; seFilePos : Longint;
public public
constructor CreateError(const FilePos: Longint; const Reason: string); constructor CreateError(const FilePos: Longint; const Reason: DOMString); overload;
{$IFDEF FPC}
constructor CreateError(const FilePos: Longint; const Reason: String); overload;
{$ENDIF}
property FilePos: Longint read seFilePos; property FilePos: Longint read seFilePos;
end; end;
@ -115,7 +118,10 @@ type
feLine: Longint; feLine: Longint;
feLinePos: Longint; feLinePos: Longint;
public public
constructor CreateError(const FilePos, Line, LinePos: Longint; const Reason: string); constructor CreateError(const FilePos, Line, LinePos: Longint; const Reason: DOMstring); overload;
{$IFDEF FPC}
constructor CreateError(const FilePos, Line, LinePos: Longint; const Reason: string); overload;
{$ENDIF}
property Reason : DOMString read feReason; property Reason : DOMString read feReason;
property Line: Longint read feLine; property Line: Longint read feLine;
property LinePos: Longint read feLinePos; property LinePos: Longint read feLinePos;
@ -123,7 +129,10 @@ type
EVpParserError = class(EVpFilterError) EVpParserError = class(EVpFilterError)
public public
constructor CreateError(Line, LinePos: Longint; const Reason: String); constructor CreateError(Line, LinePos: Longint; const Reason: DOMString); overload;
{$IFDEF FPC}
constructor CreateError(Line, LinePos: Longint; const Reason: String); overload;
{$ENDIF}
end; end;
{ implements the Version property with its associated design time About box } { implements the Version property with its associated design time About box }
@ -366,17 +375,30 @@ uses
{ EAdStreamError } { EAdStreamError }
constructor EVpStreamError.CreateError(const FilePos: Integer;
const Reason: DOMString);
begin
{$IFDEF FPC}
inherited Create(UTF8Encode(Reason));
{$ELSE}
inherited Create(Reason);
{$ENDIF}
seFilePos := FilePos;
end;
{$IFDEF FPC}
constructor EVpStreamError.CreateError(const FilePos: Integer; constructor EVpStreamError.CreateError(const FilePos: Integer;
const Reason: String); const Reason: String);
begin begin
inherited Create(Reason); inherited Create(Reason);
seFilePos := FilePos; seFilePos := FilePos;
end; end;
{$ENDIF}
{ EAdFilterError } { EAdFilterError }
constructor EVpFilterError.CreateError(const FilePos, Line, LinePos: Integer; constructor EVpFilterError.CreateError(const FilePos, Line, LinePos: Integer;
const Reason: string); const Reason: DOMString);
begin begin
inherited CreateError(FilePos, Reason); inherited CreateError(FilePos, Reason);
feLine := Line; feLine := Line;
@ -384,13 +406,32 @@ begin
feReason := Reason; feReason := Reason;
end; end;
{$IFDEF FPC}
constructor EVpFilterError.CreateError(const FilePos, Line, LinePos: Integer;
const Reason: String);
begin
feReason := UTF8DEcode(Reason);
inherited CreateError(FilePos, feReason);
feLine := Line;
feLinePos := LinePos;
end;
{$ENDIF}
{ EAdParserError } { EAdParserError }
constructor EVpParserError.CreateError(Line, LinePos: Integer;
const Reason: DOMString);
begin
inherited CreateError(FilePos, Line, LinePos, Reason);
end;
{$IFDEF FPC}
constructor EVpParserError.CreateError(Line, LinePos: Integer; constructor EVpParserError.CreateError(Line, LinePos: Integer;
const Reason: String); const Reason: String);
begin begin
inherited CreateError(FilePos, Line, LinePos, Reason); inherited CreateError(FilePos, Line, LinePos, Reason);
end; end;
{$ENDIF}
(*****************************************************************************) (*****************************************************************************)
{ TVpCustomControl } { TVpCustomControl }

12
components/tvplanit/source/vpcanvasutils.pas
View File

@ -149,10 +149,12 @@ type
function RGBToTColor(Red, Green, Blue: Byte): TColor; function RGBToTColor(Red, Green, Blue: Byte): TColor;
procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte); procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte);
procedure CachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray); procedure CachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray);
{
function GetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; function GetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
x, y: Integer): TColor; x, y: Integer): TColor;
procedure SetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; procedure SetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
x, y: Integer; AColor: TColor); x, y: Integer; AColor: TColor);
}
property Viewport: TRect read FViewport write FViewport; property Viewport: TRect read FViewport write FViewport;
published published
@ -307,12 +309,13 @@ procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte);
procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray); procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray);
{
function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
x, y: Integer): TColor; x, y: Integer): TColor;
procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
x, y: Integer; AColor: TColor); x, y: Integer; AColor: TColor);
}
function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
const Viewport: TRect; ARect: TRect; AString: string): Integer; const Viewport: TRect; ARect: TRect; AString: string): Integer;
@ -625,7 +628,7 @@ procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray)
begin begin
VpRotatedCanvas.CachePalette(ABitmap, PaletteEntries); VpRotatedCanvas.CachePalette(ABitmap, PaletteEntries);
end; end;
{
function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
x, y: Integer): TColor; x, y: Integer): TColor;
begin begin
@ -637,7 +640,7 @@ procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
begin begin
VpRotatedCanvas.SetBmpPixel(ABitmap, PaletteCache, x, y, AColor); VpRotatedCanvas.SetBmpPixel(ABitmap, PaletteCache, x, y, AColor);
end; end;
}
function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
const Viewport: TRect; ARect: TRect; AString: string): Integer; const Viewport: TRect; ARect: TRect; AString: string): Integer;
begin begin
@ -1257,6 +1260,7 @@ begin
GetPaletteEntries(ABitmap.Palette, 0, PaletteSize, PaletteEntries); GetPaletteEntries(ABitmap.Palette, 0, PaletteSize, PaletteEntries);
end; end;
(*
// Fast scanline based pixel access // Fast scanline based pixel access
function TVpExCanvas.GetBmpPixel(ABitmap: TBitmap; function TVpExCanvas.GetBmpPixel(ABitmap: TBitmap;
PaletteCache: TVpPaletteArray; x, y: Integer): TColor; PaletteCache: TVpPaletteArray; x, y: Integer): TColor;
@ -1437,7 +1441,7 @@ begin
end; end;
} }
end; end;
*)
{ TVpLineWrapper ************************************************************ } { TVpLineWrapper ************************************************************ }

13
components/tvplanit/source/vpcontactgridpainter.pas
View File

@ -220,13 +220,22 @@ var
TmpBmp: TBitmap; TmpBmp: TBitmap;
TmpCon: TVpContact; TmpCon: TVpContact;
Col, RecsInCol: Integer; Col, RecsInCol: Integer;
HeadRect, AddrRect, CSZRect, Phone1Rect, Phone2Rect, Phone3Rect: TRect; HeadRect: TRect;
Phone4Rect, Phone5Rect, WholeRect, CompanyRect, EMailRect: TRect; WholeRect: TRect;
TmpBmpRect: TRect; TmpBmpRect: TRect;
TextColWidth: Integer; TextColWidth: Integer;
TextXOffset: Integer; TextXOffset: Integer;
TextYOffset: Integer; TextYOffset: Integer;
oldCol1RecCount: Integer; oldCol1RecCount: Integer;
AddrRect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
CSZRect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
CompanyRect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
EMailRect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
Phone1Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
Phone2Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
Phone3Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
Phone4Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
Phone5Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
begin begin
oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount; oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount;
TVpContactGridOpener(FContactGrid).FVisibleContacts := 0; TVpContactGridOpener(FContactGrid).FVisibleContacts := 0;

5
components/tvplanit/source/vplocalize.pas
View File

@ -637,8 +637,13 @@ var
begin begin
Unused(oOwner, bSpecified); Unused(oOwner, bSpecified);
Item := TVpAttributeItem(FAttributes.Add); Item := TVpAttributeItem(FAttributes.Add);
{$IFDEF DELPHI}
Item.Name := sName; Item.Name := sName;
Item.Value := sValue; Item.Value := sValue;
{$ELSE}
Item.Name := UTF8Encode(sName);
Item.Value := UTF8Encode(sValue);
{$ENDIF}
end; end;
procedure TVpLocalization.xmlLocalizeEndElement (oOwner : TObject; procedure TVpLocalization.xmlLocalizeEndElement (oOwner : TObject;

4
components/tvplanit/source/vpmisc.pas
View File

@ -602,14 +602,14 @@ end;
function GetButtonWidth(AButton: TButton): Integer; function GetButtonWidth(AButton: TButton): Integer;
const const
MARGIN = 16; MARGIN = 24;
var var
canvas: TControlCanvas; canvas: TControlCanvas;
begin begin
canvas := TControlCanvas.Create; canvas := TControlCanvas.Create;
canvas.Control := AButton; canvas.Control := AButton;
canvas.Font.Assign(AButton.Font); canvas.Font.Assign(AButton.Font);
Result := canvas.TextWidth(AButton.Caption) + 24 * Screen.PixelsPerInch div DesignTimeDPI; Result := canvas.TextWidth(AButton.Caption) + MARGIN * Screen.PixelsPerInch div DesignTimeDPI;
end; end;
function GetRealFontHeight(AFont: TFont): Integer; function GetRealFontHeight(AFont: TFont): Integer;

4
components/tvplanit/source/vpprtprv.pas
View File

@ -343,9 +343,9 @@ begin
with Params do begin with Params do begin
Style := Style or WS_TABSTOP; Style := Style or WS_TABSTOP;
if FNeedHScroll then if FNeedHScroll then
Style := Longint (Style) or WS_HSCROLL; Style := Style or WS_HSCROLL;
if FNeedVScroll then if FNeedVScroll then
Style := Longint (Style) or WS_VSCROLL; Style := Style or WS_VSCROLL;
end; end;
end; end;

17
components/tvplanit/source/vpxbase.pas
View File

@ -55,7 +55,7 @@ type
method.} method.}
TVpMemoryStream = class(TMemoryStream) TVpMemoryStream = class(TMemoryStream)
public public
procedure SetPointer(Ptr : Pointer; Size : Longint); procedure SetPointer(Ptr: Pointer; Size: Longint);
end; end;
{$IFDEF LCL} {$IFDEF LCL}
@ -63,11 +63,10 @@ type
{$ELSE} {$ELSE}
TVpFileStream = class(TFileStream) TVpFileStream = class(TFileStream)
{$ENDIF} {$ENDIF}
FFileName : string; FFileName: string;
public public
constructor CreateEx(Mode : Word; const FileName : string); constructor CreateEx(Mode: Word; const FileName: string);
property Filename: string read FFileName;
property Filename : string read FFileName;
end; end;
{ Utility methods } { Utility methods }
@ -83,7 +82,7 @@ function VpUcs4ToWideChar(const aInChar : TVpUcs4Char;
function VpUtf16ToUcs4(aInChI, function VpUtf16ToUcs4(aInChI,
aInChII : DOMChar; aInChII : DOMChar;
var aOutCh : TVpUcs4Char; var aOutCh : TVpUcs4Char;
var aBothUsed : Boolean) : Boolean; out aBothUsed : Boolean) : Boolean;
function VpUcs4ToUtf8(aInCh : TVpUcs4Char; function VpUcs4ToUtf8(aInCh : TVpUcs4Char;
var aOutCh : TVpUtf8Char) : Boolean; var aOutCh : TVpUtf8Char) : Boolean;
function VpUtf8ToUcs4(const aInCh : TVpUtf8Char; function VpUtf8ToUcs4(const aInCh : TVpUtf8Char;
@ -120,7 +119,11 @@ uses
{== Utility methods ==================================================} {== Utility methods ==================================================}
function VpPos(const aSubStr, aString : DOMString) : Integer; function VpPos(const aSubStr, aString : DOMString) : Integer;
begin begin
{$IFDEF DELPHI}
Result := AnsiPos(aSubStr, aString); Result := AnsiPos(aSubStr, aString);
{$ELSE}
Result := Pos(aSubStr, aString);
{$ENDIF}
end; end;
{--------} {--------}
function VpRPos(const sSubStr, sTerm : DOMString) : Integer; function VpRPos(const sSubStr, sTerm : DOMString) : Integer;
@ -190,7 +193,7 @@ end;
function VpUtf16ToUcs4(aInChI, function VpUtf16ToUcs4(aInChI,
aInChII : DOMChar; aInChII : DOMChar;
var aOutCh : TVpUcs4Char; var aOutCh : TVpUcs4Char;
var aBothUsed : Boolean) : Boolean; out aBothUsed : Boolean) : Boolean;
begin begin
aBothUsed := False; aBothUsed := False;
if (aInChI < #$D800) or (aInChI > #$DFFF) then begin if (aInChI < #$D800) or (aInChI > #$DFFF) then begin

154
components/tvplanit/source/vpxchrflt.pas
View File

@ -119,32 +119,25 @@ type
TVpOutCharFilter = class(TVpBaseCharFilter) TVpOutCharFilter = class(TVpBaseCharFilter)
protected protected
FFormat : TVpStreamFormat; FFormat: TVpStreamFormat;
FSetUTF8Sig : Boolean; FSetUTF8Sig: Boolean;
protected protected
function csGetSize : LongInt; override; function csGetSize: LongInt; override;
procedure csPutUtf8Char(const aCh : TVpUcs4Char); procedure csPutUtf8Char(const aCh: TVpUcs4Char);
procedure csSetFormat(const aValue : TVpStreamFormat); override; procedure csSetFormat(const aValue: TVpStreamFormat); override;
procedure csWriteBuffer; procedure csWriteBuffer;
public public
constructor Create(aStream : TStream; const aBufSize : Longint); override; constructor Create(aStream: TStream; const aBufSize: Longint); override;
destructor Destroy; override; destructor Destroy; override;
procedure PutUCS4Char(aCh : TVpUcs4Char); procedure PutUCS4Char(aCh: TVpUcs4Char);
function PutChar(aCh1, aCh2 : DOMChar; function PutChar(aCh1, aCh2: DOMChar; out aBothUsed: Boolean): Boolean;
var aBothUsed : Boolean) : Boolean; function PutString(const aText: DOMString): Boolean;
function PutString(const aText : DOMString) : Boolean;
function Position : integer; function Position : integer;
property Format : TVpStreamFormat property Format: TVpStreamFormat read FFormat write csSetFormat;
read FFormat property WriteUTF8Signature: Boolean read FSetUTF8Sig write FSetUTF8Sig;
write csSetFormat; property Size: LongInt read csGetSize;
property WriteUTF8Signature : Boolean
read FSetUTF8Sig
write FSetUTF8Sig;
property Size : LongInt
read csGetSize;
end; end;
@ -372,12 +365,13 @@ begin
if (FBuffer[0] = #$FE) and (FBuffer[1] = #$FF) then begin if (FBuffer[0] = #$FE) and (FBuffer[1] = #$FF) then begin
FFormat := sfUTF16BE; FFormat := sfUTF16BE;
FBufPos := 2; FBufPos := 2;
end else if (FBuffer[0] = #$FF) and (FBuffer[1] = #$FE) then begin end else
if (FBuffer[0] = #$FF) and (FBuffer[1] = #$FE) then begin
FFormat := sfUTF16LE; FFormat := sfUTF16LE;
FBufPos := 2; FBufPos := 2;
end else if (FBuffer[0] = #$EF) and end else
(FBuffer[1] = #$BB) and if (FBuffer[0] = #$EF) and (FBuffer[1] = #$BB) and (FBuffer[2] = #$BF) then
(FBuffer[2] = #$BF) then begin begin
FFormat := sfUTF8; FFormat := sfUTF8;
FBufPos := 3; FBufPos := 3;
end else end else
@ -386,14 +380,14 @@ begin
FFormat := sfUTF8; FFormat := sfUTF8;
end; end;
{--------} {--------}
procedure TVpInCharFilter.csPushCharPrim(aCh : TVpUcs4Char); procedure TVpInCharFilter.csPushCharPrim(aCh: TVpUcs4Char);
begin begin
Assert(FUCS4Char = TVpUCS4Char(VpNullChar)); Assert(FUCS4Char = TVpUCS4Char(VpNullChar));
{put the char into the buffer} {put the char into the buffer}
FUCS4Char := aCh; FUCS4Char := aCh;
end; end;
{--------} {--------}
procedure TVpInCharFilter.csSetFormat(const aValue : TVpStreamFormat); procedure TVpInCharFilter.csSetFormat(const aValue: TVpStreamFormat);
begin begin
{we do not allow the UTF16 formats to be changed since they were {we do not allow the UTF16 formats to be changed since they were
well defined by the BOM at the start of the stream but all other well defined by the BOM at the start of the stream but all other
@ -404,8 +398,7 @@ begin
FFormat := aValue; FFormat := aValue;
end; end;
{--------} {--------}
procedure TVpInCharFilter.csGetChar(var aCh : TVpUcs4Char; procedure TVpInCharFilter.csGetChar(var aCh: TVpUcs4Char; var aIsLiteral: Boolean);
var aIsLiteral : Boolean);
begin begin
{get the next character; for an EOF raise an exception} {get the next character; for an EOF raise an exception}
csGetCharPrim(aCh, aIsLiteral); csGetCharPrim(aCh, aIsLiteral);
@ -419,7 +412,7 @@ begin
csAdvanceLinePos; csAdvanceLinePos;
end; end;
{--------} {--------}
function TVpInCharFilter.TryRead(const S : array of Longint) : Boolean; function TVpInCharFilter.TryRead(const S: array of Longint): Boolean;
var var
Idx : Longint; Idx : Longint;
Ch : TVpUcs4Char; Ch : TVpUcs4Char;
@ -489,10 +482,10 @@ begin
FEOF := True; FEOF := True;
end; end;
{--------} {--------}
function TVpInCharFilter.ReadChar : DOMChar; function TVpInCharFilter.ReadChar: DOMChar;
var var
Ch : TVpUCS4Char; Ch: TVpUCS4Char = 0; // to silence the compiler
IL : Boolean; IL: Boolean = false; // dto.
begin begin
if (FLastChar = '') or (FLastChar = #0) then begin // wp: added #0 if (FLastChar = '') or (FLastChar = #0) then begin // wp: added #0
csGetChar(Ch, IL); csGetChar(Ch, IL);
@ -500,8 +493,7 @@ begin
Dec(FLinePos); Dec(FLinePos);
FLastChar := Result; FLastChar := Result;
if (FUCS4Char <> TVpUCS4Char(VpNullChar)) then if (FUCS4Char <> TVpUCS4Char(VpNullChar)) then
if (Format = sfUTF16LE) or if (Format = sfUTF16LE) or (Format = sfUTF16BE) then
(Format = sfUTF16BE) then
Dec(FBufPos, 2) Dec(FBufPos, 2)
else if FBufPos > 0 then else if FBufPos > 0 then
Dec(FBufPos, 1); Dec(FBufPos, 1);
@ -526,15 +518,15 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{--------} {--------}
function TVpOutCharFilter.csGetSize : LongInt; function TVpOutCharFilter.csGetSize: LongInt;
begin begin
Result := FStream.Size + FBufPos; Result := FStream.Size + FBufPos;
end; end;
{--------} {--------}
procedure TVpOutCharFilter.csPutUtf8Char(const aCh : TVpUcs4Char); procedure TVpOutCharFilter.csPutUtf8Char(const aCh: TVpUcs4Char);
var var
UTF8 : TVpUtf8Char; UTF8: TVpUtf8Char;
i : integer; i: integer;
begin begin
if not VpUcs4ToUtf8(aCh, UTF8) then if not VpUcs4ToUtf8(aCh, UTF8) then
raise EVpStreamError.CreateError(FStream.Position, sUCS_U8ConverErr); raise EVpStreamError.CreateError(FStream.Position, sUCS_U8ConverErr);
@ -546,44 +538,50 @@ begin
end; end;
end; end;
{--------} {--------}
procedure TVpOutCharFilter.csSetFormat(const aValue : TVpStreamFormat); procedure TVpOutCharFilter.csSetFormat(const aValue: TVpStreamFormat);
var var
TooLate : Boolean; TooLate: Boolean;
begin begin
case Format of
sfUTF8:
TooLate := (FSetUTF8Sig and (Position > 3)) or ((not FSetUTF8Sig) and (Position > 0));
sfUTF16LE:
TooLate := (Position > 2);
sfUTF16BE:
TooLate := (Position > 2);
sfISO88591:
TooLate := (Position > 0);
else
TooLate := true;
end;
if not TooLate then begin
FBufPos := 0;
FFormat := aValue;
case Format of case Format of
sfUTF8 : TooLate := (FSetUTF8Sig and (Position > 3)) or sfUTF8:
((not FSetUTF8Sig) and (Position > 0)); if FSetUTF8Sig then begin
sfUTF16LE : TooLate := (Position > 2); FBuffer[0] := #$EF;
sfUTF16BE : TooLate := (Position > 2); FBuffer[1] := #$BB;
sfISO88591 : TooLate := (Position > 0); FBuffer[2] := #$BF;
FBufPos := 3;
end;
sfUTF16LE :
begin
FBuffer[0] := #$FF;
FBuffer[1] := #$FE;
FBufPos := 2;
end;
sfUTF16BE :
begin
FBuffer[0] := #$FE;
FBuffer[1] := #$FF;
FBufPos := 2;
end;
else else
TooLate := true;
end;
if not TooLate then begin
FBufPos := 0; FBufPos := 0;
FFormat := aValue;
case Format of
sfUTF8:
if FSetUTF8Sig then begin
FBuffer[0] := #$EF;
FBuffer[1] := #$BB;
FBuffer[2] := #$BF;
FBufPos := 3;
end;
sfUTF16LE : begin
FBuffer[0] := #$FF;
FBuffer[1] := #$FE;
FBufPos := 2;
end;
sfUTF16BE : begin
FBuffer[0] := #$FE;
FBuffer[1] := #$FF;
FBufPos := 2;
end;
else
FBufPos := 0;
end;
end; end;
end;
end; end;
{--------} {--------}
procedure TVpOutCharFilter.csWriteBuffer; procedure TVpOutCharFilter.csWriteBuffer;
@ -592,27 +590,27 @@ begin
FBufPos := 0; FBufPos := 0;
end; end;
{--------} {--------}
procedure TVpOutCharFilter.PutUCS4Char(aCh : TVpUcs4Char); procedure TVpOutCharFilter.PutUCS4Char(aCh: TVpUcs4Char);
begin begin
case Format of case Format of
sfUTF8 : csPutUTF8Char(aCh); sfUTF8: csPutUTF8Char(aCh);
end; end;
end; end;
{--------} {--------}
function TVpOutCharFilter.PutChar(aCh1, aCh2 : DOMChar; function TVpOutCharFilter.PutChar(aCh1, aCh2: DOMChar;
var aBothUsed : Boolean) : Boolean; out aBothUsed: Boolean): Boolean;
var var
OutCh : TVpUCS4Char; OutCh: TVpUCS4Char;
begin begin
Result := VpUTF16toUCS4(aCh1, aCh2, OutCh, aBothUsed); Result := VpUTF16toUCS4(aCh1, aCh2, OutCh, aBothUsed);
if Result then if Result then
PutUCS4Char(OutCh); PutUCS4Char(OutCh);
end; end;
{--------} {--------}
function TVpOutCharFilter.PutString(const aText : DOMString) : Boolean; function TVpOutCharFilter.PutString(const aText: DOMString): Boolean;
var var
aBothUsed : Boolean; aBothUsed: Boolean;
aLen, aPos : Integer; aLen, aPos: Integer;
begin begin
aLen := Length(aText); aLen := Length(aText);
aPos := 1; aPos := 1;
@ -630,7 +628,7 @@ begin
end; end;
end; end;
{--------} {--------}
function TVpOutCharFilter.Position : integer; function TVpOutCharFilter.Position: Integer;
begin begin
Result := FStreamPos + FBufPos; Result := FStreamPos + FBufPos;
end; end;

5
components/tvplanit/source/vpxmlds.pas
View File

@ -231,9 +231,8 @@ end;
function TVpXmlDatastore.CreateStoreNode(ADoc: TDOMDocument): TDOMNode; function TVpXmlDatastore.CreateStoreNode(ADoc: TDOMDocument): TDOMNode;
var var
L: TStrings; L: TStrings;
i, j: Integer; i: Integer;
node, prevnode: TDOMNode; node: TDOMNode;
rootnode: TDOMNode;
appending: Boolean; appending: Boolean;
{%H-}nodename: String; {%H-}nodename: String;
begin begin

380
components/tvplanit/source/vpxparsr.pas
View File

@ -182,8 +182,8 @@ type
procedure ParseXMLDeclaration; procedure ParseXMLDeclaration;
procedure PopDocument; procedure PopDocument;
procedure PushDocument; procedure PushDocument;
procedure PushString(const sVal : DOMString); procedure PushString(const sVal: DOMString);
function ReadChar(const UpdatePos : Boolean) : DOMChar; function ReadChar(const UpdatePos: Boolean): DOMChar;
procedure ReadExternalIds(bInNotation : Boolean; procedure ReadExternalIds(bInNotation : Boolean;
var sIds : StringIds); var sIds : StringIds);
function ReadLiteral(wFlags : Integer; function ReadLiteral(wFlags : Integer;
@ -377,70 +377,45 @@ type
{== TVpNotationInfo ==================================================} {== TVpNotationInfo ==================================================}
TVpNotationInfo = class(TObject) TVpNotationInfo = class(TObject)
private private
FPublicId : DOMString; FPublicId: DOMString;
FSystemId : DOMString; FSystemId: DOMString;
public public
property PublicId : DOMString property PublicId: DOMString read FPublicId write FPublicId;
read FPublicId property SystemId: DOMString read FSystemId write FSystemId;
write FPublicId;
property SystemId : DOMString
read FSystemId
write FSystemId;
end; end;
{== TVpAttributeInfo =================================================} {== TVpAttributeInfo =================================================}
TVpAttributeInfo = class(TObject) TVpAttributeInfo = class(TObject)
private private
FType : Integer; FType: Integer;
FValue : DOMString; FValue: DOMString;
FValueType : Integer; FValueType: Integer;
FEnum : DOMString; FEnum: DOMString;
FLookup : DOMString; FLookup: DOMString;
public public
property AttrType : Integer property AttrType: Integer read FType write FType;
read FType property Enum: DOMString read FEnum write FEnum;
write FType; property Lookup: DOMString read FLookup write FLookup;
property Value: DOMString read FValue write FValue;
property Enum : DOMString property ValueType: Integer read FValueType write FValueType;
read FEnum
write FEnum;
property Lookup : DOMString
read FLookup
write FLookup;
property Value : DOMString
read FValue
write FValue;
property ValueType : Integer
read FValueType
write FValueType;
end; end;
{== TVpElementInfo ===================================================} {== TVpElementInfo ===================================================}
TVpElementInfo = class(TObject) TVpElementInfo = class(TObject)
private private
FAttributeList : TStringList; FAttributeList: TStringList;
FContentType : Integer; FContentType: Integer;
FContentModel : DOMString; FContentModel: DOMString;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure SetAttribute(const sName: DOMString; oAttrInfo: TVpAttributeInfo);
procedure SetAttribute(const sName : DOMString; property AttributeList: TStringList read FAttributeList;
oAttrInfo : TVpAttributeInfo); property ContentModel: DOMString read FContentModel write FContentModel;
property ContentType: Integer read FContentType write FContentType;
property AttributeList : TStringList
read FAttributeList;
property ContentModel : DOMString
read FContentModel
write FContentModel;
property ContentType : Integer
read FContentType
write FContentType;
end; end;
{=== TVpElementInfo ==================================================} {=== TVpElementInfo ==================================================}
constructor TVpElementInfo.Create; constructor TVpElementInfo.Create;
begin begin
@ -462,20 +437,28 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{--------} {--------}
procedure TVpElementInfo.SetAttribute(const sName : DOMString; procedure TVpElementInfo.SetAttribute(const sName: DOMString;
oAttrInfo : TVpAttributeInfo); oAttrInfo: TVpAttributeInfo);
var var
wIdx : Integer; wIdx: Integer;
begin begin
if FAttributeList = nil then begin if FAttributeList = nil then begin
FAttributeList := TStringList.Create; FAttributeList := TStringList.Create;
FAttributeList.Sorted := True; FAttributeList.Sorted := True;
wIdx := -1 wIdx := -1
end else end else
{$IFDEF DELPHI}
wIdx := FAttributeList.IndexOf(sName); wIdx := FAttributeList.IndexOf(sName);
{$ELSE}
wIdx := FAttributeList.IndexOf(UTF8Encode(sName));
{$ENDIF}
if wIdx < 0 then if wIdx < 0 then
{$IFDEF DELPHI}
FAttributeList.AddObject(sName, oAttrInfo) FAttributeList.AddObject(sName, oAttrInfo)
{$ELSE}
FAttributeList.AddObject(UTF8Encode(sName), oAttrInfo)
{$ENDIF}
else begin else begin
TVpAttributeInfo(FAttributeList.Objects[wIdx]).Free; TVpAttributeInfo(FAttributeList.Objects[wIdx]).Free;
FAttributeList.Objects[wIdx] := oAttrInfo; FAttributeList.Objects[wIdx] := oAttrInfo;
@ -553,19 +536,22 @@ end;
{--------} {--------}
procedure TVpParser.CheckParamEntityNesting(const aString : DOMString); procedure TVpParser.CheckParamEntityNesting(const aString : DOMString);
var var
OpenPos : Integer; OpenPos: Integer;
ClosePos : Integer; ClosePos: Integer;
errMsg: DOMString;
begin begin
OpenPos := VpPos('(', aString); OpenPos := VpPos('(', aString);
ClosePos := VpPos(')', aString); ClosePos := VpPos(')', aString);
if (((OpenPos <> 0) and if ((OpenPos <> 0) and (ClosePos = 0)) or
(ClosePos = 0)) or ((ClosePos <> 0) and (OpenPos = 0)) then
((ClosePos <> 0) and begin
(OpenPos = 0))) then {$IFDEF DELPHI}
raise EVpParserError.CreateError (FFilter.Line, errMsg := sBadParamEntNesting + aString;
FFilter.LinePos, {$ELSE}
sBadParamEntNesting + errMsg := UTF8Decode(sBadParamEntNesting) + aString;
aString); {$ENDIF}
raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, errMsg);
end;
end; end;
{--------} {--------}
procedure TVpParser.Cleanup; procedure TVpParser.Cleanup;
@ -669,40 +655,46 @@ begin
Result := FErrors.Count; Result := FErrors.Count;
end; end;
{--------} {--------}
function TVpParser.GetErrorMsg(wIdx : Integer) : DOMString; function TVpParser.GetErrorMsg(wIdx: Integer): DOMString;
begin begin
{$IFDEF DELPHI}
Result := sIndexOutOfBounds; Result := sIndexOutOfBounds;
if (wIdx >= 0) and if (wIdx >= 0) and (wIdx < FErrors.Count) then
(wIdx < FErrors.Count) then
Result := FErrors[wIdx]; Result := FErrors[wIdx];
{$ELSE}
Result := UTF8Decode(sIndexOutOfBounds);
if (wIdx >= 0) and (wIdx < FErrors.Count) then
Result := UTF8Decode(FErrors[wIdx]);
{$ENDIF}
end; end;
{--------} {--------}
function TVpParser.DeclaredAttributes(const sName : DOMString; function TVpParser.DeclaredAttributes(const sName: DOMString;
aIdx : Integer) aIdx: Integer): TStringList;
: TStringList;
begin begin
Unused(sName); Unused(sName);
if aIdx < 0 then if aIdx < 0 then
Result := nil Result := nil
else else
Result := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList; Result := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList;
end; end;
{--------} {--------}
function TVpParser.GetAttributeDefaultValueType(const sElemName, function TVpParser.GetAttributeDefaultValueType(
sAttrName : DOMString) const sElemName, sAttrName: DOMString): Integer;
: Integer;
var var
wIdx : Integer; wIdx: Integer;
oAttrList : TStringList; oAttrList: TStringList;
oAttr : TVpAttributeInfo; oAttr: TVpAttributeInfo;
begin begin
Result := ATTRIBUTE_DEFAULT_UNDECLARED; Result := ATTRIBUTE_DEFAULT_UNDECLARED;
wIdx := GetElementIndexOf(sElemName); wIdx := GetElementIndexOf(sElemName);
if wIdx >= 0 then begin if wIdx >= 0 then begin
oAttrList := TVpElementInfo(FElementInfo.Objects[wIdx]).AttributeList; oAttrList := TVpElementInfo(FElementInfo.Objects[wIdx]).AttributeList;
if oAttrList <> nil then begin if oAttrList <> nil then begin
{$IFDEF DELPHI}
wIdx := oAttrList.IndexOf(sAttrName); wIdx := oAttrList.IndexOf(sAttrName);
{$ELSE}
wIdx := oAttrList.IndexOf(UTF8Encode(sAttrName));
{$ENDIF}
if wIdx >= 0 then begin if wIdx >= 0 then begin
oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]); oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]);
Result := oAttr.AttrType; Result := oAttr.AttrType;
@ -711,15 +703,13 @@ begin
end; end;
end; end;
{--------} {--------}
function TVpParser.GetAttributeExpandedValue(const sElemName, function TVpParser.GetAttributeExpandedValue(const sElemName, sAttrName: DOMString;
sAttrName : DOMString; aIdx: Integer): DOMString;
aIdx : Integer)
: DOMString;
var var
wIdx : Integer; wIdx: Integer;
oAttrList : TStringList; oAttrList: TStringList;
oAttr : TVpAttributeInfo; oAttr: TVpAttributeInfo;
HasEntRef : Boolean; HasEntRef: Boolean;
begin begin
Unused(sElemName); Unused(sElemName);
@ -728,16 +718,17 @@ begin
if aIdx >= 0 then begin if aIdx >= 0 then begin
oAttrList := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList; oAttrList := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList;
if oAttrList <> nil then begin if oAttrList <> nil then begin
{$IFDEF DELPHI}
wIdx := oAttrList.IndexOf(sAttrName); wIdx := oAttrList.IndexOf(sAttrName);
{$ELSE}
wIdx := oAttrList.IndexOf(UTF8Encode(sAttrName));
{$ENDIF}
if wIdx >= 0 then begin if wIdx >= 0 then begin
oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]); oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]);
if (oAttr.Lookup = '') and if (oAttr.Lookup = '') and (oAttr.Value <> '') then
(oAttr.Value <> '') then begin begin
PushString('"' + oAttr.Value + '"'); PushString('"' + oAttr.Value + '"');
oAttr.Lookup := ReadLiteral(LIT_NORMALIZE or oAttr.Lookup := ReadLiteral(LIT_NORMALIZE or LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef);
LIT_CHAR_REF or
LIT_ENTITY_REF,
HasEntRef);
SkipWhitespace(True); SkipWhitespace(True);
end; end;
Result := oAttr.Lookup; Result := oAttr.Lookup;
@ -746,9 +737,8 @@ begin
end; end;
end; end;
{--------} {--------}
function TVpParser.GetElementContentType(const sName : DOMString; function TVpParser.GetElementContentType(const sName: DOMString;
aIdx : Integer) aIdx: Integer): Integer;
: Integer;
begin begin
Unused(sName); Unused(sName);
if aIdx < 0 then if aIdx < 0 then
@ -757,18 +747,21 @@ begin
Result := TVpElementInfo(FElementInfo.Objects[aIdx]).ContentType; Result := TVpElementInfo(FElementInfo.Objects[aIdx]).ContentType;
end; end;
{--------} {--------}
function TVpParser.GetElementIndexOf(const sElemName : DOMString) function TVpParser.GetElementIndexOf(const sElemName: DOMString): Integer;
: Integer;
begin begin
{$IFDEF DELPHI}
Result := FElementInfo.IndexOf(sElemName); Result := FElementInfo.IndexOf(sElemName);
{$ELSE}
Result := FElementInfo.IndexOf(UTF8Encode(sElemName));
{$ENDIF}
end; end;
{--------} {--------}
function TVpParser.GetEntityIndexOf(const sEntityName : DOMString; function TVpParser.GetEntityIndexOf(const sEntityName: DOMString;
aPEAllowed : Boolean) aPEAllowed: Boolean): Integer;
: Integer;
begin begin
for Result := 0 to FEntityInfo.Count - 1 do for Result := 0 to FEntityInfo.Count - 1 do
if FEntityInfo[Result] = sEntityName then begin if FEntityInfo[Result] = {$IFDEF DELPHI}sEntityName{$ELSE}UTF8Encode(sEntityName){$ENDIF}
then begin
if (not aPEAllowed) then begin if (not aPEAllowed) then begin
if (not TVpEntityInfo(FEntityInfo.Objects[Result]).IsParameterEntity) then if (not TVpEntityInfo(FEntityInfo.Objects[Result]).IsParameterEntity) then
Exit; Exit;
@ -850,12 +843,10 @@ begin
end; end;
end; end;
{--------} {--------}
function TVpParser.GetExternalTextEntityValue(const sName, function TVpParser.GetExternalTextEntityValue(const sName, sPublicId: DOMString;
sPublicId : DOMString; sSystemId: DOMString): DOMString;
sSystemId : DOMString)
: DOMString;
var var
CompletePath : string; CompletePath: string;
begin begin
DataBufferFlush; DataBufferFlush;
Result := ''; Result := '';
@ -869,8 +860,7 @@ begin
exit; exit;
PushDocument; PushDocument;
if (VpPos('/', sSystemID) = 0) and if (VpPos('/', sSystemID) = 0) and (VpPos('\', sSystemID) = 0) then
(VpPos('\', sSystemID) = 0) then
CompletePath := FCurrentPath + sSystemID CompletePath := FCurrentPath + sSystemID
else else
CompletePath := sSystemID; CompletePath := sSystemID;
@ -931,10 +921,9 @@ begin
(cVal = #$0D) or (cVal = #$0A); (cVal = #$0D) or (cVal = #$0A);
end; end;
{--------} {--------}
function TVpParser.LoadDataSource(sSrcName : string; function TVpParser.LoadDataSource(sSrcName: string; oErrors: TStringList): Boolean;
oErrors : TStringList) : Boolean;
var var
aFileStream : TVpFileStream; aFileStream: TVpFileStream;
begin begin
begin begin
{ Must be a local or network file. Eliminate file:// prefix. } { Must be a local or network file. Eliminate file:// prefix. }
@ -1209,7 +1198,11 @@ begin
FErrors.Clear; FErrors.Clear;
FIsStandAlone := False; FIsStandAlone := False;
FHasExternals := False; FHasExternals := False;
{$IFDEF DELPHI}
FUrl := sSource; FUrl := sSource;
{$ELSE}
FUrl := UTF8Decode(sSource);
{$ENDIF}
Result := LoadDataSource(sSource, FErrors); Result := LoadDataSource(sSource, FErrors);
if Result then begin if Result then begin
FFilter.FreeStream := True; FFilter.FreeStream := True;
@ -1379,14 +1372,17 @@ end;
procedure TVpParser.ParseEndTag; procedure TVpParser.ParseEndTag;
var var
sName : DOMString; sName : DOMString;
msg: DOMString;
begin begin
sName := ReadNameToken(True); sName := ReadNameToken(True);
if sName <> FCurrentElement then if sName <> FCurrentElement then begin
raise EVpParserError.CreateError (FFilter.Line, {$IFDEF DELPHI}
FFilter.LinePos, msg := sMismatchEndTag + 'Start tag = "' + FCurrentElement + '" End tag = "' + sName + '"';
sMismatchEndTag + {$ELSE}
'Start tag = "' + FCurrentElement + msg := UTF8Decode(sMismatchEndTag) + 'Start tag = "' + FCurrentElement + '" End tag = "' + sName + '"';
'" End tag = "' + sName + '"'); {$ENDIF}
raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
end;
SkipWhitespace(True); SkipWhitespace(True);
Require(Xpc_BracketAngleRight); Require(Xpc_BracketAngleRight);
if Assigned(FOnEndElement) then if Assigned(FOnEndElement) then
@ -1657,9 +1653,8 @@ var
HasEntRef : Boolean; HasEntRef : Boolean;
begin begin
if FXMLDecParsed then if FXMLDecParsed then
raise EVpParserError.CreateError (FFilter.Line, raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sXMLDecNotAtBeg);
FFilter.LinePos,
sXMLDecNotAtBeg);
HasEntRef := False; HasEntRef := False;
SkipWhitespace(True); SkipWhitespace(True);
Require(Xpc_Version); Require(Xpc_Version);
@ -1676,37 +1671,30 @@ begin
Format(sInvalidXMLVersion, Format(sInvalidXMLVersion,
[VpXMLSpecification])); [VpXMLSpecification]));
SkipWhitespace(True); SkipWhitespace(True);
if TryRead(Xpc_Encoding) then begin if TryRead(Xpc_Encoding) then begin
DatabufferAppend('encoding'); DatabufferAppend('encoding');
ParseEq; ParseEq;
DataBufferAppend('="'); DataBufferAppend('="');
Buffer := Buffer + ' ' + DataBufferToString; Buffer := Buffer + ' ' + DataBufferToString;
sValue := ReadLiteral(LIT_CHAR_REF or sValue := ReadLiteral(LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef);
LIT_ENTITY_REF, ValidateEncName(sValue);
HasEntRef); Buffer := Buffer + sValue + '"';
ValidateEncName(sValue); if CompareText(sValue, 'ISO-8859-1') = 0 then
Buffer := Buffer + sValue + '"'; FFilter.Format := sfISO88591;
if CompareText(sValue, 'ISO-8859-1') = 0 then SkipWhitespace(True);
FFilter.Format := sfISO88591;
SkipWhitespace(True);
end; end;
if TryRead(Xpc_Standalone) then begin if TryRead(Xpc_Standalone) then begin
DatabufferAppend('standalone'); DatabufferAppend('standalone');
ParseEq; ParseEq;
DatabufferAppend('="'); DatabufferAppend('="');
Buffer := Buffer + ' ' + DataBufferToString; Buffer := Buffer + ' ' + DataBufferToString;
sValue := ReadLiteral(LIT_CHAR_REF or sValue := ReadLiteral(LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef);
LIT_ENTITY_REF, if (not ((sValue = 'yes') or (sValue = 'no'))) then
HasEntRef); raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sInvStandAloneVal);
if (not ((sValue = 'yes') or Buffer := Buffer + sValue + '"';
(sValue = 'no'))) then FIsStandalone := sValue = 'yes';
raise EVpParserError.CreateError (FFilter.Line, SkipWhitespace(True)
FFilter.LinePos,
sInvStandAloneVal);
Buffer := Buffer + sValue + '"';
FIsStandalone := sValue = 'yes';
SkipWhitespace(True)
end; end;
Require(Xpc_ProcessInstrEnd); Require(Xpc_ProcessInstrEnd);
@ -1747,13 +1735,12 @@ begin
end; end;
end; end;
{--------} {--------}
function TVpParser.ReadChar(const UpdatePos : Boolean) : DOMChar; function TVpParser.ReadChar(const UpdatePos: Boolean) : DOMChar;
begin begin
Result := FFilter.ReadChar; Result := FFilter.ReadChar;
if ((Result = VpEndOfStream) and if (Result = VpEndOfStream) and (not IsEndDocument) then
(not IsEndDocument)) then
Result := FFilter.ReadChar; Result := FFilter.ReadChar;
if (UpdatePos) then if UpdatePos then
FFilter.SkipChar; FFilter.SkipChar;
end; end;
{--------} {--------}
@ -1784,15 +1771,14 @@ begin
end; end;
end; end;
{--------} {--------}
function TVpParser.ReadLiteral(wFlags : Integer; function TVpParser.ReadLiteral(wFlags: Integer; var HasEntRef: Boolean): DOMString;
var HasEntRef : Boolean) : DOMString;
var var
TempStr : DOMString; TempStr: DOMString;
cDelim, cDelim, TempChar: DOMChar;
TempChar : DOMChar; EntRefs: TStringList;
EntRefs : TStringList; StackLevel: Integer;
StackLevel : Integer; CurrCharRef: Boolean;
CurrCharRef : Boolean; msg: DOMString;
begin begin
StackLevel := 0; StackLevel := 0;
CurrCharRef := False; CurrCharRef := False;
@ -1802,14 +1788,11 @@ begin
if (cDelim <> '"') and if (cDelim <> '"') and
(cDelim <> #39) and (cDelim <> #39) and
(cDelim <> #126) and (cDelim <> #126) and
(cDelim <> #0) then (cDelim <> #0)
raise EVpParserError.CreateError (FFilter.Line, then
FFilter.LinePos, raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sQuoteExpected);
sQuoteExpected);
TempChar := ReadChar(False); TempChar := ReadChar(False);
while (not IsEndDocument) and while (not IsEndDocument) and ((CurrCharRef) or (TempChar <> cDelim)) do begin
((CurrCharRef) or
(TempChar <> cDelim)) do begin
if (TempChar = #$0A) then begin if (TempChar = #$0A) then begin
TempChar := ' '; TempChar := ' ';
end else if (TempChar = #$0D) then end else if (TempChar = #$0D) then
@ -1833,7 +1816,8 @@ begin
(TempStr <> 'gt') and (TempStr <> 'gt') and
(TempStr <> 'amp') and (TempStr <> 'amp') and
(TempStr <> 'apos') and (TempStr <> 'apos') and
(TempStr <> 'quot') then begin (TempStr <> 'quot') then
begin
if (not Assigned(EntRefs)) then begin if (not Assigned(EntRefs)) then begin
EntRefs := TStringList.Create; EntRefs := TStringList.Create;
EntRefs.Sorted := True; EntRefs.Sorted := True;
@ -1850,10 +1834,12 @@ begin
except except
on E:EStringListError do begin on E:EStringListError do begin
EntRefs.Free; EntRefs.Free;
raise EVpParserError.CreateError (FFilter.Line, {$IFDEF DELPHI}
FFilter.LinePos, msg := sCircularEntRef + TempChar;
sCircularEntRef + {$ELSE}
TempChar); msg := UTF8Decode(sCircularEntRef) + TempChar;
{$ENDIF}
raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
end; end;
on E:EVpParserError do on E:EVpParserError do
raise; raise;
@ -1882,9 +1868,12 @@ begin
except except
on E:EStringListError do begin on E:EStringListError do begin
EntRefs.Free; EntRefs.Free;
raise EVpParserError.CreateError (FFilter.Line, {$IFDEF DELPHI}
FFilter.LinePos, msg := sCircularEntRef + TempChar;
sCircularEntRef + TempChar); {$ELSE}
msg := UTF8Decode(sCircularEntRef) + TempChar;
{$ENDIF}
raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
end; end;
on E:EVpParserError do on E:EVpParserError do
raise; raise;
@ -1897,9 +1886,7 @@ begin
CurrCharRef := False; CurrCharRef := False;
end; end;
if TempChar <> cDelim then if TempChar <> cDelim then
raise EVpParserError.CreateError (FFilter.Line, raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, 'Expected: ' + cDelim);
FFilter.LinePos,
'Expected: ' + cDelim);
SkipChar; SkipChar;
@ -1911,7 +1898,7 @@ begin
EntRefs.Free; EntRefs.Free;
end; end;
{--------} {--------}
function TVpParser.ReadNameToken(aValFirst : Boolean) : DOMString; function TVpParser.ReadNameToken(aValFirst: Boolean): DOMString;
var var
TempChar : DOMChar; TempChar : DOMChar;
First : Boolean; First : Boolean;
@ -2074,18 +2061,24 @@ begin
SetEntity(sName, ENTITY_INTERNAL, '', '', sValue, '', aIsPE); SetEntity(sName, ENTITY_INTERNAL, '', '', sValue, '', aIsPE);
end; end;
{--------} {--------}
procedure TVpParser.SetNotation(const sNotationName, procedure TVpParser.SetNotation(const sNotationName, sPublicId, sSystemId: DOMString);
sPublicId,
sSystemId : DOMString);
var var
oNot : TVpNotationInfo; oNot : TVpNotationInfo;
wIdx : Integer; wIdx : Integer;
begin begin
{$IFDEF DELPHI}
if not FNotationInfo.Find(sNotationName, wIdx) then begin if not FNotationInfo.Find(sNotationName, wIdx) then begin
{$ELSE}
if not FNotationInfo.Find(UTF8Encode(sNotationName), wIdx) then begin
{$ENDIF}
oNot := TVpNotationInfo.Create; oNot := TVpNotationInfo.Create;
oNot.PublicId := sPublicId; oNot.PublicId := sPublicId;
oNot.SystemId := sSystemId; oNot.SystemId := sSystemId;
{$IFDEF DELPHI}
FNotationInfo.AddObject(sNotationName, oNot); FNotationInfo.AddObject(sNotationName, oNot);
{$ELSE}
FNotationInfo.AddObject(UTF8Encode(sNotationName), oNot);
{$ENDIF}
end; end;
end; end;
{--------} {--------}
@ -2184,21 +2177,22 @@ begin
end; end;
end; end;
{--------} {--------}
procedure TVpParser.ValidateEntityValue(const aValue : DOMString; procedure TVpParser.ValidateEntityValue(const aValue: DOMString; aQuoteCh: DOMChar);
aQuoteCh : DOMChar);
var var
TempChr : DOMChar; TempChr: DOMChar;
i : Integer; i: Integer;
msg: String;
begin begin
for i := 1 to Length(aValue) do begin for i := 1 to Length(aValue) do begin
TempChr := aValue[i]; TempChr := aValue[i];
if (TempChr = '%') or if (TempChr = '%') or (TempChr = '&') or (TempChr = aQuoteCh) then begin
(TempChr = '&') or {$IFDEF DELPHI}
(TempChr = aQuoteCh) then msg := sInvEntityValue + QuotedStr(TempChr));
raise EVpParserError.CreateError (FFilter.Line, {$ELSE}
FFilter.LinePos, msg := sInvEntityValue + QuotedStr(UTF8Encode(TempChr));
sInvEntityValue + {$ENDIF}
QuotedStr(TempChr)); raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
end;
end; end;
end; end;
{--------} {--------}