src/shared/xparser.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 unit xparser;
  18
  19 interface
  20
  21 uses
  22   Classes;
  23
  24
  25 // ////////////////////////////////////////////////////////////////////////// //
  26 type
  27   TTextParser = class
  28   public
  29     const
  30       TTNone = -1;
  31       TTEOF = 0;
  32       TTId = 1;
  33       TTInt = 2;
  34       //TTFloat = 3; // not yet
  35       TTStr = 4; // string
  36       TTComma = 5; // ','
  37       TTColon = 6; // ':'
  38       TTSemi = 7; // ';'
  39       TTBegin = 8; // left curly
  40       TTEnd = 9; // right curly
  41       TTDelim = 10; // other delimiters
  42
  43   private
  44     mLine, mCol: Integer;
  45     mCurChar, mNextChar: AnsiChar;
  46
  47     mAllowSignedNumbers: Boolean; // internal control
  48
  49     mTokLine, mTokCol: Integer; // token start
  50     mTokType: Integer;
  51     mTokStr: AnsiString; // string or identifier
  52     mTokChar: AnsiChar; // for delimiters
  53     mTokInt: Integer;
  54
  55   protected
  56     procedure warmup (); virtual; // called in constructor to warm up the system
  57     procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
  58
  59   public
  60     constructor Create ();
  61     destructor Destroy (); override;
  62
  63     function isEOF (): Boolean; inline;
  64
  65     function skipChar (): Boolean; // returns `false` on eof
  66
  67     function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
  68
  69     function skipToken (): Boolean; // returns `false` on eof
  70
  71     function expectId (): AnsiString;
  72     procedure expectId (const aid: AnsiString);
  73     function eatId (const aid: AnsiString): Boolean;
  74
  75     function expectStr (allowEmpty: Boolean=false): AnsiString;
  76     function expectInt (): Integer;
  77
  78     function expectStrOrId (allowEmpty: Boolean=false): AnsiString;
  79
  80     procedure expectTT (ttype: Integer);
  81     function eatTT (ttype: Integer): Boolean;
  82
  83     function expectDelim (const ch: AnsiChar): AnsiChar;
  84     function eatDelim (const ch: AnsiChar): Boolean;
  85
  86   public
  87     property col: Integer read mCol;
  88     property line: Integer read mLine;
  89
  90     property curChar: AnsiChar read mCurChar;
  91     property nextChar: AnsiChar read mNextChar;
  92
  93     // token start
  94     property tokCol: Integer read mTokCol;
  95     property tokLine: Integer read mTokLine;
  96
  97     property tokType: Integer read mTokType; // see TTXXX constants
  98     property tokStr: AnsiString read mTokStr; // string or identifier
  99     property tokChar: AnsiChar read mTokChar; // for delimiters
 100     property tokInt: Integer read mTokInt;
 101   end;
 102
 103
 104 // ////////////////////////////////////////////////////////////////////////// //
 105 type
 106   TFileTextParser = class(TTextParser)
 107   private
 108     const BufSize = 16384;
 109
 110   private
 111     mFile: TStream;
 112     mStreamOwned: Boolean;
 113     mBuffer: PChar;
 114     mBufLen: Integer;
 115     mBufPos: Integer;
 116
 117   protected
 118     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 119
 120   public
 121     constructor Create (const fname: AnsiString);
 122     constructor Create (st: TStream; astOwned: Boolean=true); // will take ownership on st by default
 123     destructor Destroy (); override;
 124   end;
 125
 126   TStrTextParser = class(TTextParser)
 127   private
 128     mStr: AnsiString;
 129     mPos: Integer;
 130
 131   protected
 132     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 133
 134   public
 135     constructor Create (const astr: AnsiString);
 136     destructor Destroy (); override;
 137   end;
 138
 139
 140 // ////////////////////////////////////////////////////////////////////////// //
 141 type
 142   TTextWriter = class
 143   protected
 144     mIndent: Integer;
 145
 146   protected
 147     procedure putBuf (constref buf; len: SizeUInt); virtual; abstract;
 148
 149   public
 150     constructor Create ();
 151
 152     procedure flush (); virtual;
 153
 154     procedure put (const s: AnsiString); overload;
 155     procedure put (v: Byte); overload;
 156     procedure put (v: Integer); overload;
 157     procedure put (const fmt: AnsiString; args: array of const); overload;
 158     procedure putIndent ();
 159     procedure indent ();
 160     procedure unindent ();
 161   end;
 162
 163
 164 // ////////////////////////////////////////////////////////////////////////// //
 165 type
 166   TFileTextWriter = class(TTextWriter)
 167   private
 168     const BufSize = 16384;
 169
 170   private
 171     mFile: TStream;
 172     mStreamOwned: Boolean;
 173     mBuffer: PAnsiChar;
 174     mBufUsed: Integer;
 175
 176   protected
 177     procedure putBuf (constref buf; len: SizeUInt); override;
 178
 179   public
 180     constructor Create (const fname: AnsiString);
 181     constructor Create (ast: TStream; astOwned: Boolean=true); // will own the stream by default
 182     destructor Destroy (); override;
 183
 184     procedure flush (); override;
 185   end;
 186
 187   TStrTextWriter = class(TTextWriter)
 188   private
 189     mStr: AnsiString;
 190
 191   protected
 192     procedure putBuf (constref buf; len: SizeUInt); override;
 193
 194   public
 195     constructor Create ();
 196     destructor Destroy (); override;
 197
 198     property str: AnsiString read mStr;
 199   end;
 200
 201
 202 implementation
 203
 204 uses
 205   SysUtils, utils;
 206
 207
 208 // ////////////////////////////////////////////////////////////////////////// //
 209 function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
 210
 211
 212 // ////////////////////////////////////////////////////////////////////////// //
 213 constructor TTextParser.Create ();
 214 begin
 215   mLine := 1;
 216   mCol := 1;
 217   mCurChar := #0;
 218   mNextChar := #0;
 219   mTokType := TTNone;
 220   mTokStr := '';
 221   mTokChar := #0;
 222   mTokInt := 0;
 223   mAllowSignedNumbers := true;
 224   warmup(); // change `mAllowSignedNumbers` there, if necessary
 225   skipToken();
 226 end;
 227
 228
 229 destructor TTextParser.Destroy ();
 230 begin
 231   inherited;
 232 end;
 233
 234
 235 function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); end;
 236
 237
 238 procedure TTextParser.warmup ();
 239 begin
 240   mNextChar := ' ';
 241   loadNextChar();
 242   mCurChar := mNextChar;
 243   if (mNextChar <> #0) then loadNextChar();
 244 end;
 245
 246
 247 function TTextParser.skipChar (): Boolean;
 248 begin
 249   if (mCurChar = #0) then begin result := false; exit; end;
 250   if (mCurChar = #10) then begin mCol := 1; Inc(mLine); end else Inc(mCol);
 251   mCurChar := mNextChar;
 252   if (mCurChar = #0) then begin result := false; exit; end;
 253   loadNextChar();
 254   // skip CR in CR/LF
 255   if (mCurChar = #13) then
 256   begin
 257     if (mNextChar = #10) then loadNextChar();
 258     mCurChar := #10;
 259   end;
 260   result := true;
 261 end;
 262
 263
 264 function TTextParser.skipBlanks (): Boolean;
 265 var
 266   level: Integer;
 267 begin
 268   while not isEOF do
 269   begin
 270     if (curChar = '/') then
 271     begin
 272       // single-line comment
 273       if (nextChar = '/') then
 274       begin
 275         while not isEOF and (curChar <> #10) do skipChar();
 276         skipChar(); // skip EOL
 277         continue;
 278       end;
 279       // multline comment
 280       if (nextChar = '*') then
 281       begin
 282         // skip comment start
 283         skipChar();
 284         skipChar();
 285         while not isEOF do
 286         begin
 287           if (curChar = '*') and (nextChar = '/') then
 288           begin
 289             // skip comment end
 290             skipChar();
 291             skipChar();
 292             break;
 293           end;
 294           skipChar();
 295         end;
 296         continue;
 297       end;
 298       // nesting multline comment
 299       if (nextChar = '+') then
 300       begin
 301         // skip comment start
 302         skipChar();
 303         skipChar();
 304         level := 1;
 305         while not isEOF do
 306         begin
 307           if (curChar = '+') and (nextChar = '/') then
 308           begin
 309             // skip comment end
 310             skipChar();
 311             skipChar();
 312             Dec(level);
 313             if (level = 0) then break;
 314             continue;
 315           end;
 316           if (curChar = '/') and (nextChar = '+') then
 317           begin
 318             // skip comment start
 319             skipChar();
 320             skipChar();
 321             Inc(level);
 322             continue;
 323           end;
 324           skipChar();
 325         end;
 326         continue;
 327       end;
 328     end;
 329     if (curChar > ' ') then break;
 330     skipChar(); // skip blank
 331   end;
 332   result := not isEOF;
 333 end;
 334
 335
 336 function TTextParser.skipToken (): Boolean;
 337
 338   procedure parseInt ();
 339   var
 340     neg: Boolean = false;
 341     base: Integer = -1;
 342     n: Integer;
 343   begin
 344     if mAllowSignedNumbers then
 345     begin
 346       if (curChar = '+') or (curChar = '-') then
 347       begin
 348         neg := (curChar = '-');
 349         skipChar();
 350         if (curChar < '0') or (curChar > '9') then
 351         begin
 352           mTokType := TTDelim;
 353           if (neg) then mTokChar := '-' else mTokChar := '+';
 354           exit;
 355         end;
 356       end;
 357     end;
 358     if (curChar = '0') then
 359     begin
 360       case nextChar of
 361         'b','B': base := 2;
 362         'o','O': base := 8;
 363         'd','D': base := 10;
 364         'h','H': base := 16;
 365       end;
 366       if (base > 0) then
 367       begin
 368         // skip prefix
 369         skipChar();
 370         skipChar();
 371       end;
 372     end;
 373     // default base
 374     if (base < 0) then base := 10;
 375     if (digitInBase(curChar, base) < 0) then raise Exception.Create('invalid number');
 376     mTokType := TTInt;
 377     mTokInt := 0; // just in case
 378     while not isEOF do
 379     begin
 380       n := digitInBase(curChar, base);
 381       if (n < 0) then break;
 382       n := mTokInt*10+n;
 383       if (n < 0) or (n < mTokInt) then raise Exception.Create('integer overflow');
 384       mTokInt := n;
 385       skipChar();
 386     end;
 387     // check for valid number end
 388     if not isEOF then
 389     begin
 390       if (curChar = '.') then raise Exception.Create('floating numbers aren''t supported yet');
 391       if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then
 392       begin
 393         raise Exception.Create('invalid number');
 394       end;
 395     end;
 396     if neg then mTokInt := -mTokInt;
 397   end;
 398
 399   procedure parseString ();
 400   var
 401     qch, ch: AnsiChar;
 402     n: Integer;
 403   begin
 404     mTokType := TTStr;
 405     mTokStr := ''; // just in case
 406     qch := curChar;
 407     skipChar(); // skip starting quote
 408     while not isEOF do
 409     begin
 410       // escape
 411       if (qch = '"') and (curChar = '\') then
 412       begin
 413         if (nextChar = #0) then raise Exception.Create('unterminated string escape');
 414         ch := nextChar;
 415         // skip backslash and escape type
 416         skipChar();
 417         skipChar();
 418         case ch of
 419           't': mTokStr += #9;
 420           'n': mTokStr += #10;
 421           'r': mTokStr += #13;
 422           'z': mTokStr += #0;
 423           'e': mTokStr += #27;
 424           'x', 'X': // hex escape
 425             begin
 426               n := digitInBase(curChar, 16);
 427               if (n < 0) then raise Exception.Create('invalid hexstr escape');
 428               skipChar();
 429               if (digitInBase(curChar, 16) > 0) then
 430               begin
 431                 n := n*16+digitInBase(curChar, 16);
 432                 skipChar();
 433               end;
 434               mTokStr += AnsiChar(n);
 435             end;
 436           else mTokStr += ch;
 437         end;
 438         continue;
 439       end;
 440       // duplicate single quote (pascal style)
 441       if (qch = '''') and (curChar = '''') and (nextChar = '''') then
 442       begin
 443         // skip both quotes
 444         skipChar();
 445         skipChar();
 446         mTokStr += '''';
 447         continue;
 448       end;
 449       if (curChar = qch) then
 450       begin
 451         skipChar(); // skip ending quote
 452         break;
 453       end;
 454       mTokStr += curChar;
 455       skipChar();
 456     end;
 457   end;
 458
 459   procedure parseId ();
 460   begin
 461     mTokType := TTId;
 462     mTokStr := ''; // just in case
 463     while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or
 464           ((curChar >= 'A') and (curChar <= 'Z')) or
 465           ((curChar >= 'a') and (curChar <= 'z')) or
 466           (curChar >= #128) do
 467     begin
 468       mTokStr += curChar;
 469       skipChar();
 470     end;
 471   end;
 472
 473 begin
 474   mTokType := TTEOF;
 475   mTokStr := '';
 476   mTokChar := #0;
 477   mTokInt := 0;
 478
 479   if not skipBlanks() then
 480   begin
 481     result := false;
 482     mTokLine := mLine;
 483     mTokCol := mCol;
 484     exit;
 485   end;
 486
 487   mTokLine := mLine;
 488   mTokCol := mCol;
 489
 490   result := true;
 491
 492   // number?
 493   if mAllowSignedNumbers and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
 494   if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end;
 495
 496   // string?
 497   if (curChar = '"') or (curChar = '''') then begin parseString(); exit; end;
 498
 499   // identifier?
 500   if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end;
 501
 502   // known delimiters?
 503   case curChar of
 504     ',': mTokType := TTComma;
 505     ':': mTokType := TTColon;
 506     ';': mTokType := TTSemi;
 507     '{': mTokType := TTBegin;
 508     '}': mTokType := TTEnd;
 509     else mTokType := TTDelim;
 510   end;
 511   mTokChar := curChar;
 512   skipChar();
 513 end;
 514
 515
 516 function TTextParser.expectId (): AnsiString;
 517 begin
 518   if (mTokType <> TTId) then raise Exception.Create('identifier expected');
 519   result := mTokStr;
 520   skipToken();
 521 end;
 522
 523
 524 procedure TTextParser.expectId (const aid: AnsiString);
 525 begin
 526   if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
 527   skipToken();
 528 end;
 529
 530
 531 function TTextParser.eatId (const aid: AnsiString): Boolean;
 532 begin
 533   result := false;
 534   if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then exit;
 535   result := true;
 536   skipToken();
 537 end;
 538
 539
 540 function TTextParser.expectStr (allowEmpty: Boolean=false): AnsiString;
 541 begin
 542   if (mTokType <> TTStr) then raise Exception.Create('string expected');
 543   if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 544   result := mTokStr;
 545   skipToken();
 546 end;
 547
 548
 549 function TTextParser.expectStrOrId (allowEmpty: Boolean=false): AnsiString;
 550 begin
 551   case mTokType of
 552     TTStr:
 553       if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 554     TTId:
 555       begin end;
 556     else
 557       raise Exception.Create('string or identifier expected');
 558   end;
 559   result := mTokStr;
 560   skipToken();
 561 end;
 562
 563
 564 function TTextParser.expectInt (): Integer;
 565 begin
 566   if (mTokType <> TTInt) then raise Exception.Create('string expected');
 567   result := mTokInt;
 568   skipToken();
 569 end;
 570
 571
 572 procedure TTextParser.expectTT (ttype: Integer);
 573 begin
 574   if (mTokType <> ttype) then raise Exception.Create('unexpected token');
 575   skipToken();
 576 end;
 577
 578
 579 function TTextParser.eatTT (ttype: Integer): Boolean;
 580 begin
 581   result := (mTokType = ttype);
 582   if result then skipToken();
 583 end;
 584
 585
 586 function TTextParser.expectDelim (const ch: AnsiChar): AnsiChar;
 587 begin
 588   if (mTokType <> TTDelim) then raise Exception.Create(Format('delimiter ''%s'' expected', [ch]));
 589   result := mTokChar;
 590   skipToken();
 591 end;
 592
 593
 594 function TTextParser.eatDelim (const ch: AnsiChar): Boolean;
 595 begin
 596   result := false;
 597   if (mTokType <> TTDelim) or (mTokChar <> ch) then exit;
 598   result := true;
 599   skipToken();
 600 end;
 601
 602
 603 // ////////////////////////////////////////////////////////////////////////// //
 604 constructor TFileTextParser.Create (const fname: AnsiString);
 605 begin
 606   mBuffer := nil;
 607   mFile := openDiskFileRO(fname);
 608   mStreamOwned := true;
 609   GetMem(mBuffer, BufSize);
 610   mBufPos := 0;
 611   mBufLen := mFile.Read(mBuffer^, BufSize);
 612   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 613   inherited Create();
 614 end;
 615
 616
 617 constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true);
 618 begin
 619   if (st = nil) then raise Exception.Create('cannot create parser for nil stream');
 620   mFile := st;
 621   mStreamOwned := astOwned;
 622   GetMem(mBuffer, BufSize);
 623   mBufPos := 0;
 624   mBufLen := mFile.Read(mBuffer^, BufSize);
 625   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 626   inherited Create();
 627 end;
 628
 629
 630 destructor TFileTextParser.Destroy ();
 631 begin
 632   if (mBuffer <> nil) then FreeMem(mBuffer);
 633   mBuffer := nil;
 634   mBufPos := 0;
 635   mBufLen := 0;
 636   if mStreamOwned then mFile.Free();
 637   mFile := nil;
 638   inherited;
 639 end;
 640
 641
 642 procedure TFileTextParser.loadNextChar ();
 643 begin
 644   if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 645   if (mBufPos >= mBufLen) then
 646   begin
 647     mBufLen := mFile.Read(mBuffer^, BufSize);
 648     if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 649     if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 650     mBufPos := 0;
 651   end;
 652   assert(mBufPos < mBufLen);
 653   mNextChar := mBuffer[mBufPos];
 654   Inc(mBufPos);
 655   if (mNextChar = #0) then mNextChar := ' ';
 656 end;
 657
 658
 659 // ////////////////////////////////////////////////////////////////////////// //
 660 constructor TStrTextParser.Create (const astr: AnsiString);
 661 begin
 662   mStr := astr;
 663   mPos := 1;
 664   inherited Create();
 665 end;
 666
 667
 668 destructor TStrTextParser.Destroy ();
 669 begin
 670   mStr := '';
 671   inherited;
 672 end;
 673
 674
 675 procedure TStrTextParser.loadNextChar ();
 676 begin
 677   mNextChar := #0;
 678   if (mPos > Length(mStr)) then exit;
 679   mNextChar := mStr[mPos]; Inc(mPos);
 680   if (mNextChar = #0) then mNextChar := ' ';
 681 end;
 682
 683
 684 // ////////////////////////////////////////////////////////////////////////// //
 685 constructor TTextWriter.Create (); begin mIndent := 0; end;
 686 procedure TTextWriter.flush (); begin end;
 687 procedure TTextWriter.put (const s: AnsiString); overload; begin if (Length(s) > 0) then putBuf((@(s[1]))^, Length(s)); end;
 688 procedure TTextWriter.put (v: Byte); overload; begin put('%d', [v]); end;
 689 procedure TTextWriter.put (v: Integer); overload; begin put('%d', [v]); end;
 690 procedure TTextWriter.put (const fmt: AnsiString; args: array of const); overload; begin put(formatstrf(fmt, args)); end;
 691 procedure TTextWriter.putIndent (); var f: Integer; begin for f := 1 to mIndent do put(' '); end;
 692 procedure TTextWriter.indent (); begin Inc(mIndent, 2); end;
 693 procedure TTextWriter.unindent (); begin Dec(mIndent, 2); end;
 694
 695
 696 // ////////////////////////////////////////////////////////////////////////// //
 697 constructor TFileTextWriter.Create (const fname: AnsiString);
 698 begin
 699   mFile := createDiskFile(fname);
 700   mStreamOwned := true;
 701   mBufUsed := 0;
 702   GetMem(mBuffer, BufSize);
 703   assert(mBuffer <> nil);
 704   inherited Create();
 705 end;
 706
 707
 708 constructor TFileTextWriter.Create (ast: TStream; astOwned: Boolean=true);
 709 begin
 710   if (ast = nil) then raise Exception.Create('cannot write to nil stream');
 711   mFile := ast;
 712   mStreamOwned := astOwned;
 713   mBufUsed := 0;
 714   GetMem(mBuffer, BufSize);
 715   assert(mBuffer <> nil);
 716 end;
 717
 718
 719 destructor TFileTextWriter.Destroy ();
 720 begin
 721   flush();
 722   if (mBuffer <> nil) then FreeMem(mBuffer);
 723   mBufUsed := 0;
 724   mBuffer := nil;
 725   if (mStreamOwned) then mFile.Free();
 726   mFile := nil;
 727   inherited;
 728 end;
 729
 730
 731 procedure TFileTextWriter.flush ();
 732 begin
 733   if (mFile <> nil) and (mBufUsed > 0) then
 734   begin
 735     mFile.WriteBuffer(mBuffer^, mBufUsed);
 736   end;
 737   mBufUsed := 0;
 738 end;
 739
 740
 741 procedure TFileTextWriter.putBuf (constref buf; len: SizeUInt);
 742 var
 743   pc: PChar;
 744   left: Integer;
 745 begin
 746   if (len = 0) then exit;
 747   pc := @buf;
 748   while (len > 0) do
 749   begin
 750     left := BufSize-mBufUsed;
 751     if (left = 0) then
 752     begin
 753       flush();
 754       left := BufSize-mBufUsed;
 755       assert(left > 0);
 756     end;
 757     if (left > len) then left := Integer(len);
 758     Move(pc^, (mBuffer+mBufUsed)^, left);
 759     Inc(mBufUsed, left);
 760     pc += left;
 761     len -= left;
 762   end;
 763 end;
 764
 765
 766 // ////////////////////////////////////////////////////////////////////////// //
 767 constructor TStrTextWriter.Create ();
 768 begin
 769   mStr := '';
 770 end;
 771
 772
 773 destructor TStrTextWriter.Destroy ();
 774 begin
 775   mStr := '';
 776   inherited;
 777 end;
 778
 779
 780 procedure TStrTextWriter.putBuf (constref buf; len: SizeUInt);
 781 var
 782   st: AnsiString = '';
 783 begin
 784   if (len > 0) then
 785   begin
 786     SetLength(st, Integer(len));
 787     Move(buf, PChar(st)^, Integer(len));
 788     mStr += st;
 789     st := '';
 790   end;
 791 end;
 792
 793
 794 end.