ststrms.pas

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

    if (aLineNum < longint(FLineIndex[M])) then
      R := M - 2
    else if (aLineNum > longint(FLineIndex[M])) then
      L := M + 2
    else begin
      FLineCurrent := longint(FLineIndex[M]);
      FLineCurOfs := longint(FLineIndex[M+1]);
      Seek(FLineCurOfs, soFromBeginning);
      Result := FLineCurrent;
      Exit;
    end;
  end;
  {the item at L-2 will have the nearest smaller line number than the
   one we want; start here and read through the stream forwards}
  CurLine := longint(FLineIndex[L-2]);
  Seek(longint(FLineIndex[L-1]), soFromBeginning);
  while true do begin
    atsGetLine(CurPos, EndPos, Len);
    inc(CurLine);
    if (CurLine = FLineCount) or (CurLine = aLineNum) then begin
      FLineCurrent := CurLine;
      FLineCurOfs := EndPos;
      Seek(EndPos, soFromBeginning);
      Result := CurLine;
      Exit;
    end;
  end;
end;

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

procedure TStAnsiTextStream.WriteLine(const aSt : string);
var
  Len : Integer;
begin
  Len := Length(aSt);
  if Len > 0 then
    WriteLineArray(PAnsiChar(aSt), Len)
  else
    WriteLineArray('', 0);
end;

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

procedure TStAnsiTextStream.WriteLineArray(aCharArray : PAnsiChar;
                                           aLen       : TStMemSize);
var
  C : AnsiChar;
