/components/turbopower_ipro/ipstrms.pas

   1{******************************************************************}
   2{*     IPSTRMS.PAS - Various stream classes                       *}
   3{******************************************************************}
   4
   5{ $Id$ }
   6
   7(* ***** BEGIN LICENSE BLOCK *****
   8 * Version: MPL 1.1
   9 *
  10 * The contents of this file are subject to the Mozilla Public License Version
  11 * 1.1 (the "License"); you may not use this file except in compliance with
  12 * the License. You may obtain a copy of the License at
  13 * http://www.mozilla.org/MPL/
  14 *
  15 * Software distributed under the License is distributed on an "AS IS" basis,
  16 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  17 * for the specific language governing rights and limitations under the
  18 * License.
  19 *
  20 * The Original Code is TurboPower Internet Professional
  21 *
  22 * The Initial Developer of the Original Code is
  23 * TurboPower Software
  24 *
  25 * Portions created by the Initial Developer are Copyright (C) 2000-2002
  26 * the Initial Developer. All Rights Reserved.
  27 *
  28 * Contributor(s):
  29 *
  30 * Markus Kaemmerer <mk@happyarts.de> SourceForge: mkaemmerer
  31 *
  32 * ***** END LICENSE BLOCK ***** *)
  33
  34{ Global defines potentially affecting this unit }
  35
  36{$I IPDEFINE.INC}
  37
  38unit IpStrms;
  39  {- Ansi text stream class}
  40
  41interface
  42
  43uses
  44  SysUtils,
  45  Classes,
  46  {$IFDEF IP_LAZARUS}
  47  FPCAdds,
  48  LCLType,
  49  GraphType,
  50  LCLIntf,
  51  LazFileUtils,
  52  {$ELSE}
  53  Windows, // put Windows behind Classes because of THandle
  54  {$ENDIF}
  55  IpUtils,
  56  IpConst;
  57
  58const
  59  IpFileOpenFailed = THandle(-1);
  60
  61{ TIpMemMapStream  }
  62type
  63  TIpMemMapStream = class(TStream)
  64  protected
  65    FCanGrow : Boolean;
  66      { If True then the map file can grow if the user writes past the
  67        current end of the stream. Note that growing may be expensive
  68        time-wise. }
  69    FDataSize : Longint;
  70      { The amount of data actually written to the stream. }
  71    FGrowthFactor : Double;
  72      { The factor by which the map file is to be grow each time a size
  73        increase is needed. }
  74    FReadOnly : Boolean;
  75      { If set to True then file is to be opened for read-only access. }
  76    FSize : Longint;
  77      { The current size of the mapped file. When creating files, the size
  78        must be pre-set. The size is fixed unless the CanGrow property is
  79        set to True. }
  80    mmFileExists : Boolean;
  81      { Set to True if the file existed when the open method was called. }
  82    mmFileHandle : THandle;
  83    mmFileIsTemp : Boolean;
  84      { If set to True then file was created by this stream. }
  85    mmFileName : string;
  86    mmMapHandle : THandle;
  87    mmPointer : Pointer;
  88      { Pointer to the beginning of the file. }
  89    mmPos : Longint;
  90      { Current position in the file. }
  91
  92    { Verification methods }
  93    procedure CheckClosed(const aMethodName : string);
  94    procedure CheckFileName;
  95
  96    procedure CloseFile;
  97    procedure CloseMap;
  98
  99    procedure OpenFile;
 100    procedure OpenMap;
 101
 102    procedure Resize(const NewSize : Longint);
 103    procedure SetSize(NewSize : Longint); override;
 104  public
 105    constructor Create(const FileName : string;
 106                       const ReadOnly, Temporary : Boolean);
 107    destructor Destroy; override;
 108    procedure Open;
 109      { After the stream has been created, call this method to open the file. }
 110    function Read(var Buffer; Count: Longint): Longint; override;
 111    function Write(const Buffer; Count: Longint): Longint; override;
 112    function Seek(Offset: Longint; Origin: Word): Longint; override;
 113
 114    property ReadOnly : Boolean read FReadOnly;
 115      { Returns True if the file is being opened in read-only mode. }
 116
 117    property CanGrow : Boolean read FCanGrow write FCanGrow;
 118      { If True then the mapped stream can grow in size when data is written
 119        past the current end of the stream. Note this involves closing &
 120        reopening the map which may be expensive time-wise.
 121        Defaults to True. }
 122
 123    property DataSize : Longint read FDataSize;
 124      { The amount of data actually written to the stream. It is calculated
 125        based upon the highest position to which data was written.
 126        For example, if an app seeks to position 100 and writes 100 bytes
 127        of data then the data size is 201. }
 128
 129    property GrowthFactor : Double read FGrowthFactor write FGrowthFactor;
 130      { The factor by which the stream will be grown in size if CanGrow is
 131        True and data is written past the current end of stream.
 132        Defaults to 0.25. }
 133
 134    property Memory: Pointer read mmPointer;
 135      { Points to the memory associated with the file. }
 136
 137    property Size : Longint read FSize write SetSize;
 138      { For temporary files, specify the maximum size of the file via this
 139        property. }
 140  end;
 141
 142{ TIpBufferedStream }
 143type
 144  TIpBufferedStream = class(TStream)
 145    private {- property variables }
 146      FBufCount: Longint;
 147      FBuffer  : PAnsiChar;
 148      FBufOfs  : Longint;
 149      FBufPos  : Longint;
 150      FBufSize : Longint;
 151      FDirty   : Boolean;
 152      FSize    : {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF};
 153      FStream  : TStream;
 154
 155    protected {- methods }
 156      procedure bsInitForNewStream; virtual;
 157      procedure bsReadFromStream;
 158      procedure bsSetStream(aValue : TStream);
 159      procedure bsWriteToStream;
 160
 161    public {- methods }
 162      constructor Create(aStream : TStream);
 163      constructor CreateEmpty;
 164      destructor  Destroy; override;
 165
 166      procedure Flush;                                                 {!!.12}
 167        { Flush any unwritten changes to the stream. }
 168      procedure FreeStream;
 169      function ReadChar(var aCh : AnsiChar) : Boolean;
 170      function Read(var Buffer; Count : Longint) : Longint; override;
 171      function Seek(Offset : Longint; Origin : word) : Longint; override;
 172      function Write(const Buffer; Count : Longint) : Longint; override;
 173
 174    public {-properties }
 175      property FastSize: {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF}
 176        read FSize;
 177      property Stream : TStream
 178        read FStream write bsSetStream;
 179   end;
 180
 181
 182{ TIpAnsiTextStream }
 183type
 184  TIpAnsiTextStream = class(TIpBufferedStream)
 185    private {- property variables }
 186      FLineEndCh   : AnsiChar;
 187      FLineLen     : Integer;
 188      FLineTerm    : TIpLineTerminator;
 189      FFixedLine   : PAnsiChar;
 190      FLineCount   : Longint;
 191      FLineCurrent : Longint;
 192      FLineCurOfs  : Longint;
 193      FLineIndex   : TList;
 194      FLineInxStep : Longint;
 195      FLineInxTop  : Integer;
 196
 197    protected {- methods }
 198      procedure atsGetLine(var aStartPos, aEndPos, aLen : Longint);
 199      function  atsGetLineCount : Longint;
 200      procedure atsResetLineIndex;
 201      procedure atsSetLineTerm(aValue : TIpLineTerminator);
 202      procedure atsSetLineEndCh(aValue : AnsiChar);
 203      procedure atsSetLineLen(aValue : Integer);
 204
 205    public {- properties }
 206      property FixedLineLength : Integer
 207        read FLineLen write atsSetLineLen;
 208      property LineCount : Longint
 209        read atsGetLineCount;
 210      property LineTermChar : AnsiChar
 211        read FLineEndCh write atsSetLineEndCh;
 212      property LineTerminator : TIpLineTerminator
 213        read FLineTerm write atsSetLineTerm;
 214
 215    public {- methods }
 216      constructor Create(aStream : TStream);
 217      destructor Destroy; override;
 218
 219      function  AtEndOfStream : Boolean;
 220      procedure bsInitForNewStream; override;                        {!!.01}
 221      function  ReadLine : string;
 222      function  ReadLineArray(aCharArray : PAnsiChar; aLen : Longint) : Longint;
 223      function  ReadLineZ(aSt : PAnsiChar; aMaxLen : Longint) : PAnsiChar;
 224      function  SeekNearestLine(aOffset : Longint) : Longint;
 225      function  SeekLine(aLineNum : Longint) : Longint;
 226      procedure WriteLine(const aSt : string);
 227      procedure WriteLineArray(aCharArray : PAnsiChar; aLen : Longint);
 228      procedure WriteLineZ(aSt : PAnsiChar);
 229  end;
 230
 231{ TIpDownloadFileStream }
 232type
 233  TIpDownloadFileStream = class(TStream)
 234    private
 235      FHandle   : THandle;
 236      FPath     : string;
 237      FFileName : string;
 238      FRenamed  : boolean;
 239    protected
 240      procedure dfsMakeTempFile(const aPath : string);         
 241    public
 242      constructor Create(const aPath : string);
 243      destructor Destroy; override;
 244
 245      function Read(var Buffer; Count : Longint) : Longint; override;
 246      procedure Rename(aNewName : string);
 247      procedure Move(aNewName: string);
 248      function Seek(Offset : Longint; Origin : Word) : Longint; override;
 249      function Write(const Buffer; Count : Longint) : Longint; override;
 250
 251      property Handle : THandle read FHandle;
 252      property FileName : string read FFileName;
 253  end;
 254
 255
 256{ TIpByteStream }
 257type
 258  TIpByteStream = class
 259    private {variables}
 260      FStream  : TStream;
 261      BufEnd   : Integer;
 262      BufPos   : Integer;
 263      Buffer   : array[0..1023] of Byte;
 264    protected {methods}
 265      function GetPosition : Integer;
 266      function GetSize : Integer;
 267    public {methods}
 268      constructor Create(aStream : TStream);
 269      destructor Destroy; override;
 270      function Read(var b :Byte) : Boolean;
 271    public {properties}
 272      property Position : Integer
 273        read GetPosition;
 274      property Size : longint
 275        read GetSize;
 276  end;
 277
 278
 279
 280
 281implementation
 282
 283const
 284  LineTerm : array [TIpLineTerminator] of
 285               array [0..1] of AnsiChar =
 286                 ('', #13, #10, #13#10, '');
 287
 288const
 289  LineIndexCount = 1024;
 290  LineIndexMax   = pred(LineIndexCount);
 291
 292
 293{--- Helper routines ---------------------------------------------------------}
 294
 295function MinLong(A, B : Longint) : Longint;
 296begin
 297  if A < B then
 298    Result := A
 299  else
 300    Result := B;
 301end;
 302
 303{-----------------------------------------------------------------------------}
 304{                          TIpMemMapStream                                    }
 305{-----------------------------------------------------------------------------}
 306
 307constructor TIpMemMapStream.Create(const FileName : string;
 308                                   const ReadOnly, Temporary : Boolean);
 309begin
 310  inherited Create;
 311
 312  FCanGrow := True;
 313  FDataSize := 0;
 314  FGrowthFactor := 0.25;
 315  FReadOnly := ReadOnly;
 316  FSize := 64 * 1024;
 317  mmFileName := FileName;
 318  mmFileIsTemp := Temporary;
 319end;
 320
 321{-----------------------------------------------------------------------------}
 322
 323destructor TIpMemMapStream.Destroy;
 324begin
 325  CloseMap;
 326  CloseFile;
 327  
 328  { If map file was temporary then get rid of it. }
 329  if mmFileIsTemp and FileExistsUTF8(mmFileName) then
 330    DeleteFileUTF8(mmFileName);
 331
 332  inherited;
 333end;
 334
 335{-----------------------------------------------------------------------------}
 336
 337procedure TIpMemMapStream.CheckClosed(const aMethodName : string);
 338begin
 339  if mmFileHandle <> 0 then
 340    raise EIpBaseException.CreateFmt(SMemMapMustBeClosed, [aMethodName]);
 341end;
 342
 343{-----------------------------------------------------------------------------}
 344
 345procedure TIpMemMapStream.CheckFileName;
 346begin
 347  if mmFileName = '' then
 348    raise EIpBaseException.Create(SMemMapFilenameRequired);
 349end;
 350
 351{-----------------------------------------------------------------------------}
 352
 353procedure TIpMemMapStream.CloseFile;
 354begin
 355  {$IFDEF IP_LAZARUS}
 356  writeln('TIpMemMapStream.CloseFile ToDo');
 357  {$ELSE}
 358  if mmFileHandle <> 0 then
 359    CloseHandle(mmFileHandle);
 360  {$ENDIF}
 361end;
 362
 363{-----------------------------------------------------------------------------}
 364
 365procedure TIpMemMapStream.CloseMap;
 366begin
 367  {$IFDEF IP_LAZARUS}
 368  writeln('TIpMemMapStream.CloseMap ToDo');
 369  {$ELSE}
 370  FlushViewOfFile(mmPointer, 0);
 371  UnMapViewOfFile(mmPointer);
 372  if mmMapHandle <> 0 then
 373    CloseHandle(mmMapHandle);
 374  {$ENDIF}
 375end;
 376
 377{-----------------------------------------------------------------------------}
 378
 379procedure TIpMemMapStream.Open;
 380begin
 381  OpenFile;
 382  OpenMap;
 383end;
 384
 385{-----------------------------------------------------------------------------}
 386
 387procedure TIpMemMapStream.OpenFile;
 388{$IFDEF IP_LAZARUS}
 389begin
 390  writeln('TIpMemMapStream.OpenFile ToDo');
 391end;
 392{$ELSE}
 393var
 394  CreateMode,
 395  Flags,
 396  OpenMode : DWORD;
 397begin
 398
 399  { Check requirements. }
 400  CheckFileName;
 401  CheckClosed('Open');
 402
 403  { Are we opening an existing file or creating a new file? }
 404  if not FileExistsUTF8(mmFileName) then
 405    CreateMode:= CREATE_ALWAYS
 406  else
 407    CreateMode := OPEN_EXISTING;
 408
 409  OpenMode := GENERIC_READ;
 410  if FReadOnly then
 411    Flags := FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN
 412  else begin
 413    OpenMode := OpenMode or GENERIC_WRITE;
 414    Flags := FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS;
 415  end;
 416
 417  mmFileExists := (CreateMode = OPEN_EXISTING);
 418
 419  mmFileHandle := CreateFile(PChar(mmFileName),
 420                             OpenMode,
 421                             0,  { exclusive }
 422                             nil,
 423                             CreateMode,
 424                             Flags,
 425                             0);
 426
 427  if mmFileHandle = INVALID_HANDLE_VALUE then
 428    { Raise exception. }
 429    raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
 430                                  mmFileName);
 431end;
 432{$ENDIF}
 433
 434{-----------------------------------------------------------------------------}
 435
 436procedure TIpMemMapStream.OpenMap;
 437{$IFDEF IP_LAZARUS}
 438begin
 439  writeln('TIpMemMapStream.OpenMap ToDo');
 440end;
 441{$ELSE}
 442var
 443  AccessMode,
 444  ProtectMode,
 445  SizeHigh : DWORD;
 446  Size : DWORD;
 447begin
 448  { If this was an existing file then get the size of the file. }
 449  if mmFileExists then begin
 450    SizeHigh := 0;
 451    Size := GetFileSize(mmFileHandle, @SizeHigh);
 452    FSize := Size;
 453    FDataSize := Size;
 454    if Size = $FFFFFFFF then
 455      { Raise exception. }
 456      raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
 457                                    mmFileName);
 458  end
 459  else
 460    Size := FSize;
 461
 462  { Read-only? }
 463  if FReadOnly then begin
 464    AccessMode := FILE_MAP_READ;
 465    ProtectMode := PAGE_READONLY;
 466  end
 467  else begin
 468    AccessMode := FILE_MAP_ALL_ACCESS;
 469    ProtectMode := PAGE_READWRITE;
 470  end;
 471
 472  mmMapHandle := CreateFileMapping(mmFileHandle, nil, ProtectMode,
 473                                   0, Size, nil);
 474  if mmMapHandle = 0 then
 475    { Raise exception. }
 476    raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
 477                                  mmFileName);
 478
 479  mmPointer := MapViewOfFile(mmMapHandle, AccessMode, 0, 0, Size);
 480  if mmPointer = nil then
 481    raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
 482                                  mmFileName);
 483  mmPos := 0;
 484end;
 485{$ENDIF}
 486
 487{-----------------------------------------------------------------------------}
 488
 489procedure TIpMemMapStream.Resize(const NewSize : Longint);
 490var
 491  SavPos : Longint;
 492begin
 493  { Close the map. }
 494  if NewSize < FSize then
 495    SavPos := 0
 496  else
 497    SavPos := mmPos;
 498  CloseMap;
 499
 500  {$IFDEF IP_LAZARUS}
 501  writeln('TIpMemMapStream.Resize ToDo');
 502  {$ELSE}
 503  { Update the size of the file. }
 504  if SetFilePointer(mmFileHandle, NewSize, nil, FILE_BEGIN) <> $FFFFFFFF then begin
 505    if SetEndOfFile(mmFileHandle) = false then
 506      raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
 507                                    mmFileName);
 508  end
 509  else
 510    raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
 511                                  mmFileName);
 512  {$ENDIF}
 513
 514  { Update internal size information. }
 515  FSize := NewSize;
 516  if FSize < FDataSize then
 517    FDataSize := FSize;
 518
 519  { Re-open the map. }
 520  mmFileExists := True;
 521  OpenMap;
 522  mmPos := SavPos;
 523end;
 524
 525{-----------------------------------------------------------------------------}
 526
 527procedure TIpMemMapStream.SetSize(NewSize : Longint);
 528begin
 529  if mmFileHandle <> 0 then
 530    Resize(NewSize);
 531  FSize := NewSize;
 532end;
 533
 534{-----------------------------------------------------------------------------}
 535
 536function TIpMemMapStream.Read(var Buffer; Count: Longint): Longint;
 537begin
 538  if mmFileHandle = 0 then
 539    raise EIpBaseException.CreateFmt(SMemMapMustBeOpen, ['Read']);
 540  if (mmPos + Count) > FDataSize then
 541    Result := FDataSize - mmPos
 542  else
 543    Result := Count;
 544  Move(PByteArray(mmPointer)[mmPos], Buffer, Result);
 545  inc(mmPos, Result);
 546end;
 547
 548{-----------------------------------------------------------------------------}
 549
 550function TIpMemMapStream.Write(const Buffer; Count: Longint): Longint;
 551var
 552  NewSize : Longint;
 553begin
 554  if mmFileHandle = 0 then
 555    raise EIpBaseException.CreateFmt(SMemMapMustBeOpen, ['Write']);
 556  if not FReadOnly then begin
 557    if (mmPos + Count) > FSize then begin
 558      if FCanGrow then begin
 559        { Grow the stream. }
 560        NewSize := FSize + Trunc(FSize * FGrowthFactor);
 561        if NewSize < FSize + Count then
 562          NewSize := FSize + Count;
 563        Resize(NewSize);
 564        Result := Count;
 565      end
 566      else
 567        Result := FSize - mmPos;
 568    end
 569    else
 570      Result := Count;
 571
 572    Move(Buffer, PByteArray(mmPointer)[mmPos], Result);
 573    inc(mmPos, Result);
 574    if mmPos > FDataSize then
 575      FDataSize := mmPos + 1;
 576  end
 577  else
 578    Result := 0;
 579end;
 580
 581{-----------------------------------------------------------------------------}
 582
 583function TIpMemMapStream.Seek(Offset: Longint; Origin: Word): Longint;
 584begin
 585  if mmFileHandle = 0 then
 586    raise EIpBaseException.CreateFmt(SMemMapMustBeOpen, ['Seek']);
 587  case Origin of
 588    soFromBeginning :
 589      if Offset < 0 then
 590        raise EIpBaseException.Create(SOriginFromBegin)
 591      else
 592        mmPos := Offset;
 593
 594    soFromCurrent   :
 595      mmPos := mmPos + Offset;
 596
 597    soFromEnd       :
 598      if Offset > 0 then
 599        raise EIpBaseException.Create(SOriginFromEnd)
 600      else
 601        mmPos := FSize + Offset;
 602  end;  { case }
 603  Result := mmPos;
 604end;
 605
 606{-----------------------------------------------------------------------------}
 607{                          TIpBufferedStream                                  }
 608{-----------------------------------------------------------------------------}
 609
 610const
 611  BufferSize = 16384; // higher values for more speed but more memory
 612
 613constructor TIpBufferedStream.Create(aStream : TStream);
 614begin
 615  inherited Create;
 616
 617  {allocate the buffer}
 618  FBufSize := BufferSize;
 619
 620  GetMem(FBuffer, FBufSize);
 621
 622  {save the stream}
 623  if (aStream = nil) then
 624    raise EIpBaseException.Create(SNoStreamErr);
 625  FStream := aStream;
 626
 627  bsInitForNewStream;
 628end;
 629
 630{-----------------------------------------------------------------------------}
 631
 632constructor TIpBufferedStream.CreateEmpty;
 633begin
 634  inherited Create;
 635
 636  {allocate the buffer}
 637  FBufSize := BufferSize;
 638  GetMem(FBuffer, FBufSize);
 639  bsInitForNewStream
 640end;
 641
 642{-----------------------------------------------------------------------------}
 643
 644destructor TIpBufferedStream.Destroy;
 645begin
 646  if (FBuffer <> nil) and (FStream <> nil) then
 647    if FDirty then
 648      bsWriteToStream;
 649  FreeMem(FBuffer, FBufSize);
 650
 651  inherited Destroy;
 652end;
 653
 654{-----------------------------------------------------------------------------}
 655
 656procedure TIpBufferedStream.bsInitForNewStream;
 657begin
 658  if (FStream <> nil) then
 659    FSize := FStream.Size
 660  else
 661    FSize := 0;
 662  FBufCount := 0;
 663  FBufOfs := 0;
 664  FBufPos := 0;
 665  FDirty := false;
 666end;
 667
 668{-----------------------------------------------------------------------------}
 669
 670function TIpBufferedStream.ReadChar(var aCh : AnsiChar) : Boolean;
 671begin
 672  {is there anything to read?}
 673  if (FSize = (FBufOfs + FBufPos)) then begin
 674    Result := false;
 675    Exit;
 676  end;
 677  {if we get here, we'll definitely read a character}
 678  Result := true;
 679  {make sure that the buffer has some data in it}
 680  if (FBufCount = 0) then
 681    bsReadFromStream
 682  else if (FBufPos = FBufCount) then begin
 683    if FDirty then
 684      bsWriteToStream;
 685    FBufPos := 0;
 686    inc(FBufOfs, FBufSize);
 687    bsReadFromStream;
 688  end;
 689  {get the next character}
 690  aCh := AnsiChar(FBuffer[FBufPos]);
 691  inc(FBufPos);
 692end;
 693
 694{-----------------------------------------------------------------------------}
 695
 696procedure TIpBufferedStream.bsReadFromStream;
 697var
 698  NewPos : Longint;
 699begin
 700  {assumptions: FBufOfs is where to read the buffer
 701                FBufSize is the number of bytes to read
 702                FBufCount will be the number of bytes read}
 703  NewPos := FStream.Seek(FBufOfs, soFromBeginning);
 704  if (NewPos <> FBufOfs) then
 705    raise EIpBaseException.Create(SNoSeekForRead);
 706  FBufCount := FStream.Read(FBuffer^, FBufSize);
 707end;
 708
 709{-----------------------------------------------------------------------------}
 710
 711procedure TIpBufferedStream.bsSetStream(aValue : TStream);
 712begin
 713  if (aValue <> FStream) then begin
 714    {if the buffer is dirty, flush it to the current stream}
 715    if FDirty and (FStream <> nil) then
 716      bsWriteToStream;
 717    {remember the stream and initialize all fields}
 718    FStream := aValue;
 719    bsInitForNewStream;
 720  end;
 721end;
 722
 723{-----------------------------------------------------------------------------}
 724
 725procedure TIpBufferedStream.bsWriteToStream;
 726var
 727  NewPos       : Longint;
 728  BytesWritten : Longint;
 729begin
 730  {assumptions: FDirty is true
 731                FBufOfs is where to write the buffer
 732                FBufCount is the number of bytes to write
 733                FDirty will be set false afterwards}
 734  NewPos := FStream.Seek(FBufOfs, soFromBeginning);
 735  if (NewPos <> FBufOfs) then
 736    raise EIpBaseException.Create(SNoSeekForWrite);
 737  BytesWritten := FStream.Write(FBuffer^, FBufCount);
 738  if (BytesWritten <> FBufCount) then
 739    raise EIpBaseException.Create(SCannotWriteToStream);
 740  FDirty := false;
 741end;
 742{Begin !!.12}
 743
 744{-----------------------------------------------------------------------------}
 745
 746procedure TIpBufferedStream.Flush;
 747begin
 748  if FDirty then
 749    bsWriteToStream;
 750end;
 751{End !!.12}
 752
 753{-----------------------------------------------------------------------------}
 754
 755procedure TIpBufferedStream.FreeStream ;
 756begin
 757  if (FBuffer <> nil) and (FStream <> nil) then begin
 758    if FDirty then
 759      bsWriteToStream;
 760    FStream.Free;
 761    FStream := nil;
 762  end;
 763end;
 764
 765{-----------------------------------------------------------------------------}
 766
 767function TIpBufferedStream.Read(var Buffer; Count : Longint) : Longint;
 768var
 769  BytesToGo   : Longint;
 770  BytesToRead : Longint;
 771  BufAsBytes  : TByteArray absolute Buffer;
 772  DestPos     : Longint;
 773begin
 774  Result := 0;
 775  if not Assigned(FStream) then
 776    Exit;
 777  {calculate the number of bytes we could read if possible}
 778  BytesToGo := MinLong(Count, FSize - (FBufOfs + FBufPos));
 779  {we will return this number of bytes or raise an exception}
 780  Result := BytesToGo;
 781  {are we going to read some data after all?}
 782  if (BytesToGo > 0) then begin
 783    {make sure that the buffer has some data in it}
 784    if (FBufCount = 0) then
 785      bsReadFromStream;
 786    {read as much as we can from the current buffer}
 787    BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
 788    {transfer that number of bytes}
 789    Move(FBuffer[FBufPos], BufAsBytes[0], BytesToRead);
 790    {update our counters}
 791    inc(FBufPos, BytesToRead);
 792    dec(BytesToGo, BytesToRead);
 793    {if we have more bytes to read then we've reached the end of the
 794     buffer and so we need to read another, and another, etc}
 795    DestPos := 0;
 796    while BytesToGo > 0 do begin
 797      {if the current buffer is dirty, write it out}
 798      if FDirty then
 799        bsWriteToStream;
 800      {position and read the next buffer}
 801      FBufPos := 0;
 802      inc(FBufOfs, FBufSize);
 803      bsReadFromStream;
 804      {calculate the new destination position, and the number of bytes
 805       to read from this buffer}
 806      inc(DestPos, BytesToRead);
 807      BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
 808      {transfer that number of bytes}
 809      Move(FBuffer[FBufPos], BufAsBytes[DestPos], BytesToRead);
 810      {update our counters}
 811      inc(FBufPos, BytesToRead);
 812      dec(BytesToGo, BytesToRead);
 813    end;
 814  end;
 815end;
 816
 817{-----------------------------------------------------------------------------}
 818
 819function TIpBufferedStream.Seek(Offset : Longint; Origin : word) : Longint;
 820var
 821  NewPos : Longint;
 822  NewOfs : Longint;
 823begin
 824  Result := 0;
 825  if not Assigned(FStream) then
 826    Exit;
 827  {optimization: to help code that just wants the current stream
 828   position (ie, reading the Position property), check for this as a
 829   special case}
 830  if (Offset = 0) and (Origin = soFromCurrent) then begin
 831    Result := FBufOfs + FBufPos;
 832    Exit;
 833  end;
 834  {calculate the desired position}
 835  case Origin of
 836    soFromBeginning : NewPos := Offset;
 837    soFromCurrent   : NewPos := (FBufOfs + FBufPos) + Offset;
 838    soFromEnd       : NewPos := FSize + Offset;
 839  else
 840    raise EIpBaseException.Create(SBadSeekOrigin);
 841    NewPos := 0; {to fool the compiler's warning--we never get here}
 842  end;
 843  {force the new position to be valid}
 844  if (NewPos < 0) then
 845    NewPos := 0
 846  else if (NewPos > FSize) then
 847    NewPos := FSize;
 848  {calculate the offset for the buffer}
 849  NewOfs := (NewPos div FBufSize) * FBufSize;
 850  {if the offset differs, we have to move the buffer window}
 851  if (NewOfs <> FBufOfs) then begin
 852    {check to see whether we have to write the current buffer to the
 853     original stream first}
 854    if FDirty then
 855      bsWriteToStream;
 856    {mark the buffer as empty}
 857    FBufOfs := NewOfs;
 858    FBufCount := 0;
 859  end;
 860  {set the position within the buffer}
 861  FBufPos := NewPos - FBufOfs;
 862  Result := NewPos;
 863end;
 864
 865{-----------------------------------------------------------------------------}
 866
 867function TIpBufferedStream.Write(const Buffer; Count : Longint) : Longint;
 868type
 869  TIpByteArray = array[0..MaxInt-1] of Byte;
 870var
 871  BytesToGo   : Longint;
 872  BytesToWrite: Longint;
 873  BufAsBytes  : TIpByteArray absolute Buffer;
 874  DestPos     : Longint;
 875begin
 876  Result := 0;
 877  if not Assigned(FStream) then
 878    Exit;
 879  {calculate the number of bytes we should be able to write}
 880  BytesToGo := Count;
 881  {we will return this number of bytes or raise an exception}
 882  Result := BytesToGo;
 883  {are we going to write some data?}
 884  if (BytesToGo > 0) then begin
 885    {try and make sure that the buffer has some data in it}
 886    if (FBufCount = 0) and ((FBufOfs + FBufPos) < FSize) then
 887      bsReadFromStream;
 888    {write as much as we can to the current buffer}
 889    BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
 890    {transfer that number of bytes}
 891    Move(BufAsBytes[0], FBuffer[FBufPos], BytesToWrite);
 892    FDirty := true;
 893    {update our counters}
 894    inc(FBufPos, BytesToWrite);
 895    if (FBufCount < FBufPos) then begin
 896      FBufCount := FBufPos;
 897      FSize := FBufOfs + FBufPos;
 898    end;
 899    dec(BytesToGo, BytesToWrite);
 900    {if we have more bytes to write then we've reached the end of the
 901     buffer and so we need to write another, and another, etc}
 902    DestPos := 0;
 903    while BytesToGo > 0 do begin
 904      {as the current buffer is dirty, write it out}
 905      bsWriteToStream;
 906      {position and read the next buffer, if required}
 907      FBufPos := 0;
 908      inc(FBufOfs, FBufSize);
 909      if (FBufOfs < FSize) then
 910        bsReadFromStream
 911      else
 912        FBufCount := 0;
 913      {calculate the new destination position, and the number of bytes
 914       to write to this buffer}
 915      inc(DestPos, BytesToWrite);
 916      BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
 917      {transfer that number of bytes}
 918      if BytesToWrite > 0 then
 919        Move(BufAsBytes[DestPos], FBuffer[0], BytesToWrite);
 920      FDirty := true;
 921      {update our counters}
 922      inc(FBufPos, BytesToWrite);
 923      if (FBufCount < FBufPos) then begin
 924        FBufCount := FBufPos;
 925        FSize := FBufOfs + FBufPos;
 926      end;
 927      dec(BytesToGo, BytesToWrite);
 928    end;
 929  end;
 930end;
 931
 932{-----------------------------------------------------------------------------}
 933{                           TIpAnsiTextStream                                 }
 934{-----------------------------------------------------------------------------}
 935
 936constructor TIpAnsiTextStream.Create(aStream : TStream);
 937begin
 938  inherited Create(aStream);
 939
 940  {set up the line index variables}
 941  atsResetLineIndex;
 942end;
 943
 944{-----------------------------------------------------------------------------}
 945
 946destructor TIpAnsiTextStream.Destroy;
 947begin
 948  {if needed, free the fixed line buffer}
 949  if (FFixedLine <> nil) then
 950    FreeMem(FFixedLine, FixedLineLength);
 951  {free the line index}
 952  FLineIndex.Free;
 953  inherited Destroy;
 954end;
 955
 956{-----------------------------------------------------------------------------}
 957
 958function TIpAnsiTextStream.AtEndOfStream : Boolean;
 959begin
 960  Result := FSize = (FBufOfs + FBufPos);
 961end;
 962
 963{-----------------------------------------------------------------------------}
 964
 965procedure TIpAnsiTextStream.atsGetLine(var aStartPos, aEndPos, aLen : Longint);
 966var
 967  Done   : Boolean;
 968  Ch     : AnsiChar;
 969  PrevCh : AnsiChar;
 970  TempLineTerm: Integer;
 971begin
 972  if (LineTerminator = ltNone) then begin
 973    aStartPos := FBufOfs + FBufPos;
 974    aEndPos := Seek(aStartPos + FixedLineLength, soFromBeginning);
 975    aLen := aEndPos - aStartPos;
 976  end
 977  else begin
 978    aStartPos := FBufOfs + FBufPos;
 979    Ch := #0;
 980    Done := false;
 981
 982    // use temp as local variable for speed
 983    case LineTerminator of
 984      ltCRLF : TempLineTerm := 0;
 985      ltLF   : TempLineTerm := 1;
 986      ltCR   : TempLineTerm := 2;
 987      ltOther: TempLineTerm := 3;
 988    else
 989      raise EIpBaseException.Create(SBadLineTerminator);
 990    end;
 991
 992    if FDirty then
 993      bsWriteToStream;
 994
 995    while not Done do
 996    begin
 997      PrevCh := Ch;
 998
 999      {is there anything to read?}
1000      if (FSize = (FBufOfs + FBufPos)) then begin
1001        aEndPos := FBufOfs + FBufPos;
1002        aLen := aEndPos - aStartPos;
1003        Done := True;
1004      end;
1005
1006      {make sure that the buffer has some data in it}
1007      if (FBufCount = 0) then
1008        bsReadFromStream
1009      else if (FBufPos = FBufCount) then begin
1010        FBufPos := 0;
1011        inc(FBufOfs, FBufSize);
1012        bsReadFromStream;
1013      end;
1014
1015      {get the next character}
1016      Ch := AnsiChar(FBuffer[FBufPos]);
1017      inc(FBufPos);
1018
1019      case TempLineTerm of
1020        0   : if (Ch = #10) then begin
1021                     Done := true;
1022                     aEndPos := FBufOfs + FBufPos;
1023                   if PrevCh = #13 then
1024                     aLen := aEndPos - aStartPos - 2
1025                   else
1026                     aLen := aEndPos - aStartPos - 1;
1027                   end;
1028        1   : if (Ch = #10) then begin
1029                     Done := true;
1030                     aEndPos := FBufOfs + FBufPos;
1031                     aLen := aEndPos - aStartPos - 1;
1032                   end;
1033        2   : if (Ch = #13) then begin
1034                     Done := true;
1035                     aEndPos := FBufOfs + FBufPos;
1036                       aLen := aEndPos - aStartPos - 1;
1037                   end;
1038        3   : if (Ch = LineTermChar) then begin
1039                     Done := true;
1040                     aEndPos := FBufOfs + FBufPos;
1041                     aLen := aEndPos - aStartPos - 1;
1042                   end;
1043      end;
1044    end;
1045  end;
1046end;
1047
1048{-----------------------------------------------------------------------------}
1049
1050function TIpAnsiTextStream.atsGetLineCount : Longint;
1051begin
1052  if FLineCount < 0 then
1053    Result := MaxLongInt
1054  else
1055    Result := FLineCount;
1056end;
1057
1058{-----------------------------------------------------------------------------}
1059
1060procedure TIpAnsiTextStream.atsResetLineIndex;
1061begin
1062  {make sure we have a line index}
1063  if (FLineIndex = nil) then begin
1064    FLineIndex := TList.Create;  {create the index: even elements are}
1065    FLineIndex.Count := LineIndexCount * 2; {linenums, odd are offsets}
1066
1067    {if we didn't have a line index, set up some reasonable defaults}
1068    FLineTerm := ltCRLF;  {normal Windows text file terminator}
1069    FLineEndCh := #10;    {not used straight away}
1070    FLineLen := 80;       {not used straight away}
1071  end;
1072  FLineIndex[0] := pointer(0); {the first line is line 0 and...}
1073  FLineIndex[1] := pointer(0); {...it starts at position 0}
1074  FLineInxTop := 0;            {the top valid index}
1075  FLineInxStep := 1;           {step count before add a line to index}
1076  FLineCount := -1;            {number of lines (-1 = don't know)}
1077  FLineCurrent := 0;           {current line}
1078  FLineCurOfs := 0;            {current line offset}
1079end;
1080
1081{-----------------------------------------------------------------------------}
1082
1083procedure TIpAnsiTextStream.atsSetLineTerm(aValue : TIpLineTerminator);
1084begin
1085  if (aValue <> LineTerminator) and ((FBufOfs + FBufPos) = 0) then begin
1086    {if there was no terminator, free the line buffer}
1087    if (LineTerminator = ltNone) then begin
1088      FreeMem(FFixedLine, FixedLineLength);
1089      FFixedLine := nil;
1090    end;
1091    {set the new value}
1092    FLineTerm := aValue;
1093    {if there is no terminator now, allocate the line buffer}
1094    if (LineTerminator = ltNone) then begin
1095      GetMem(FFixedLine, FixedLineLength);
1096    end;
1097    atsResetLineIndex;
1098  end;
1099end;
1100
1101{-----------------------------------------------------------------------------}
1102
1103procedure TIpAnsiTextStream.atsSetLineEndCh(aValue : AnsiChar);
1104begin
1105  if ((FBufOfs + FBufPos) = 0) then begin
1106    FLineEndCh := aValue;
1107    atsResetLineIndex;
1108  end;
1109end;
1110
1111{-----------------------------------------------------------------------------}
1112
1113procedure TIpAnsiTextStream.atsSetLineLen(aValue : Integer);
1114begin
1115  if (aValue <> FixedLineLength) and ((FBufOfs + FBufPos) = 0) then begin
1116    {validate the new length first}
1117    if (aValue < 1) or (aValue > 1024) then
1118      raise EIpBaseException.Create(SBadLineLength);
1119
1120    {set the new value; note that if there is no terminator we need to
1121     free the old line buffer, and then allocate a new one}
1122    if (LineTerminator = ltNone) then
1123      FreeMem(FFixedLine, FixedLineLength);
1124    FLineLen := aValue;
1125    if (LineTerminator = ltNone) then
1126      GetMem(FFixedLine, FixedLineLength);
1127    atsResetLineIndex;
1128  end;
1129end;
1130
1131{-----------------------------------------------------------------------------}
1132
1133procedure TIpAnsiTextStream.bsInitForNewStream;
1134begin
1135  inherited bsInitForNewStream;
1136  atsResetLineIndex;
1137end;
1138
1139{-----------------------------------------------------------------------------}
1140
1141function TIpAnsiTextStream.ReadLine : string;
1142var
1143  CurPos : Longint;
1144  EndPos : Longint;
1145  Len    : Longint;
1146  StLen  : Longint;
1147begin
1148  if not Assigned(FStream) then
1149    Exit;
1150  atsGetLine(CurPos, EndPos, Len);
1151  if (LineTerminator = ltNone) then begin
1152    {at this point, Len will either equal FixedLineLength, or it will
1153     be less than it because we read the last line of all and it was
1154     short}
1155    StLen := FixedLineLength;
1156    {$IFDEF MSWindows}
1157    SetLength(Result, StLen);
1158    {$ELSE}
1159    {$IFDEF IP_LAZARUS}
1160    SetLength(Result, StLen);
1161    {$ELSE}
1162    if (StLen > 255) then
1163      StLen := 255;
1164    Result[0] := char(StLen);
1165    {$ENDIF}
1166    {$ENDIF}
1167    if (Len < StLen) then
1168      FillChar(Result[Len+1], StLen-Len, ' ');
1169  end
1170  else {LineTerminator is not ltNone} begin
1171    {$IFDEF MSWindows}
1172    SetLength(Result, Len);
1173    {$ELSE}
1174    {$IFDEF IP_LAZARUS}
1175    SetLength(Result, Len);
1176    {$ELSE}
1177    if (Len > 255) then
1178      Len := 255;
1179    Result[0] := char(Len);
1180    {$ENDIF}
1181    {$ENDIF}
1182  end;
1183  {read the line}
1184  Seek(CurPos, soFromBeginning);
1185  if Len > 0 then
1186    Read(Result[1], Len);
1187  Seek(EndPos, soFromBeginning);
1188end;
1189
1190{-----------------------------------------------------------------------------}
1191
1192function TIpAnsiTextStream.ReadLineArray(aCharArray : PAnsiChar;
1193                                         aLen       : Longint)
1194                                                    : Longint;
1195var
1196  CurPos : Longint;
1197  EndPos : Longint;
1198  Len    : Longint;
1199  StLen  : Longint;
1200begin
1201  Result := 0;
1202  if not Assigned(FStream) then
1203    Exit;
1204  atsGetLine(CurPos, EndPos, Len);
1205  if (LineTerminator = ltNone) then begin
1206    {at this point, Len will either equal FixedLineLength, or it will
1207     be less than it because we read the last line of all and it was
1208     short}
1209    StLen := FixedLineLength;
1210    if (StLen > aLen) then
1211      StLen := aLen;
1212    if (Len < StLen) then
1213      FillChar(aCharArray[Len], StLen-Len, ' ');
1214    Result := StLen;
1215  end
1216  else {LineTerminator is not ltNone} begin
1217    if (Len > aLen) then
1218      Len := aLen;
1219    Result := Len;
1220  end;
1221  Seek(CurPos, soFromBeginning);
1222  Read(aCharArray[0], Len);
1223  Seek(EndPos, soFromBeginning);
1224end;
1225
1226{-----------------------------------------------------------------------------}
1227
1228function TIpAnsiTextStream.ReadLineZ(aSt : PAnsiChar; aMaxLen : Longint) : PAnsiChar;
1229var
1230  CurPos : Longint;
1231  EndPos : Longint;
1232  Len    : Longint;
1233  StLen  : Longint;
1234begin
1235  Result := nil;
1236  if not Assigned(FStream) then
1237    Exit;
1238  Result := aSt;
1239  atsGetLine(CurPos, EndPos, Len);
1240  if (LineTerminator = ltNone) then begin
1241    {at this point, Len will either equal FixedLineLength, or it will
1242     be less than it because we read the last line of all and it was
1243     short}
1244    StLen := FixedLineLength;
1245    if (StLen > aMaxLen) then
1246      StLen := aMaxLen;
1247    if (Len < StLen) then
1248      FillChar(Result[Len], StLen-Len, ' ');
1249    Result[StLen] := #0;
1250  end
1251  else {LineTerminator is not ltNone} begin
1252    if (Len > aMaxLen) then
1253      Len := aMaxLen;
1254    Result[Len] := #0;
1255  end;
1256  Seek(CurPos, soFromBeginning);
1257  Read(Result[0], Len);
1258  Seek(EndPos, soFromBeginning);
1259end;
1260
1261{-----------------------------------------------------------------------------}
1262
1263function TIpAnsiTextStream.SeekNearestLine(aOffset : Longint) : Longint;
1264var
1265  CurLine : Longint;
1266  CurOfs  : Longint;
1267  CurPos  : Longint;
1268  EndPos  : Longint;
1269  Len     : Longint;
1270  i       : Longint;
1271  Done    : Boolean;
1272  L, R, M : Integer;
1273begin
1274  Result := 0;
1275  if not Assigned(FStream) then
1276    Exit;
1277  {if the offset we want is for the current line, reposition at the
1278   current line offset, return the current line number and exit}
1279  if (aOffset = FLineCurOfs) then begin
1280    Seek(FLineCurOfs, soFromBeginning);
1281    Result := FLineCurrent;
1282    Exit;
1283  end;
1284  {if the offset requested is less than or equal to zero, just
1285   position at line zero (ie, the start of the stream)}
1286  if (aOffset <= 0) then begin
1287    Seek(0, soFromBeginning);
1288    FLineCurrent := 0;
1289    FLineCurOfs := 0;
1290    Result := 0;
1291    Exit;
1292  end;
1293  {if the offset requested is greater than or equal to the size of the
1294   stream, position at the end of the stream (note that if we don't
1295   know the number of lines in the stream yet, FLineCount is set to
1296   -1 and we can't take this shortcut because we need to return the
1297   true value)}
1298  if (FLineCount >= 0) and (aOffset >= FSize) then begin
1299    Seek(0, soFromEnd);
1300    FLineCurrent := FLineCount;
1301    FLineCurOfs := FSize;
1302    Result := FLineCount;
1303    Exit;
1304  end;
1305  {if the offset requested is greater than the top item in the
1306   line index, we shall have to build up the index until we get to the
1307   line we require, or just beyond}
1308  if (aOffset > {%H-}Longint(FLineIndex[FLineInxTop+1])) then begin
1309    {position at the last known line offset}
1310    CurLine := {%H-}Longint(FLineIndex[FLineInxTop]);
1311    CurOfs := {%H-}Longint(FLineIndex[FLineInxTop+1]);
1312    Seek(CurOfs, soFromBeginning);
1313    Done := false;
1314    {continue reading lines in chunks of FLineInxStep and add an index
1315     entry for each chunk}
1316    while not Done do begin
1317      for i := 0 to pred(FLineInxStep) do begin
1318        atsGetLine(CurPos, EndPos, Len);
1319        inc(CurLine);
1320        CurOfs := EndPos;
1321        if (EndPos = FSize) then begin
1322          Done := true;
1323          Break;
1324        end;
1325      end;
1326      if Done then
1327        FLineCount := CurLine
1328      else begin
1329        inc(FLineInxTop, 2);
1330        if (FLineInxTop = (LineIndexCount * 2)) then begin
1331          {we've exhausted the space in the index: rescale}
1332          FLineInxTop := FLineInxTop div 2;
1333          for i := 0 to pred(FLineInxTop) do begin
1334            if Odd(i) then
1335              FLineIndex.Exchange((i*2)-1, i)
1336            else
1337              FLineIndex.Exchange(i*2, i);
1338          end;
1339          FLineInxStep := FLineInxStep * 2;
1340        end;
1341        FLineIndex[FLineInxTop] := {%H-}pointer(CurLine);
1342        FLineIndex[FLineInxTop+1] := {%H-}pointer(CurOfs);
1343        if (aOffset <= CurOfs) then
1344          Done := true;
1345      end;
1346    end;
1347  end;
1348  {we can now work out where the nearest item in the index is to the
1349   line we require}
1350  L := 1;
1351  R := FLineInxTop+1;
1352  while (L <= R) do begin
1353    M := (L + R) div 2;
1354    if not Odd(M) then
1355      inc(M);
1356    if (aOffset < {%H-}Longint(FLineIndex[M])) then
1357      R := M - 2
1358    else if (aOffset > {%H-}Longint(FLineIndex[M])) then
1359      L := M + 2
1360    else begin
1361      FLineCurrent := {%H-}Longint(FLineIndex[M-1]);
1362      FLineCurOfs := {%H-}Longint(FLineIndex[M]);
1363      Seek(FLineCurOfs, soFromBeginning);
1364      Result := FLineCurrent;
1365      Exit;
1366    end;
1367  end;
1368  {the item at L-2 will have the nearest smaller offset than the
1369   one we want, hence the nearest smaller line is at L-3; start here
1370   and read through the stream forwards}
1371  CurLine := {%H-}Longint(FLineIndex[L-3]);
1372  Seek({%H-}Longint(FLineIndex[L-2]), soFromBeginning);
1373  while true do begin
1374    atsGetLine(CurPos, EndPos, Len);
1375    inc(CurLine);
1376    if (EndPos > aOffset) then begin
1377      FLineCurrent := CurLine - 1;
1378       FLineCurOfs := CurPos;
1379      Seek(CurPos, soFromBeginning);
1380      Result := CurLine - 1;
1381      Exit;
1382    end
1383    else if (CurLine = FLineCount) or (EndPos = aOffset) then begin
1384      FLineCurrent := CurLine;
1385      FLineCurOfs := EndPos;
1386      Seek(EndPos, soFromBeginning);
1387      Result := CurLine;
1388      Exit;
1389    end;
1390  end;
1391end;
1392
1393{-----------------------------------------------------------------------------}
1394
1395function TIpAnsiTextStream.SeekLine(aLineNum : Longint) : Longint;
1396var
1397  CurLine : Longint;
1398  CurOfs  : Longint;
1399  CurPos  : Longint;
1400  EndPos  : Longint;
1401  Len     : Longint;
1402  i       : Longint;
1403  Done    : Boolean;
1404  L, R, M : Integer;
1405begin
1406  Result := 0;
1407  if not Assigned(FStream) then
1408    Exit;
1409  {if the line number we want is the current line, reposition at the
1410   current line offset, return the current line number and exit}
1411  if (aLineNum = FLineCurrent) then begin
1412    Seek(FLineCurOfs, soFromBeginning);
1413    Result := FLineCurrent;
1414    Exit;
1415  end;
1416  {if the line number requested is less than or equal to zero, just
1417   position at line zero (ie, the start of the stream)}
1418  if (aLineNum <= 0) then begin
1419    Seek(0, soFromBeginning);
1420    FLineCurrent := 0;
1421    FLineCurOfs := 0;
1422    Result := 0;
1423    Exit;
1424  end;
1425  {if the line number requested is greater than or equal to the line
1426   count, position at the end of the stream (note that if we don't
1427   know the number of lines in the stream yet, FLineCount is set to
1428   -1)}
1429  if (FLineCount >= 0) and (aLineNum > FLineCount) then begin
1430    Seek(0, soFromEnd);
1431    FLineCurrent := FLineCount;
1432    FLineCurOfs := FSize;
1433    Result := FLineCount;
1434    Exit;
1435  end;
1436  {if the line number requested is greater than the top item in the
1437   line index, we shall have to build up the index until we get to the
1438   line we require, or just beyond}
1439  if (aLineNum > {%H-}Longint(FLineIndex[FLineInxTop])) then begin
1440    {position at the last known line offset}
1441    CurLine := {%H-}Longint(FLineIndex[FLineInxTop]);
1442    CurOfs := {%H-}Longint(FLineIndex[FLineInxTop+1]);
1443    Seek(CurOfs, soFromBeginning);
1444    Done := false;
1445    {continue reading lines in chunks of FLineInxStep and add an index
1446     entry for each chunk}
1447    while not Done do begin
1448      for i := 0 to pred(FLineInxStep) do begin
1449        atsGetLine(CurPos, EndPos, Len);
1450        inc(CurLine);
1451        CurOfs := EndPos;
1452        if (EndPos = FSize) then begin
1453          Done := true;
1454          Break;
1455        end;
1456      end;
1457      if Done then
1458        FLineCount := CurLine
1459      else begin
1460        inc(FLineInxTop, 2);
1461        if (FLineInxTop = (LineIndexCount * 2)) then begin
1462          {we've exhausted the space in the index: rescale}
1463          FLineInxTop := FLineInxTop div 2;
1464          for i := 0 to pred(FLineInxTop) do begin
1465            if Odd(i) then
1466              FLineIndex.Exchange((i*2)-1, i)
1467            else
1468              FLineIndex.Exchange(i*2, i);
1469          end;
1470          FLineInxStep := FLineInxStep * 2;
1471        end;
1472        FLineIndex[FLineInxTop] := {%H-}pointer(CurLine);
1473        FLineIndex[FLineInxTop+1] := {%H-}pointer(CurOfs);
1474        if (aLineNum <= CurLine) then
1475          Done := true;
1476      end;
1477    end;
1478  end;
1479  {we can now work out where the nearest item in the index is to the
1480   line we require}
1481  L := 0;
1482  R := FLineInxTop;
1483  while (L <= R) do begin
1484    M := (L + R) div 2;
1485    if Odd(M) then
1486      dec(M);
1487    if (aLineNum < {%H-}Longint(FLineIndex[M])) then
1488      R := M - 2
1489    else if (aLineNum > {%H-}Longint(FLineIndex[M])) then
1490      L := M + 2
1491    else begin
1492      FLineCurrent := {%H-}Longint(FLineIndex[M]);
1493      FLineCurOfs := {%H-}Longint(FLineIndex[M+1]);
1494      Seek(FLineCurOfs, soFromBeginning);
1495      Result := FLineCurrent;
1496      Exit;
1497    end;
1498  end;
1499  {the item at L-2 will have the nearest smaller line number than the
1500   one we want; start here and read through the stream forwards}
1501  CurLine := Longint({%H-}PtrInt(FLineIndex[L-2]));
1502  Seek(Longint({%H-}PtrInt(FLineIndex[L-1])), soFromBeginning);
1503  while true do begin
1504    atsGetLine(CurPos, EndPos, Len);
1505    inc(CurLine);
1506    if (CurLine = FLineCount) or (CurLine = aLineNum) then begin
1507      FLineCurrent := CurLine;
1508      FLineCurOfs := EndPos;
1509      Seek(EndPos, soFromBeginning);
1510      Result := CurLine;
1511      Exit;
1512    end;
1513  end;
1514end;
1515
1516{-----------------------------------------------------------------------------}
1517
1518procedure TIpAnsiTextStream.WriteLine(const aSt : string);
1519{Rewritten !!.15}
1520begin
1521  if Length(aSt) > 0 then
1522    WriteLineArray(@aSt[1], length(aSt))
1523  else
1524    WriteLineArray(nil, 0);
1525end;
1526
1527{-----------------------------------------------------------------------------}
1528
1529procedure TIpAnsiTextStream.WriteLineArray(aCharArray : PAnsiChar;
1530                                           aLen       : Longint);
1531var
1532  C : AnsiChar;
1533begin
1534  if not Assigned(FStream) then
1535    Exit;
1536  if (aCharArray = nil) then
1537    aLen := 0;
1538  if (LineTerminator = ltNone) then begin
1539    if (aLen >= FixedLineLength) then
1540      Write(aCharArray[0], FixedLineLength)
1541    else begin
1542      FillChar(FFixedLine[aLen], FixedLineLength-aLen, ' ');
1543      if (aLen > 0) then
1544        Move(aCharArray[0], FFixedLine[0], aLen);
1545      Write(FFixedLine[0], FixedLineLength);
1546    end;
1547  end
1548  else begin
1549    if (aLen > 0) then
1550      Write(aCharArray[0], aLen);
1551    case LineTerminator of
1552      ltNone : {this'll never get hit};
1553      ltCR   : Write(LineTerm[ltCR], 1);
1554      ltLF   : Write(LineTerm[ltLF], 1);
1555      ltCRLF : Write(LineTerm[ltCRLF], 2);
1556      ltOther: begin
1557                 C := LineTermChar;
1558                 Write(C, 1);
1559               end;
1560    else
1561      raise EIpBaseException.Create(SBadLineTerminator);
1562    end;
1563  end;
1564end;
1565
1566{-----------------------------------------------------------------------------}
1567
1568procedure TIpAnsiTextStream.WriteLineZ(aSt : PAnsiChar);
1569var
1570  LenSt : Longint;
1571begin
1572  if not Assigned(FStream) then
1573    Exit;
1574  if (aSt = nil) then
1575    LenSt := 0
1576  else
1577    LenSt := StrLen(aSt);
1578  WriteLineArray(aSt, LenSt);
1579end;
1580
1581
1582{ TIpDownloadFileStream }
1583
1584constructor TIpDownloadFileStream.Create(const aPath : string);
1585begin
1586  FHandle := IpFileOpenFailed;
1587  inherited Create;
1588  dfsMakeTempFile(aPath);
1589
1590  FHandle := THandle(FileOpen(FFileName, fmShareDenyNone + fmOpenReadWrite));
1591  if (Handle = IpFileOpenFailed) then
1592{$IFDEF Version6OrHigher}
1593    RaiseLastOSError; 
1594{$ELSE}
1595    RaiseLastWin32Error;
1596{$ENDIF}
1597end;
1598
1599destructor TIpDownloadFileStream.Destroy;
1600begin
1601  {$IFDEF IP_LAZARUS}
1602  writeln('ToDo: TIpDownloadFileStream.Destroy ');
1603  {$ELSE}
1604  FlushFileBuffers(FHandle);
1605  if (Handle <> INVALID_HANDLE_VALUE) then
1606    CloseHandle(Handle);
1607  {$ENDIF}
1608  inherited Destroy;
1609end;
1610
1611procedure TIpDownloadFileStream.dfsMakeTempFile(const aPath : string);
1612begin
1613  { Make sure the path has no backslash. }
1614  if aPath[length(aPath)] = '\' then
1615    FPath := Copy(aPath, 1, pred(length(aPath)))
1616  else
1617    FPath := aPath;
1618
1619  { Check that it really exists. }
1620  if not DirExists(aPath) then
1621    raise EIpBaseException.Create(SBadPath);
1622
1623  { Create a new uniquely named file in that folder. }
1624  FFileName := GetTemporaryFile(FPath);                                {!!.12}
1625end;
1626
1627function TIpDownloadFileStream.Read(var Buffer; Count : Longint) : Longint;
1628{$IFDEF IP_LAZARUS}
1629begin
1630  writeln('ToDo: TIpDownloadFileStream.Read ');
1631  Result:=0;
1632end;
1633{$ELSE}
1634var
1635  ReadOK : Bool;
1636begin
1637  ReadOK := ReadFile(Handle, Buffer, Count, DWord(Result), nil);
1638
1639  if not ReadOK then begin
1640    raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename + FFileName);
1641    Result := 0;
1642  end;
1643end;
1644{$ENDIF}
1645
1646procedure TIpDownloadFileStream.Rename(aNewName : string);
1647var
1648  NewFullName : string;
1649begin
1650  {$IFDEF IP_LAZARUS}
1651  writeln('ToDo: TIpDownloadFileStream.Rename ');
1652  {$ENDIF}
1653  {close the current handle}
1654  {$IFNDEF IP_LAZARUS}
1655  CloseHandle(Handle);
1656  {$ENDIF}
1657  FHandle := IpFileOpenFailed;
1658  {calculate the full new name}
1659  NewFullName := FPath + '\' + aNewName;
1660  {rename the file}
1661{$IFDEF Version6OrHigher}
1662  {$IFNDEF IP_LAZARUS}
1663  if not MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)) then
1664    RaiseLastOSError;
1665  {$ENDIF}
1666{$ELSE}
1667  Win32Check(MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)));
1668{$ENDIF}
1669  {open up the same file, but with its new name}
1670  FFileName := NewFullName;
1671  try
1672    FHandle := THandle(FileOpen(FFileName, fmShareDenyNone + fmOpenRead));
1673  except
1674    { do nothing }
1675  end;
1676
1677  if (Handle = IpFileOpenFailed) then
1678{$IFDEF Version6OrHigher}
1679    RaiseLastOSError;
1680{$ELSE}
1681    RaiseLastWin32Error;
1682{$ENDIF}
1683
1684  FRenamed  := true;
1685end;
1686
1687procedure TIpDownloadFileStream.Move(aNewName : string);
1688begin
1689  {$IFDEF IP_LAZARUS}
1690  writeln('ToDo: TIpDownloadFileStream.Move ');
1691  {$ENDIF}
1692  {close the current handle}
1693  {$IFNDEF IP_LAZARUS}
1694  CloseHandle(Handle);
1695  {$ENDIF}
1696  FHandle := IpFileOpenFailed;
1697  {copy the file}                                                      {!!.01}
1698{$IFDEF Version6OrHigher}
1699  {$IFNDEF IP_LAZARUS}
1700  if not CopyFile(PAnsiChar(FFileName), PAnsiChar(aNewName), False) then
1701    RaiseLastOSError;
1702  {$ENDIF}
1703{$ELSE}
1704  Win32Check(CopyFile(PAnsiChar(FFileName),                            {!!.01}
1705    PAnsiChar(aNewName), False));                                      {!!.01}
1706{$ENDIF}
1707
1708  {open up the same file, but with its new name}
1709  FFileName := aNewName;
1710  try
1711    FHandle := THandle(FileOpen(FFileName, fmShareDenyNone + fmOpenRead));
1712  except
1713    { do nothing }
1714  end;
1715
1716  if (Handle = IpFileOpenFailed) then
1717{$IFDEF Version6OrHigher}
1718    RaiseLastOSError;
1719{$ELSE}
1720    RaiseLastWin32Error;
1721{$ENDIF}
1722
1723  FRenamed  := true;
1724end;
1725
1726function TIpDownloadFileStream.Seek(Offset : Longint; Origin : Word) : Longint;
1727begin
1728  {$IFDEF IP_LAZARUS}
1729  writeln('ToDo: TIpDownloadFileStream.Seek');
1730  Result := 0;
1731  {$ELSE}
1732  Result := SetFilePointer(Handle, Offset, nil, Origin);
1733  {$ENDIF}
1734end;
1735
1736function TIpDownloadFileStream.Write(const Buffer; Count : Longint) : Longint;
1737{$IFDEF IP_LAZARUS}
1738begin
1739  writeln('ToDo: TIpDownloadFileStream.Write');
1740  Result:=Count;
1741end;
1742{$ELSE}
1743var
1744  WriteOK : Bool;
1745begin
1746  WriteOK := WriteFile(Handle, Buffer, Count, DWord(Result), nil);
1747
1748  if not WriteOK then begin
1749    raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename + FFileName);
1750    Result := 0
1751  end;
1752end;
1753{$ENDIF}
1754
1755
1756{ TIpByteStream }
1757constructor TIpByteStream.Create(aStream : TStream);
1758begin
1759  inherited Create;
1760  FStream := aStream;
1761end;
1762
1763destructor TIpByteStream.Destroy;
1764begin
1765  inherited Destroy;
1766end;
1767
1768function TIpByteStream.Read(var b : Byte) : Boolean;
1769begin
1770  Result := True;
1771  if (BufPos = BufEnd) then begin
1772    BufPos := 0;
1773    BufEnd := FStream.Read(Buffer, SizeOf(Buffer));
1774    if (BufEnd = 0) then begin
1775      Result := False;
1776      Exit;
1777    end;
1778  end;
1779  b := Buffer[BufPos];
1780  Inc(BufPos);
1781end;
1782
1783function TIpByteStream.GetPosition : Integer;
1784begin
1785  Result := FStream.Position - BufEnd + BufPos;
1786end;
1787
1788function TIpByteStream.GetSize : Integer;
1789begin
1790  Result := FStream.Size;
1791end;
1792
1793end.
1794