omnixml.pas

OmniXML源码

    (Code: 175; Name: 'macr'),
    (Code: 176; Name: 'deg'),
    (Code: 177; Name: 'plusm'),
    (Code: 178; Name: 'sup2'),
    (Code: 179; Name: 'sup3'),
    (Code: 180; Name: 'acute'),
    (Code: 181; Name: 'micro'),
    (Code: 182; Name: 'para'),
    (Code: 183; Name: 'middot'),
    (Code: 184; Name: 'cedil'),
    (Code: 185; Name: 'supl'),
    (Code: 186; Name: 'ordm'),
    (Code: 187; Name: 'raquo'),
    (Code: 188; Name: 'frac14'),
    (Code: 189; Name: 'frac12'),
    (Code: 190; Name: 'frac34'),
    (Code: 191; Name: 'iquest'),
    (Code: 192; Name: 'Agrave'),
    (Code: 193; Name: 'Aacute'),
    (Code: 194; Name: 'circ'),
    (Code: 195; Name: 'Atilde'),
    (Code: 196; Name: 'Auml'),
    (Code: 197; Name: 'ring'),
    (Code: 198; Name: 'AElig'),
    (Code: 199; Name: 'Ccedil'),
    (Code: 200; Name: 'Egrave'),
    (Code: 201; Name: 'Eacute'),
    (Code: 202; Name: 'Ecirc'),
    (Code: 203; Name: 'Euml'),
    (Code: 204; Name: 'Igrave'),
    (Code: 205; Name: 'Iacute'),
    (Code: 206; Name: 'Icirc'),
    (Code: 207; Name: 'Iuml'),
    (Code: 208; Name: 'ETH'),
    (Code: 209; Name: 'Ntilde'),
    (Code: 210; Name: 'Ograve'),
    (Code: 211; Name: 'Oacute'),
    (Code: 212; Name: 'Ocirc'),
    (Code: 213; Name: 'Otilde'),
    (Code: 214; Name: 'Ouml'),
    (Code: 215; Name: 'times'),
    (Code: 216; Name: 'Oslash'),
    (Code: 217; Name: 'Ugrave'),
    (Code: 218; Name: 'Uacute'),
    (Code: 219; Name: 'Ucirc'),
    (Code: 220; Name: 'Uuml'),
    (Code: 221; Name: 'Yacute'),
    (Code: 222; Name: 'THORN'),
    (Code: 223; Name: 'szlig'),
    (Code: 224; Name: 'agrave'),
    (Code: 225; Name: 'aacute'),
    (Code: 226; Name: 'acirc'),
    (Code: 227; Name: 'atilde'),
    (Code: 228; Name: 'auml'),
    (Code: 229; Name: 'aring'),
    (Code: 230; Name: 'aelig'),
    (Code: 231; Name: 'ccedil'),
    (Code: 232; Name: 'egrave'),
    (Code: 233; Name: 'eacute'),
    (Code: 234; Name: 'ecirc'),
    (Code: 235; Name: 'euml'),
    (Code: 236; Name: 'igrave'),
    (Code: 237; Name: 'iacute'),
    (Code: 238; Name: 'icirc'),
    (Code: 239; Name: 'iuml'),
    (Code: 240; Name: 'ieth'),
    (Code: 241; Name: 'ntilde'),
    (Code: 242; Name: 'ograve'),
    (Code: 243; Name: 'oacute'),
    (Code: 244; Name: 'ocirc'),
    (Code: 245; Name: 'otilde'),
    (Code: 246; Name: 'ouml'),
    (Code: 247; Name: 'divide'),
    (Code: 248; Name: 'oslash'),
    (Code: 249; Name: 'ugrave'),
    (Code: 250; Name: 'uacute'),
    (Code: 251; Name: 'ucirc'),
    (Code: 252; Name: 'uuml'),
    (Code: 253; Name: 'yacute'),
    (Code: 254; Name: 'thorn'),
    (Code: 255; Name: 'yuml')
  );

const
  BIT_IS_BaseChar = Byte($01);
  BIT_IS_CombiningChar = Byte($02);
  BIT_IS_Digit = Byte($04);
  BIT_IS_Ideographic = Byte($08);
  BIT_IS_Letter = Byte($10);
  BIT_IS_Extender = Byte($20);
  BIT_IS_Char = Byte($40);
  BIT_IS_NameChar = Byte($80);

function CreateXMLDoc: IXMLDocument;
begin
  Result := TXMLDocument.Create;
end;

function GetCodePage(const Alias: string; var CodePage: Word): Boolean;
var
  i: Integer;
begin
  Result := False;
  i := Low(TCodePages);
  while (not Result) and (i <= High(TCodePages)) do begin
    Result := CompareText(Alias, CodePages[i].Alias) = 0;
    if Result then
      CodePage := CodePages[i].CodePage
    else
      Inc(i);
  end;
end;

function FindEncoding(const PI: IXMLProcessingInstruction; var CodePage: Word): Boolean;
var
  EncodingStartPos,
  EncodingEndPos: Integer;
  R: string;
  Encoding: string;
  DelimiterChar: WideChar;