begin
  if (aCharArray = nil) then
    aLen := 0;
  if (LineTerminator = ltNone) then begin
    if (aLen >= FixedLineLength) then
      Write(aCharArray[0], FixedLineLength)
    else begin
      FillChar(FFixedLine[aLen], FixedLineLength-aLen, ' ');
      if (aLen > 0) then
        Move(aCharArray[0], FFixedLine[0], aLen);
      Write(FFixedLine[0], FixedLineLength);
    end;
  end
  else begin
    if (aLen > 0) then
      Write(aCharArray[0], aLen);
    case LineTerminator of
      ltNone : {this'll never get hit};
      ltCR   : Write(LineTerm[ltCR], 1);
      ltLF   : Write(LineTerm[ltLF], 1);
      ltCRLF : Write(LineTerm[ltCRLF], 2);
      ltOther: begin
                 C := LineTermChar;
                 Write(C, 1);
               end;
    else
      RaiseStError(EStBufStreamError, stscBadTerminator);
    end;
  end;
end;

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

procedure TStAnsiTextStream.WriteLineZ(aSt : PAnsiChar);
var
  LenSt : TStMemSize;
begin
  if (aSt = nil) then
    LenSt := 0
  else
    LenSt := StrLen(aSt);
  WriteLineArray(aSt, LenSt);
end;


{-----------------------------------------------------------------------------}
{                           TStMemoryMappedFile                               }
{-----------------------------------------------------------------------------}

constructor TStMemoryMappedFile.Create(const FileName   : string;      {!!.02}
                                             MaxSize    : Cardinal;
                                             ReadOnly   : Boolean;
                                             SharedData : Boolean);
var
  RO1,
  RO2,
  RO3,
  RO4,
  FHi    : DWORD;
  SetSize: Boolean;
begin
  inherited Create;

  FMutex := CreateMutex(nil, False, nil);
  FSharedData := SharedData;
  if (FSharedData) then
    FHeaderSize := SizeOf(Word) + SizeOf(Cardinal)
  else
    FHeaderSize := 0;

  FReadOnly := ReadOnly;
  if (SharedData) then
    FReadOnly := False;
  if (FReadOnly) then begin
    RO1 := GENERIC_READ;
    RO2 := FILE_ATTRIBUTE_READONLY;
    RO3 := PAGE_READONLY;
    RO4 := FILE_MAP_READ;
    FMaxHi := 0;
    FMaxLo := 0;
  end else begin
    RO1 := GENERIC_READ or GENERIC_WRITE;
    RO2 := FILE_ATTRIBUTE_NORMAL;
    RO3 := PAGE_READWRITE;
    RO4 := FILE_MAP_WRITE;
    FMaxHi := 0;
    FMaxLo := MaxSize;
  end;

  if (not SharedData) then begin
    FHandle := CreateFile(PChar(FileName),
                          RO1,
                          FILE_SHARE_READ or FILE_SHARE_WRITE,
                          nil,
                          OPEN_ALWAYS,
                          RO2,
                          0);

    if (FHandle = INVALID_HANDLE_VALUE) then
      RaiseStError(EStMMFileError, stscCreateFileFailed);

    {reset FMaxLo if file is read/write and less < FileSize}
    {the result is that the file size cannot be changed but the contents can}
    {still be modified}
    FDataSize := GetFileSize(FHandle, @FHi);
    if (FDataSize <> $FFFFFFFF) then begin
      if (not ReadOnly) and (FDataSize > FMaxLo) then
        FMaxLo := FDataSize;
    end else begin
      CloseHandle(FHandle);
      RaiseStError(EStMMFileError, stscGetSizeFailed);
    end;
  end else
    FDataSize := 0;

  if (not SharedData) then begin
    FMapObj := CreateFileMapping(FHandle, nil, RO3, FMaxHi, FMaxLo, nil);
    SetSize := False;
  end else begin
    if (FMaxLo > (High(Cardinal) - FHeaderSize)) then
      FMaxLo := High(Cardinal) - FHeaderSize
    else
      FMaxLo := FMaxLo + FHeaderSize;
    FMapObj := CreateFileMapping(THandle($FFFFFFFF), nil, RO3,
                                 FMaxHi, FMaxLo, 'STMMFILE1');
    SetSize := (GetLastError = ERROR_ALREADY_EXISTS);
  end;

  if (FMapObj = INVALID_HANDLE_VALUE) then
    RaiseStError(EStMMFileError, stscFileMappingFailed);

  FBuffer := MapViewOfFile(FMapObj, RO4, 0, 0, FMaxLo);
  if (not Assigned(FBuffer)) then
    RaiseStError(EStMMFileError, stscCreateViewFailed);

  if (SharedData) then begin
    if (SetSize) then
      Move(PByteArray(FBuffer)[SizeOf(Word)-1], FDataSize, SizeOf(Cardinal))
    else begin
      Move(FHeaderSize, PByteArray(FBuffer)[0], SizeOf(Word));
      FDataSize := 0;
      Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
    end;
  end;
  {set position to beginning}
  FPos := FHeaderSize;
end;

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

destructor TStMemoryMappedFile.Destroy;
begin
{Close the View and Mapping object}
  UnmapViewOfFile(FBuffer);
  FBuffer := nil;
  CloseHandle(FMapObj);

  if (not SharedData) then begin
{set the file pointer to the end of the actual data}
    SetFilePointer(FHandle, FDataSize, nil, FILE_BEGIN);
{set the EOF marker to the end of actual data}
    SetEndOfFile(FHandle);
    CloseHandle(FHandle);
  end;

  {now the Mutex can be cleared}
  CloseHandle(FMutex);
  FMutex := 0;

  inherited Destroy;
end;

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

function TStMemoryMappedFile.GetDataSize : Cardinal;
begin
  Move(PByteArray(FBuffer)[SizeOf(Word)-1], FDataSize, SizeOf(Cardinal));
  Result := FDataSize;
end;

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

function TStMemoryMappedFile.Read(var Buffer; Count : Longint) : Longint;
var
//  ByteArray : TByteArray absolute Buffer;                            {!!.02}
  ByteArray : PChar;                                                   {!!.02}
begin
  ByteArray := @Buffer;                                                {!!.02}
  {check to make sure that the read does not go beyond the actual data}
  if (((FPos-FHeaderSize) + DWORD(Count)) > FDataSize) then
    Count := FDataSize - FPos + FHeaderSize;

  if (SharedData) then begin
    WaitForSingleObject(FMutex, INFINITE);
    try
//      Move(PByteArray(FBuffer)[FPos], ByteArray[0], Count);          {!!.02}
      Move(PByteArray(FBuffer)[FPos], ByteArray^, Count);              {!!.02}
      Inc(FPos, Count);
      Result := Count;
    finally
      ReleaseMutex(FMutex);
    end;
  end else begin
//    Move(PByteArray(FBuffer)[FPos], ByteArray[0], Count);            {!!.02}
    Move(PByteArray(FBuffer)[FPos], ByteArray^, Count);                {!!.02}
    Inc(FPos, Count);
    Result := Count;
  end;
end;

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

function TStMemoryMappedFile.Write(const Buffer; Count : Longint) : Longint;
var
//  ByteArray : TByteArray absolute Buffer;                            {!!.02}
  ByteArray : PChar;                                                   {!!.02}
begin
  ByteArray := @Buffer;                                                {!!.02}
  if (ReadOnly) then begin
    Result := 0;
    Exit;
  end;

  {check that the write does not go beyond the maximum file size}
  if ((FPos + DWORD(Count)) > pred(FMaxLo)) then
    Count := pred(FMaxLo - FPos);

  if (SharedData) then begin
    WaitForSingleObject(FMutex, INFINITE);
    try
//      Move(ByteArray[0], PByteArray(FBuffer)[FPos], Count);          {!!.02}
      Move(ByteArray^, PByteArray(FBuffer)[FPos], Count);              {!!.02}
      Inc(FPos, Count);
      {if the write went beyond the previous end of data, update FDataSize}
      if ((FPos-FHeaderSize) > FDataSize) then
        FDataSize := FPos-FHeaderSize;
      Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
      Result := Count;
    finally
      ReleaseMutex(FMutex);
    end;
  end else begin
//    Move(ByteArray[0], PByteArray(FBuffer)[FPos], Count);            {!!.02}
    Move(ByteArray^, PByteArray(FBuffer)[FPos], Count);                {!!.02}
    Inc(FPos, Count);
    {if the write went beyond the previous end of data, update FDataSize}
    if ((FPos-FHeaderSize) > FDataSize) then
      FDataSize := FPos-FHeaderSize;
    Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
    Result := Count;
  end;
end;

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

function TStMemoryMappedFile.Seek(Offset : Longint; Origin : Word) : Longint;
begin
  if (SharedData) then begin
    WaitForSingleObject(FMutex, INFINITE);
    try
      case Origin of
        {$WARNINGS OFF}
        soFromBeginning : FPos := Offset + FHeaderSize;
        soFromCurrent   : FPos := FPos + Offset + FHeaderSize;
        {the seek should be based on actual data, not the mapped size since}
        {the "data" between FDataSize and the mapped size is undefined}
        soFromEnd       : FPos := FDataSize + Offset + FHeaderSize;
        {$WARNINGS ON}
      else
        RaiseStError(EStMMFileError, stscBadOrigin);
      end;

      {force the new position to be valid}
      if ((FPos-FHeaderSize) > FDataSize) then
        FPos := FDataSize + FHeaderSize;
      Result := FPos;
    finally
      ReleaseMutex(FMutex);
    end;
  end else begin
    {$WARNINGS OFF}
    case Origin of
      soFromBeginning : FPos := Offset + FHeaderSize;
      soFromCurrent   : FPos := FPos + Offset + FHeaderSize;
      {the seek should be based on actual data, not the mapped size since}
      {the "data" between FDataSize and the mapped size is undefined}
      soFromEnd       : FPos := FDataSize + Offset + FHeaderSize;
    else
      RaiseStError(EStMMFileError, stscBadOrigin);
    end;
    {$WARNINGS ON}

    {force the new position to be valid}
    if ((FPos-FHeaderSize) > FDataSize) then
      FPos := FDataSize + FHeaderSize;
    Result := FPos;
  end;
end;

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

end.