ststrms.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StStrms.pas 4.03                            *}
{*********************************************************}
{* SysTools: Specialized Stream Classes for SysTools     *}
{*********************************************************}

{$I StDefine.inc}

unit StStrms;

interface

uses
  Windows,
  SysUtils,
  Classes,

  StBase,
  StConst;

type
  TStMemSize = Integer;

  TStBufferedStream = class(TStream)
    private
      FBufCount: TStMemSize;   {count of valid bytes in buffer}
      FBuffer  : PAnsiChar;    {buffer into underlying stream}
      FBufOfs  : longint;      {offset of buffer in underlying stream}
      FBufPos  : TStMemSize;   {current position in buffer}
      FBufSize : TStMemSize;   {size of buffer}
      FDirty   : boolean;      {has data in buffer been changed?}
      FSize    : longint;      {size of underlying stream}
      FStream  : TStream;      {underlying stream}
      {$IFNDEF VERSION3}
      FOnSetStreamSize : TStSetStreamSize;
                               {event to set underlying stream's size}
      {$ENDIF}
    protected
      procedure bsSetStream(aValue : TStream);

      procedure bsInitForNewStream; virtual;
      function bsReadChar(var aCh : AnsiChar) : boolean;
      procedure bsReadFromStream;
      procedure bsWriteToStream;

      {$IFDEF VERSION3}
      procedure SetSize(NewSize : longint); override;
      {$ENDIF}
    public
      constructor Create(aStream : TStream);
      constructor CreateEmpty;
      destructor Destroy; override;

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
      {$IFNDEF VERSION3}
      procedure SetSize(NewSize : longint);
      {$ENDIF}

      property FastSize : longint read FSize;
      property Stream : TStream read FStream write bsSetStream;

      {$IFNDEF VERSION3}
      property OnSetStreamSize : TStSetStreamSize
                 read FOnSetStreamSize write FOnSetStreamSize;
      {$ENDIF}
   end;

type
{!!.01 - moved to StBase.pas }
(*
  TStLineTerminator = ( {possible line terminators...}
     ltNone,            {..no terminator, ie fixed length lines}
     ltCR,              {..carriage return (#13)}
     ltLF,              {..line feed (#10)}
     ltCRLF,            {..carriage return/line feed (#13/#10)}
     ltOther);          {..another character}
*)
{!!.01 - end moved }


  TStAnsiTextStream = class(TStBufferedStream)
    private
      FLineEndCh   : AnsiChar;
      FLineLen     : integer;
      FLineTerm    : TStLineTerminator;
      FFixedLine   : PAnsiChar;
      FLineCount   : longint;
      FLineCurrent : longint;
      FLineCurOfs  : longint;
      FLineIndex   : TList;
      FLineInxStep : longint;
      FLineInxTop  : integer;
    protected
      function atsGetLineCount : longint;

      procedure atsSetLineTerm(aValue : TStLineTerminator);
      procedure atsSetLineEndCh(aValue : AnsiChar);
      procedure atsSetLineLen(aValue : integer);

      procedure atsGetLine(var aStartPos : longint;
                           var aEndPos   : longint;
                           var aLen      : longint);
      procedure atsResetLineIndex;

      procedure bsInitForNewStream; override;
    public
      constructor Create(aStream : TStream);
      destructor Destroy; override;

      function AtEndOfStream : boolean;

      function ReadLine : string;
      function ReadLineArray(aCharArray : PAnsiChar; aLen : TStMemSize)
                                                          : TStMemSize;
      function ReadLineZ(aSt : PAnsiChar; aMaxLen : TStMemSize) : PAnsiChar;

      function SeekNearestLine(aOffset : longint) : longint;
      function SeekLine(aLineNum : longint) : longint;

      procedure WriteLine(const aSt : string);
      procedure WriteLineArray(aCharArray : PAnsiChar; aLen : TStMemSize);
      procedure WriteLineZ(aSt : PAnsiChar);

      property FixedLineLength : integer
                  read FLineLen write atsSetLineLen;
      property LineCount : longint
                  read atsGetLineCount;
      property LineTermChar : AnsiChar
                  read FLineEndCh write atsSetLineEndCh;
      property LineTerminator : TStLineTerminator
                  read FLineTerm write atsSetLineTerm;
  end;

  TStMemoryMappedFile = class(TStream)
  protected {private}
    FBuffer     : Pointer;
    FHeaderSize : Word;
    FDataSize   : Cardinal;
    FHandle     : THandle;
    FMapObj     : THandle;
    FMaxHi      : Cardinal;
    FMaxLo      : Cardinal;
    FMutex      : THandle;
    FPos        : Cardinal;
    FReadOnly   : Boolean;
    FSharedData : Boolean;

  protected
    function GetDataSize : Cardinal;

  public
    constructor Create(const FileName   : string;                      {!!.02}
                             MaxSize    : Cardinal;
                             ReadOnly   : Boolean;
                             SharedData : Boolean);
    destructor Destroy; override;

    function Read(var Buffer; Count : Longint) : Longint; override;
    function Seek(Offset : Longint; Origin : Word) : Longint; override;
    function Write(const Buffer; Count : Longint) : Longint; override;

    property DataSize : Cardinal
      read GetDataSize;

    property MaxSize : Cardinal
      read FMaxLo;

    property Position : Cardinal
      read FPos;

    property ReadOnly : Boolean
      read FReadOnly;

    property SharedData : Boolean
      read FSharedData;
  end;

implementation

const
  LineTerm : array [TStLineTerminator] of
               array [0..1] of AnsiChar =
                 ('', #13, #10, #13#10, '');

const
  LineIndexCount = 1024;
  LineIndexMax   = pred(LineIndexCount);


{--- Helper routines ---------------------------------------------------------}

function MinLong(A, B : longint) : longint;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;


{-----------------------------------------------------------------------------}
{                          TStBufferedStream                                  }
{-----------------------------------------------------------------------------}

constructor TStBufferedStream.Create(aStream : TStream);
begin
  inherited Create;

  {allocate the buffer}
  FBufSize := 4096;
  GetMem(FBuffer, FBufSize);

  {save the stream}
  if (aStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  FStream := aStream;

  bsInitForNewStream;
end;

{-----------------------------------------------------------------------------}

constructor TStBufferedStream.CreateEmpty;
begin
  inherited Create;

  {allocate the buffer}
  FBufSize := 4096;
  GetMem(FBuffer, FBufSize);

  bsInitForNewStream
end;

{-----------------------------------------------------------------------------}

destructor TStBufferedStream.Destroy;
begin
  if (FBuffer <> nil) then begin
    if FDirty and (FStream <> nil) then
      bsWriteToStream;
    FreeMem(FBuffer, FBufSize);
  end;

  inherited Destroy;
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsInitForNewStream;
begin
  if (FStream <> nil) then
    FSize := FStream.Size
  else
    FSize := 0;
  FBufCount := 0;
  FBufOfs := 0;
  FBufPos := 0;
  FDirty := false;
end;

{-----------------------------------------------------------------------------}

function TStBufferedStream.bsReadChar(var aCh : AnsiChar) : boolean;
begin
  {is there anything to read?}
  if (FSize = (FBufOfs + FBufPos)) then begin
    Result := false;
    Exit;
  end;
  {if we get here, we'll definitely read a character}
  Result := true;
  {make sure that the buffer has some data in it}
  if (FBufCount = 0) then
    bsReadFromStream
  else if (FBufPos = FBufCount) then begin
    if FDirty then
      bsWriteToStream;
    FBufPos := 0;
    inc(FBufOfs, FBufSize);
    bsReadFromStream;
  end;
  {get the next character}
  aCh := AnsiChar(FBuffer[FBufPos]);
  inc(FBufPos);
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsReadFromStream;
var
  NewPos : longint;
begin
  {assumptions: FBufOfs is where to read the buffer
                FBufSize is the number of bytes to read
                FBufCount will be the number of bytes read}
  NewPos := FStream.Seek(FBufOfs, soFromBeginning);
  if (NewPos <> FBufOfs) then
    RaiseStError(EStBufStreamError, stscNoSeekForRead);
  FBufCount := FStream.Read(FBuffer^, FBufSize);
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsSetStream(aValue : TStream);
begin
  if (aValue <> FStream) then begin
    {if the buffer is dirty, flush it to the current stream}
    if FDirty and (FStream <> nil) then
      bsWriteToStream;
    {remember the stream and initialize all fields}
    FStream := aValue;
    bsInitForNewStream;
  end;
end;

{-----------------------------------------------------------------------------}

procedure TStBufferedStream.bsWriteToStream;
var
  NewPos       : longint;
  BytesWritten : longint;
begin
  {assumptions: FDirty is true
                FBufOfs is where to write the buffer
                FBufCount is the number of bytes to write
                FDirty will be set false afterwards}