begin
  Result := False;
  if CompareText(PI.Target, 'xml') = 0 then begin
    // 2004-02-06 (mr): modified to recognize valid delimiter characters
    EncodingStartPos := Pos('encoding=', PI.Data) + 9;

    if EncodingStartPos > 9 then begin
      DelimiterChar := PI.Data[EncodingStartPos];

      if (DelimiterChar = '''') or (DelimiterChar = '"') then begin
        Inc(EncodingStartPos);
        R := Copy(PI.Data, EncodingStartPos, MaxInt);
        EncodingEndPos := Pos(DelimiterChar, R) + EncodingStartPos;
        if EncodingEndPos > 0 then begin
          Encoding := Copy(PI.Data, EncodingStartPos, EncodingEndPos - EncodingStartPos - 1);
          Result := GetCodePage(Encoding, CodePage);
        end;
      end;
    end;
  end;
end;

function FindCharReference(const CharReferenceName: string; var Character: WideChar): Boolean;
var
  i: Integer;
begin
  Result := False;

  i := Low(CharacterReferences);
  while (not Result) and (i <= High(CharacterReferences)) do begin
    Result := SameText(CharReferenceName, CharacterReferences[i].Name);
    if Result then
      Character := WideChar(CharacterReferences[i].Code)
    else
      Inc(i);
  end;
end;

function CharIs_BaseChar(const ch: WideChar): Boolean;
begin
  // [85] BaseChar
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_BaseChar) > 0;
end;

function CharIs_Ideographic(const ch: WideChar): Boolean;
begin
  // [86] Ideographic
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_Ideographic) > 0;
end;

function CharIs_Letter(const ch: WideChar): Boolean;
begin
  // [84] Letter ::= BaseChar | Ideographic
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_Letter) > 0;
end;

function CharIs_Extender(const ch: WideChar): Boolean;
begin
  // [89] Extender
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_Extender) > 0;
end;

function CharIs_Digit(const ch: WideChar): Boolean;
begin
  // [88] Digit
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_Digit) > 0;
end;

function CharIs_CombiningChar(const ch: WideChar): Boolean;
begin
  // [87] CombiningChar
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_CombiningChar) > 0;
end;

function CharIs_WhiteSpace(const ch: WideChar): Boolean;
var
  _ch: Cardinal;
begin
  // [3] WhiteSpace
  _ch := Ord(ch);
  Result := (_ch = $0020) or (_ch = $0009) or (_ch = $000D) or (_ch = $000A);
end;

function CharIs_Char(const ch: WideChar): Boolean;
begin
  // [2] Char - any Unicode character, excluding the surrogate blocks, FFFE, and FFFF
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_Char) > 0;
end;

function CharIs_NameChar(const ch: WideChar): Boolean;
begin
  // [4] NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender
  Result := (XMLCharLookupTable[Ord(ch)] and BIT_IS_NameChar) > 0;
end;

function CharIs_Name(const ch: WideChar; const IsFirstChar: Boolean): Boolean;
var
  _ch: Cardinal;
begin
  // [5] Name ::= (Letter | '_' | ':') (NameChar)*
  _ch := Ord(ch);
  if IsFirstChar then
    Result := CharIs_Letter(ch) or (_ch = $005F) or (_ch = $003A)  // '_', ':'
  else
    Result := CharIs_NameChar(ch);
end;

//
//  E N D
// 


function EncodeText(const Value: WideString): WideString;
var
  iResult: Integer;
  iValue: Integer;

  procedure ExtendResult(atLeast: Integer = 0);
  begin
    SetLength(Result, Round(1.1 * System.Length(Result) + atLeast));
  end;

  procedure Store(const token: WideString);
  var
    iToken: Integer;
  begin
    if (iResult + System.Length(token)) >= System.Length(Result) then
      ExtendResult(System.Length(token));
    for iToken := 1 to System.Length(token) do begin
      Inc(iResult);
      Result[iResult] := token[iToken];
    end;
  end;
begin
  SetLength(Result, Round(1.1 * System.Length(Value)));  // a wild guess
  iResult := 0;
  iValue := 1;
  while iValue <= System.Length(Value) do begin
    case Ord(Value[iValue]) of
      38: Store('&amp;');
      60: Store('&lt;');
      62: Store('&gt;');
    else
      begin
        Inc(iResult);
        if iResult > System.Length(Result) then
          ExtendResult;
        Result[iResult] := Value[iValue];
      end;
    end;
    Inc(iValue);
  end;
  SetLength(Result, iResult);
end;

function Reference2Char(const InputStream: IUnicodeStream): WideChar;
type
  TParserState = (psReference, psEntityRef, psCharRef, psCharDigitalRef, psCharHexRef);
var
  ReadChar: WideChar;
  PState: TParserState;
  CharRef: LongWord;
  EntityName: string;
begin
  // [67] Reference ::= EntityRef | CharRef
  // [68] EntityRef ::= '&' Name ';'
  // [66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'
  PState := psReference;
  CharRef := 0;
  Result := ' ';
  // read next available character
  while InputStream.ProcessChar(ReadChar) do begin
    case PState of
      psReference:
        if CharIs_WhiteSpace(ReadChar) then
          raise EXMLException.CreateParseError(INVALID_CHARACTER_ERR, MSG_E_UN