mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 08:26:20 +02:00
* merge revs
git-svn-id: branches/fixes_3_2@43196 -
This commit is contained in:
parent
1e9677e20e
commit
65ae9d2413
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2005,6 +2005,7 @@ packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
|
|||||||
packages/fcl-base/src/wtex.pp svneol=native#text/plain
|
packages/fcl-base/src/wtex.pp svneol=native#text/plain
|
||||||
packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
|
packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
|
||||||
packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
|
packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
|
||||||
|
packages/fcl-base/tests/tcbufferedfilestream.pp svneol=native#text/plain
|
||||||
packages/fcl-base/tests/tccsvreadwrite.pp svneol=native#text/plain
|
packages/fcl-base/tests/tccsvreadwrite.pp svneol=native#text/plain
|
||||||
packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
|
packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
|
||||||
packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain
|
packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain
|
||||||
|
@ -3,6 +3,7 @@
|
|||||||
Copyright (c) 1999-2000 by the Free Pascal development team
|
Copyright (c) 1999-2000 by the Free Pascal development team
|
||||||
|
|
||||||
Implement a buffered stream.
|
Implement a buffered stream.
|
||||||
|
TBufferedFileStream contributed by José Mejuto, bug ID 30549.
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
See the file COPYING.FPC, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
@ -27,8 +28,10 @@ Const
|
|||||||
|
|
||||||
Type
|
Type
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
TBufStream - simple read or write buffer, for sequential reading/writing
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
{ TBufStream }
|
|
||||||
TBufStream = Class(TOwnerStream)
|
TBufStream = Class(TOwnerStream)
|
||||||
Private
|
Private
|
||||||
FTotalPos : Int64;
|
FTotalPos : Int64;
|
||||||
@ -70,6 +73,72 @@ Type
|
|||||||
Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
|
Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
TBufferedFileStream -
|
||||||
|
Multiple pages buffer for random access reading/writing in file.
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
TBufferedFileStream = class(TFileStream)
|
||||||
|
private
|
||||||
|
const
|
||||||
|
TSTREAMCACHEPAGE_SIZE_DEFAULT=4*1024;
|
||||||
|
TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT=8;
|
||||||
|
type
|
||||||
|
TStreamCacheEntry=record
|
||||||
|
IsDirty: Boolean;
|
||||||
|
LastTick: NativeUInt;
|
||||||
|
PageBegin: int64;
|
||||||
|
PageRealSize: integer;
|
||||||
|
Buffer: Pointer;
|
||||||
|
end;
|
||||||
|
PStreamCacheEntry=^TStreamCacheEntry;
|
||||||
|
private
|
||||||
|
FCachePages: array of PStreamCacheEntry;
|
||||||
|
FCacheLastUsedPage: integer;
|
||||||
|
FCacheStreamPosition: int64;
|
||||||
|
FCacheStreamSize: int64;
|
||||||
|
FOpCounter: NativeUInt;
|
||||||
|
FStreamCachePageSize: integer;
|
||||||
|
FStreamCachePageMaxCount: integer;
|
||||||
|
FEmergencyFlag: Boolean;
|
||||||
|
procedure ClearCache;
|
||||||
|
procedure WriteDirtyPage(const aPage: PStreamCacheEntry);
|
||||||
|
procedure WriteDirtyPage(const aIndex: integer);
|
||||||
|
procedure WriteDirtyPages;
|
||||||
|
procedure EmergencyWriteDirtyPages;
|
||||||
|
procedure FreePage(const aPage: PStreamCacheEntry; const aFreeBuffer: Boolean); inline;
|
||||||
|
function LookForPositionInPages: Boolean;
|
||||||
|
function ReadPageForPosition: Boolean;
|
||||||
|
function ReadPageBeforeWrite: Boolean;
|
||||||
|
function FreeOlderInUsePage(const aFreeBuffer: Boolean=false): PStreamCacheEntry;
|
||||||
|
function GetOpCounter: NativeUInt; inline;
|
||||||
|
function DoCacheRead(var Buffer; Count: Longint): Longint;
|
||||||
|
function DoCacheWrite(const Buffer; Count: Longint): Longint;
|
||||||
|
protected
|
||||||
|
function GetPosition: Int64; override;
|
||||||
|
procedure SetPosition(const Pos: Int64); override;
|
||||||
|
function GetSize: Int64; override;
|
||||||
|
procedure SetSize64(const NewSize: Int64); override;
|
||||||
|
procedure SetSize(NewSize: Longint); override;overload;
|
||||||
|
procedure SetSize(const NewSize: Int64); override;overload;
|
||||||
|
public
|
||||||
|
// Warning using Mode=fmOpenWrite because the write buffer
|
||||||
|
// needs to read, as this class is a cache system not a dumb buffer.
|
||||||
|
constructor Create(const AFileName: string; Mode: Word);
|
||||||
|
constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
|
||||||
|
destructor Destroy; override;
|
||||||
|
function Seek(Offset: Longint; Origin: Word): Longint; override; overload;
|
||||||
|
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload;
|
||||||
|
function Read(var Buffer; Count: Longint): Longint; override;
|
||||||
|
function Write(const Buffer; Count: Longint): Longint; override;
|
||||||
|
// Flush write-cache content to disk
|
||||||
|
procedure Flush;
|
||||||
|
// re-initialize the cache with aCacheBlockCount block
|
||||||
|
// of aCacheBlockSize bytes in each block.
|
||||||
|
procedure InitializeCache(const aCacheBlockSize: integer; const aCacheBlockCount: integer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
Resourcestring
|
Resourcestring
|
||||||
@ -77,6 +146,11 @@ Resourcestring
|
|||||||
SErrCouldNotFLushBuffer = 'Could not flush buffer';
|
SErrCouldNotFLushBuffer = 'Could not flush buffer';
|
||||||
SErrInvalidSeek = 'Invalid buffer seek operation';
|
SErrInvalidSeek = 'Invalid buffer seek operation';
|
||||||
|
|
||||||
|
SErrCacheUnexpectedPageDiscard ='CACHE: Unexpected behaviour. Discarded page.';
|
||||||
|
SErrCacheUnableToReadExpected = 'CACHE: Unable to read expected bytes (Open for write only ?). Expected: %d, effective read: %d';
|
||||||
|
SErrCacheUnableToWriteExpected ='CACHE: Unable to write expected bytes (Open for read only ?). Expected: %d, effective write: %d';
|
||||||
|
SErrCacheInternal = 'CACHE: Internal error.';
|
||||||
|
|
||||||
{ TBufStream }
|
{ TBufStream }
|
||||||
|
|
||||||
procedure TBufStream.SetCapacity(const AValue: Integer);
|
procedure TBufStream.SetCapacity(const AValue: Integer);
|
||||||
@ -257,4 +331,518 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
TBufferedFileStream
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.ClearCache;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pStream: PStreamCacheEntry;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
WriteDirtyPages;
|
||||||
|
finally
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
pStream:=FCachePages[j];
|
||||||
|
if Assigned(pStream) then begin
|
||||||
|
if Assigned(pStream^.Buffer) then Freemem(pStream^.Buffer);
|
||||||
|
Dispose(pStream);
|
||||||
|
FCachePages[j]:=nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.WriteDirtyPage(const aPage: PStreamCacheEntry);
|
||||||
|
var
|
||||||
|
lEffectiveBytesWrite: integer;
|
||||||
|
begin
|
||||||
|
inherited Seek(aPage^.PageBegin,soBeginning);
|
||||||
|
lEffectiveBytesWrite:=inherited Write(aPage^.Buffer^,aPage^.PageRealSize);
|
||||||
|
if lEffectiveBytesWrite<>aPage^.PageRealSize then begin
|
||||||
|
EmergencyWriteDirtyPages;
|
||||||
|
Raise EStreamError.CreateFmt(SErrCacheUnableToWriteExpected,[aPage^.PageRealSize,lEffectiveBytesWrite,IntToStr(aPage^.PageBegin)]);
|
||||||
|
end;
|
||||||
|
aPage^.IsDirty:=False;
|
||||||
|
aPage^.LastTick:=GetOpCounter;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.WriteDirtyPage(const aIndex: integer);
|
||||||
|
var
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
begin
|
||||||
|
pCache:=FCachePages[aIndex];
|
||||||
|
if Assigned(pCache) then begin
|
||||||
|
WriteDirtyPage(pCache);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.WriteDirtyPages;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
begin
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
pCache:=FCachePages[j];
|
||||||
|
if Assigned(pCache) then begin
|
||||||
|
if pCache^.IsDirty then begin
|
||||||
|
WriteDirtyPage(pCache);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.EmergencyWriteDirtyPages;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
begin
|
||||||
|
// Are we already in a emergency write dirty pages ??
|
||||||
|
if FEmergencyFlag then exit;
|
||||||
|
FEmergencyFlag:=true;
|
||||||
|
// This procedure tries to save all dirty pages inconditional
|
||||||
|
// because a write fail happens, so everything in cache will
|
||||||
|
// be dumped to stream if possible, trying to save as much
|
||||||
|
// information as possible.
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
pCache:=FCachePages[j];
|
||||||
|
if Assigned(pCache) then begin
|
||||||
|
if pCache^.IsDirty then begin
|
||||||
|
try
|
||||||
|
WriteDirtyPage(pCache);
|
||||||
|
except on e: Exception do begin
|
||||||
|
// Do nothing, eat exception if happen.
|
||||||
|
// This way the cache still holds data to be
|
||||||
|
// written (that fails) and can be written later
|
||||||
|
// if write fail conditions change.
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
FEmergencyFlag:=False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.FreePage(const aPage: PStreamCacheEntry;
|
||||||
|
const aFreeBuffer: Boolean);
|
||||||
|
begin
|
||||||
|
aPage^.PageBegin:=0;
|
||||||
|
aPage^.PageRealSize:=0;
|
||||||
|
aPage^.LastTick:=0;
|
||||||
|
aPage^.IsDirty:=false;
|
||||||
|
if aFreeBuffer then begin
|
||||||
|
FreeMem(aPage^.Buffer);
|
||||||
|
aPage^.Buffer:=nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.LookForPositionInPages: Boolean;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
begin
|
||||||
|
Result:=false;
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
pCache:=FCachePages[j];
|
||||||
|
if Assigned(pCache^.Buffer) then begin
|
||||||
|
if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
|
||||||
|
FCacheLastUsedPage:=j;
|
||||||
|
Result:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.ReadPageForPosition: Boolean;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pCache: PStreamCacheEntry=nil;
|
||||||
|
lStreamPosition: int64;
|
||||||
|
begin
|
||||||
|
// Find free page entry
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
if not Assigned(FCachePages[j]^.Buffer) then begin
|
||||||
|
pCache:=FCachePages[j];
|
||||||
|
FCacheLastUsedPage:=j;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not Assigned(pCache) then begin
|
||||||
|
// Free last used page
|
||||||
|
pCache:=FreeOlderInUsePage(false);
|
||||||
|
end;
|
||||||
|
if not Assigned(pCache^.Buffer) then begin
|
||||||
|
Getmem(pCache^.Buffer,FStreamCachePageSize);
|
||||||
|
end;
|
||||||
|
lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
|
||||||
|
inherited Seek(lStreamPosition,soBeginning);
|
||||||
|
pCache^.PageBegin:=lStreamPosition;
|
||||||
|
pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
|
||||||
|
if pCache^.PageRealSize=FStreamCachePageSize then begin
|
||||||
|
pCache^.LastTick:=GetOpCounter;
|
||||||
|
Result:=true;
|
||||||
|
end else begin
|
||||||
|
if FCacheStreamPosition<lStreamPosition+pCache^.PageRealSize then begin
|
||||||
|
pCache^.LastTick:=GetOpCounter;
|
||||||
|
Result:=true;
|
||||||
|
end else begin
|
||||||
|
Result:=false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.ReadPageBeforeWrite: Boolean;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pCache: PStreamCacheEntry=nil;
|
||||||
|
lStreamPosition: int64;
|
||||||
|
lExpectedBytesToRead: integer;
|
||||||
|
lEffectiveRead: integer;
|
||||||
|
begin
|
||||||
|
// Find free page entry
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
if not Assigned(FCachePages[j]^.Buffer) then begin
|
||||||
|
pCache:=FCachePages[j];
|
||||||
|
FCacheLastUsedPage:=j;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not Assigned(pCache) then begin
|
||||||
|
// Free last used page
|
||||||
|
pCache:=FreeOlderInUsePage(false);
|
||||||
|
end;
|
||||||
|
if not Assigned(pCache^.Buffer) then begin
|
||||||
|
Getmem(pCache^.Buffer,FStreamCachePageSize);
|
||||||
|
end;
|
||||||
|
lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
|
||||||
|
inherited Seek(lStreamPosition,soBeginning);
|
||||||
|
if (lStreamPosition+FStreamCachePageSize) > FCacheStreamSize then begin
|
||||||
|
lExpectedBytesToRead:=FCacheStreamSize-lStreamPosition;
|
||||||
|
end else begin
|
||||||
|
lExpectedBytesToRead:=FStreamCachePageSize;
|
||||||
|
end;
|
||||||
|
pCache^.PageBegin:=lStreamPosition;
|
||||||
|
pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
|
||||||
|
if pCache^.PageRealSize<>lExpectedBytesToRead then begin
|
||||||
|
lEffectiveRead:=pCache^.PageRealSize;
|
||||||
|
pCache^.IsDirty:=false;
|
||||||
|
pCache^.LastTick:=0;
|
||||||
|
pCache^.PageBegin:=0;
|
||||||
|
pCache^.PageRealSize:=0;
|
||||||
|
Freemem(pCache^.Buffer);
|
||||||
|
pCache^.Buffer:=nil;
|
||||||
|
Raise EStreamError.CreateFmt(SErrCacheUnableToReadExpected,[lExpectedBytesToRead,lEffectiveRead]);
|
||||||
|
end;
|
||||||
|
pCache^.LastTick:=GetOpCounter;
|
||||||
|
Result:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.FreeOlderInUsePage(const aFreeBuffer: Boolean
|
||||||
|
): PStreamCacheEntry;
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
lOlderTick: int64=High(int64);
|
||||||
|
lOlderEntry: integer=-1;
|
||||||
|
begin
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
Result:=FCachePages[j];
|
||||||
|
if Assigned(Result^.Buffer) then begin
|
||||||
|
if Result^.LastTick<lOlderTick then begin
|
||||||
|
lOlderTick:=Result^.LastTick;
|
||||||
|
lOlderEntry:=j;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if lOlderEntry=-1 then begin
|
||||||
|
Raise Exception.Create(SErrCacheInternal);
|
||||||
|
end;
|
||||||
|
Result:=FCachePages[lOlderEntry];
|
||||||
|
FCacheLastUsedPage:=lOlderEntry;
|
||||||
|
if Result^.IsDirty then begin
|
||||||
|
WriteDirtyPage(Result);
|
||||||
|
end;
|
||||||
|
FreePage(Result,aFreeBuffer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.GetOpCounter: NativeUInt;
|
||||||
|
begin
|
||||||
|
Result:=FOpCounter;
|
||||||
|
{$PUSH}
|
||||||
|
{$Q-}
|
||||||
|
inc(FOpCounter);
|
||||||
|
{$POP}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.DoCacheRead(var Buffer; Count: Longint): Longint;
|
||||||
|
var
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
lAvailableInThisPage: integer;
|
||||||
|
lPositionInPage: integer;
|
||||||
|
lNewBuffer: PBYTE;
|
||||||
|
begin
|
||||||
|
pCache:=FCachePages[FCacheLastUsedPage];
|
||||||
|
if Assigned(pCache) then begin
|
||||||
|
// Check if FCacheStreamPosition is in range
|
||||||
|
if Assigned(pCache^.Buffer) then begin
|
||||||
|
if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
|
||||||
|
// Position is in range, so read available data from this page up to count or page end
|
||||||
|
lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
|
||||||
|
lAvailableInThisPage:=pCache^.PageRealSize - lPositionInPage;
|
||||||
|
if lAvailableInThisPage>=Count then begin
|
||||||
|
move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,Count);
|
||||||
|
inc(FCacheStreamPosition,Count);
|
||||||
|
Result:=Count;
|
||||||
|
pCache^.LastTick:=GetOpCounter;
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,lAvailableInThisPage);
|
||||||
|
inc(FCacheStreamPosition,lAvailableInThisPage);
|
||||||
|
if pCache^.PageRealSize=FStreamCachePageSize then begin
|
||||||
|
lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
|
||||||
|
Result:=lAvailableInThisPage+DoCacheRead(lNewBuffer^,Count-lAvailableInThisPage);
|
||||||
|
end else begin
|
||||||
|
// This cache page is not filled, so it is the last one
|
||||||
|
// in the file, nothing more to read...
|
||||||
|
pCache^.LastTick:=GetOpCounter;
|
||||||
|
Result:=lAvailableInThisPage;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
// The position is in other cache page or not in cache at all, so look for
|
||||||
|
// position in cached pages or allocate a new page.
|
||||||
|
if LookForPositionInPages then begin
|
||||||
|
Result:=DoCacheRead(Buffer,Count);
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
if ReadPageForPosition then begin
|
||||||
|
Result:=DoCacheRead(Buffer,Count);
|
||||||
|
end else begin
|
||||||
|
Result:=0;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if ReadPageForPosition then begin
|
||||||
|
Result:=DoCacheRead(Buffer,Count);
|
||||||
|
end else begin
|
||||||
|
Result:=0;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
// The page has been discarded for some unknown reason
|
||||||
|
Raise EStreamError.Create(SErrCacheUnexpectedPageDiscard);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.DoCacheWrite(const Buffer; Count: Longint): Longint;
|
||||||
|
var
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
lAvailableInThisPage: integer;
|
||||||
|
lPositionInPage: integer;
|
||||||
|
lNewBuffer: PBYTE;
|
||||||
|
begin
|
||||||
|
pCache:=FCachePages[FCacheLastUsedPage];
|
||||||
|
if Assigned(pCache) then begin
|
||||||
|
// Check if FCacheStreamPosition is in range
|
||||||
|
if Assigned(pCache^.Buffer) then begin
|
||||||
|
if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+FStreamCachePageSize) then begin
|
||||||
|
// Position is in range, so write data up to end of page
|
||||||
|
lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
|
||||||
|
lAvailableInThisPage:=FStreamCachePageSize - lPositionInPage;
|
||||||
|
if lAvailableInThisPage>=Count then begin
|
||||||
|
move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,Count);
|
||||||
|
if not pCache^.IsDirty then pCache^.IsDirty:=true;
|
||||||
|
inc(FCacheStreamPosition,Count);
|
||||||
|
// Update page size
|
||||||
|
if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+Count;
|
||||||
|
// Update file size
|
||||||
|
if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
|
||||||
|
Result:=Count;
|
||||||
|
pCache^.LastTick:=GetOpCounter;
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,lAvailableInThisPage);
|
||||||
|
if not pCache^.IsDirty then pCache^.IsDirty:=true;
|
||||||
|
inc(FCacheStreamPosition,lAvailableInThisPage);
|
||||||
|
// Update page size
|
||||||
|
if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+lAvailableInThisPage;
|
||||||
|
// Update file size
|
||||||
|
if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
|
||||||
|
|
||||||
|
Assert(pCache^.PageRealSize=FStreamCachePageSize,'This must not happend');
|
||||||
|
lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
|
||||||
|
Result:=lAvailableInThisPage+DoCacheWrite(lNewBuffer^,Count-lAvailableInThisPage);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
// The position is in other cache page or not in cache at all, so look for
|
||||||
|
// position in cached pages or allocate a new page.
|
||||||
|
if LookForPositionInPages then begin
|
||||||
|
Result:=DoCacheWrite(Buffer,Count);
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
if ReadPageBeforeWrite then begin
|
||||||
|
Result:=DoCacheWrite(Buffer,Count);
|
||||||
|
end else begin
|
||||||
|
Result:=0;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if ReadPageBeforeWrite then begin
|
||||||
|
Result:=DoCacheWrite(Buffer,Count);
|
||||||
|
end else begin
|
||||||
|
Result:=0;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
// The page has been discarded for some unknown reason
|
||||||
|
Raise EStreamError.Create(SErrCacheUnexpectedPageDiscard);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.GetPosition: Int64;
|
||||||
|
begin
|
||||||
|
Result:=FCacheStreamPosition;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.SetPosition(const Pos: Int64);
|
||||||
|
begin
|
||||||
|
if Pos<0 then begin
|
||||||
|
FCacheStreamPosition:=0;
|
||||||
|
end else begin
|
||||||
|
FCacheStreamPosition:=Pos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.GetSize: Int64;
|
||||||
|
begin
|
||||||
|
Result:=FCacheStreamSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.SetSize64(const NewSize: Int64);
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
pCache: PStreamCacheEntry;
|
||||||
|
begin
|
||||||
|
WriteDirtyPages;
|
||||||
|
inherited SetSize64(NewSize);
|
||||||
|
FCacheStreamSize:=inherited Seek(0,soFromEnd);
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
pCache:=FCachePages[j];
|
||||||
|
if Assigned(pCache^.Buffer) and (pCache^.PageRealSize+pCache^.PageBegin>FCacheStreamSize) then begin
|
||||||
|
// This page is out of bounds the new file size
|
||||||
|
// so discard it.
|
||||||
|
FreePage(pCache,True);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.SetSize(NewSize: Longint);
|
||||||
|
begin
|
||||||
|
SetSize64(NewSize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.SetSize(const NewSize: Int64);
|
||||||
|
begin
|
||||||
|
SetSize64(NewSize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word);
|
||||||
|
begin
|
||||||
|
// Initialize with 8 blocks of 4096 bytes
|
||||||
|
InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
|
||||||
|
inherited Create(AFileName,Mode);
|
||||||
|
FCacheStreamSize:=inherited Seek(int64(0),soEnd);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word;
|
||||||
|
Rights: Cardinal);
|
||||||
|
begin
|
||||||
|
// Initialize with 8 blocks of 4096 bytes
|
||||||
|
InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
|
||||||
|
inherited Create(AFileName,Mode,Rights);
|
||||||
|
FCacheStreamSize:=inherited Seek(int64(0),soEnd);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.Read(var Buffer; Count: Longint): Longint;
|
||||||
|
begin
|
||||||
|
Result:=DoCacheRead(Buffer,Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.Write(const Buffer; Count: Longint): Longint;
|
||||||
|
begin
|
||||||
|
Result:=DoCacheWrite(Buffer,Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.Flush;
|
||||||
|
begin
|
||||||
|
WriteDirtyPages;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||||
|
begin
|
||||||
|
Result:=Seek(int64(OffSet),TSeekOrigin(Origin));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
||||||
|
var
|
||||||
|
lNewOffset: int64;
|
||||||
|
begin
|
||||||
|
Case Origin of
|
||||||
|
soEnd:
|
||||||
|
begin
|
||||||
|
lNewOffset:=FCacheStreamSize+Offset;
|
||||||
|
end;
|
||||||
|
soBeginning:
|
||||||
|
begin
|
||||||
|
lNewOffset:=0+Offset;
|
||||||
|
end;
|
||||||
|
soCurrent:
|
||||||
|
begin
|
||||||
|
lNewOffset:=FCacheStreamPosition+Offset;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if lNewOffset>0 then begin
|
||||||
|
FCacheStreamPosition:=lNewOffset;
|
||||||
|
Result:=lNewOffset;
|
||||||
|
end else begin
|
||||||
|
// This is compatible with FPC stream
|
||||||
|
// as it returns the negative value :-?
|
||||||
|
// but in fact does not move the read pointer.
|
||||||
|
Result:=-1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedFileStream.InitializeCache(const aCacheBlockSize: integer;
|
||||||
|
const aCacheBlockCount: integer);
|
||||||
|
var
|
||||||
|
j: integer;
|
||||||
|
begin
|
||||||
|
ClearCache;
|
||||||
|
FStreamCachePageSize:=aCacheBlockSize;
|
||||||
|
FStreamCachePageMaxCount:=aCacheBlockCount;
|
||||||
|
FCacheStreamSize:=inherited Seek(0,soEnd);
|
||||||
|
SetLength(FCachePages,FStreamCachePageMaxCount);
|
||||||
|
for j := 0 to Pred(FStreamCachePageMaxCount) do begin
|
||||||
|
FCachePages[j]:=New(PStreamCacheEntry);
|
||||||
|
FillByte(FCachePages[j]^,Sizeof(PStreamCacheEntry^),0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TBufferedFileStream.Destroy;
|
||||||
|
begin
|
||||||
|
ClearCache;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -124,7 +124,7 @@ Type
|
|||||||
// simple parsing
|
// simple parsing
|
||||||
procedure ParseValue;
|
procedure ParseValue;
|
||||||
public
|
public
|
||||||
constructor Create;
|
constructor Create; override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
// Source data stream
|
// Source data stream
|
||||||
procedure SetSource(AStream: TStream); overload;
|
procedure SetSource(AStream: TStream); overload;
|
||||||
@ -161,7 +161,7 @@ Type
|
|||||||
procedure AppendStringToStream(const AString: String; AStream: TStream);
|
procedure AppendStringToStream(const AString: String; AStream: TStream);
|
||||||
function QuoteCSVString(const AValue: String): String;
|
function QuoteCSVString(const AValue: String): String;
|
||||||
public
|
public
|
||||||
constructor Create;
|
constructor Create; override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
// Set output/destination stream.
|
// Set output/destination stream.
|
||||||
// If not called, output is sent to DefaultOutput
|
// If not called, output is sent to DefaultOutput
|
||||||
@ -455,6 +455,7 @@ var
|
|||||||
b: packed array[0..2] of byte;
|
b: packed array[0..2] of byte;
|
||||||
n: Integer;
|
n: Integer;
|
||||||
begin
|
begin
|
||||||
|
B[0]:=0; B[1]:=0; B[2]:=0;
|
||||||
ClearOutput;
|
ClearOutput;
|
||||||
FSourceStream.Seek(0, soFromBeginning);
|
FSourceStream.Seek(0, soFromBeginning);
|
||||||
if FDetectBOM then
|
if FDetectBOM then
|
||||||
@ -533,6 +534,7 @@ begin
|
|||||||
if StreamSize > 0 then
|
if StreamSize > 0 then
|
||||||
begin
|
begin
|
||||||
SetLength(Result, StreamSize);
|
SetLength(Result, StreamSize);
|
||||||
|
FDefaultOutput.Position:=0;
|
||||||
FDefaultOutput.ReadBuffer(Result[1], StreamSize);
|
FDefaultOutput.ReadBuffer(Result[1], StreamSize);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
@ -1382,15 +1382,8 @@ begin
|
|||||||
slLines.LoadFromFile(FFileName)
|
slLines.LoadFromFile(FFileName)
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
slLines.DefaultEncoding := FEncoding;
|
slLines.DefaultEncoding := FEncoding; // TStrings clones the encoding.
|
||||||
slLines.LoadFromFile(FFileName, nil);
|
slLines.LoadFromFile(FFileName, nil);
|
||||||
if FEncoding <> slLines.Encoding then
|
|
||||||
begin
|
|
||||||
if FOwnsEncoding then
|
|
||||||
FEncoding.Free;
|
|
||||||
FEncoding := slLines.Encoding;
|
|
||||||
FOwnsEncoding := not TEncoding.IsStandardEncoding(FEncoding);
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
FillSectionList(slLines);
|
FillSectionList(slLines);
|
||||||
finally
|
finally
|
||||||
|
@ -308,7 +308,6 @@ end;
|
|||||||
// Clear (virtually) a single char in position Position
|
// Clear (virtually) a single char in position Position
|
||||||
function TMaskUtils.ClearChar(Position: Integer): Char;
|
function TMaskUtils.ClearChar(Position: Integer): Char;
|
||||||
begin
|
begin
|
||||||
Result := FMask[Position];
|
|
||||||
//For Delphi compatibilty, only literals remain, all others will be blanked
|
//For Delphi compatibilty, only literals remain, all others will be blanked
|
||||||
case CharToMask(FMask[Position]) Of
|
case CharToMask(FMask[Position]) Of
|
||||||
Char_Number,
|
Char_Number,
|
||||||
@ -334,6 +333,8 @@ begin
|
|||||||
Char_AllFixedDownCase: Result := FSpaceChar;
|
Char_AllFixedDownCase: Result := FSpaceChar;
|
||||||
Char_HourSeparator: Result := DefaultFormatSettings.TimeSeparator;
|
Char_HourSeparator: Result := DefaultFormatSettings.TimeSeparator;
|
||||||
Char_DateSeparator: Result := DefaultFormatSettings.DateSeparator;
|
Char_DateSeparator: Result := DefaultFormatSettings.DateSeparator;
|
||||||
|
else
|
||||||
|
Result := FMask[Position];
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -181,7 +181,6 @@ type
|
|||||||
|
|
||||||
|
|
||||||
TStreamHelper = class helper for TStream
|
TStreamHelper = class helper for TStream
|
||||||
|
|
||||||
function ReadWordLE :word;
|
function ReadWordLE :word;
|
||||||
function ReadDWordLE:dword;
|
function ReadDWordLE:dword;
|
||||||
function ReadQWordLE:qword;
|
function ReadQWordLE:qword;
|
||||||
@ -198,7 +197,6 @@ type
|
|||||||
function ReadDouble:Double;
|
function ReadDouble:Double;
|
||||||
procedure WriteSingle(s:Single);
|
procedure WriteSingle(s:Single);
|
||||||
procedure WriteDouble(d:double);
|
procedure WriteDouble(d:double);
|
||||||
|
|
||||||
{$ifndef FPC}
|
{$ifndef FPC}
|
||||||
function ReadByte : Byte;
|
function ReadByte : Byte;
|
||||||
function ReadWord : Word;
|
function ReadWord : Word;
|
||||||
|
@ -1,14 +1,15 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<ProjectOptions>
|
<ProjectOptions>
|
||||||
<Version Value="9"/>
|
<Version Value="12"/>
|
||||||
<General>
|
<General>
|
||||||
<Flags>
|
<Flags>
|
||||||
|
<SaveOnlyProjectUnits Value="True"/>
|
||||||
<MainUnitHasCreateFormStatements Value="False"/>
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
<MainUnitHasTitleStatement Value="False"/>
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
<CompatibilityMode Value="True"/>
|
||||||
</Flags>
|
</Flags>
|
||||||
<SessionStorage Value="InProjectDir"/>
|
<SessionStorage Value="InProjectDir"/>
|
||||||
<MainUnit Value="0"/>
|
|
||||||
<Title Value="fclbase-unittests"/>
|
<Title Value="fclbase-unittests"/>
|
||||||
<UseAppBundle Value="False"/>
|
<UseAppBundle Value="False"/>
|
||||||
<ResourceType Value="res"/>
|
<ResourceType Value="res"/>
|
||||||
@ -16,28 +17,29 @@
|
|||||||
<i18n>
|
<i18n>
|
||||||
<EnableI18N LFM="False"/>
|
<EnableI18N LFM="False"/>
|
||||||
</i18n>
|
</i18n>
|
||||||
<VersionInfo>
|
|
||||||
<StringTable ProductVersion=""/>
|
|
||||||
</VersionInfo>
|
|
||||||
<BuildModes Count="1">
|
<BuildModes Count="1">
|
||||||
<Item1 Name="Default" Default="True"/>
|
<Item1 Name="Default" Default="True"/>
|
||||||
</BuildModes>
|
</BuildModes>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
|
||||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
|
||||||
</PublishOptions>
|
</PublishOptions>
|
||||||
<RunParams>
|
<RunParams>
|
||||||
<local>
|
<local>
|
||||||
<FormatVersion Value="1"/>
|
|
||||||
<CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
|
<CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
|
||||||
</local>
|
</local>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="1">
|
||||||
|
<Mode0 Name="default">
|
||||||
|
<local>
|
||||||
|
<CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
|
||||||
|
</local>
|
||||||
|
</Mode0>
|
||||||
|
</Modes>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<Units Count="6">
|
<Units Count="7">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="fclbase-unittests.pp"/>
|
<Filename Value="fclbase-unittests.pp"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="fclbase_unittests"/>
|
|
||||||
</Unit0>
|
</Unit0>
|
||||||
<Unit1>
|
<Unit1>
|
||||||
<Filename Value="tchashlist.pp"/>
|
<Filename Value="tchashlist.pp"/>
|
||||||
@ -59,6 +61,10 @@
|
|||||||
<Filename Value="tccsvreadwrite.pp"/>
|
<Filename Value="tccsvreadwrite.pp"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
</Unit5>
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="tcbufferedfilestream.pp"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit6>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
@ -4,7 +4,7 @@ program fclbase_unittests;
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, consoletestrunner, tests_fptemplate, tchashlist,
|
Classes, consoletestrunner, tests_fptemplate, tchashlist,
|
||||||
testexprpars, tcmaskutils, tcinifile, tccsvreadwrite;
|
testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream;
|
||||||
|
|
||||||
var
|
var
|
||||||
Application: TTestRunner;
|
Application: TTestRunner;
|
||||||
|
393
packages/fcl-base/tests/tcbufferedfilestream.pp
Normal file
393
packages/fcl-base/tests/tcbufferedfilestream.pp
Normal file
@ -0,0 +1,393 @@
|
|||||||
|
unit tcbufferedfilestream;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcunit, testregistry, bufstream;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TTestBufferedFileStream }
|
||||||
|
|
||||||
|
TTestBufferedFileStream= class(TTestCase)
|
||||||
|
private
|
||||||
|
const
|
||||||
|
TEST_RANDOM_READS=10000;
|
||||||
|
TEST_SEQUENTIAL_READS=1000000;
|
||||||
|
TEST_FILENAME='testfile.bin';
|
||||||
|
TEST_WRITEC_FILE='testwritecache.bin';
|
||||||
|
TEST_WRITEF_FILE='testwritedirec.bin';
|
||||||
|
private
|
||||||
|
function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean;
|
||||||
|
protected
|
||||||
|
procedure SetUp; override;
|
||||||
|
procedure TearDown; override;
|
||||||
|
published
|
||||||
|
procedure TestCacheRead;
|
||||||
|
procedure TestCacheWrite;
|
||||||
|
procedure TestCacheSeek;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure TTestBufferedFileStream.TestCacheRead;
|
||||||
|
var
|
||||||
|
lBufferedStream: TBufferedFileStream;
|
||||||
|
lStream: TFileStream;
|
||||||
|
b: array [0..10000-1] of char;
|
||||||
|
j,k: integer;
|
||||||
|
lBytesToRead: integer;
|
||||||
|
lEffectiveRead: integer;
|
||||||
|
{$IFDEF CHECK_AGAINST_FILE}
|
||||||
|
lEffectiveRead2: integer;
|
||||||
|
{$ENDIF}
|
||||||
|
lReadPosition: int64;
|
||||||
|
lCheckInitV: integer;
|
||||||
|
lTick: QWord;
|
||||||
|
begin
|
||||||
|
b[0]:=#0; // Avoid initalization hint
|
||||||
|
lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
|
||||||
|
lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
|
||||||
|
try
|
||||||
|
RandSeed:=1;
|
||||||
|
Randomize;
|
||||||
|
lTick:=GetTickCount64;
|
||||||
|
for j := 0 to Pred(TEST_RANDOM_READS) do begin
|
||||||
|
lBytesToRead:=Random(10000);
|
||||||
|
lReadPosition:=Random(lBufferedStream.Size);
|
||||||
|
lBufferedStream.Position:=lReadPosition;
|
||||||
|
|
||||||
|
lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
|
||||||
|
|
||||||
|
{$IFDEF CHECK_AGAINST_FILE}
|
||||||
|
// Now read without cache
|
||||||
|
lStream.Position:=lReadPosition;
|
||||||
|
lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
|
||||||
|
if lEffectiveRead<>lEffectiveRead2 then begin
|
||||||
|
FAIL('Read length mismatch');
|
||||||
|
end;
|
||||||
|
if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
|
||||||
|
FAIL('Compare buffer data error');
|
||||||
|
end;
|
||||||
|
F.Position:=0;
|
||||||
|
{$ELSE}
|
||||||
|
lCheckInitV:=lReadPosition mod 10;
|
||||||
|
for k := 0 to Pred(lEffectiveRead) do begin
|
||||||
|
if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
|
||||||
|
FAIL('Expected data error');
|
||||||
|
end;
|
||||||
|
inc(lCheckInitV);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
// Writeln('CACHE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
|
||||||
|
|
||||||
|
RandSeed:=1;
|
||||||
|
Randomize;
|
||||||
|
|
||||||
|
// Writeln('Same operation without cache');
|
||||||
|
lTick:=GetTickCount64;
|
||||||
|
for j := 0 to Pred(TEST_RANDOM_READS) do begin
|
||||||
|
lBytesToRead:=Random(10000);
|
||||||
|
lReadPosition:=Random(lBufferedStream.Size);
|
||||||
|
|
||||||
|
lStream.Position:=lReadPosition;
|
||||||
|
lEffectiveRead:=lStream.Read(b,lBytesToRead);
|
||||||
|
|
||||||
|
lCheckInitV:=lReadPosition mod 10;
|
||||||
|
for k := 0 to Pred(lEffectiveRead) do begin
|
||||||
|
if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
|
||||||
|
FAIL('Expected data error');
|
||||||
|
end;
|
||||||
|
inc(lCheckInitV);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// Writeln('FILE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
|
||||||
|
|
||||||
|
// Writeln('Check sequential read');
|
||||||
|
|
||||||
|
RandSeed:=1;
|
||||||
|
Randomize;
|
||||||
|
lTick:=GetTickCount64;
|
||||||
|
lBytesToRead:=1;
|
||||||
|
lReadPosition:=0;
|
||||||
|
lBufferedStream.Position:=lReadPosition;
|
||||||
|
lStream.Position:=lReadPosition;
|
||||||
|
for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
|
||||||
|
|
||||||
|
lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
|
||||||
|
|
||||||
|
{$IFDEF CHECK_AGAINST_FILE}
|
||||||
|
// Now read without cache
|
||||||
|
lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
|
||||||
|
if lEffectiveRead<>lEffectiveRead2 then begin
|
||||||
|
FAIL('Read length mismatch');
|
||||||
|
end;
|
||||||
|
if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
|
||||||
|
FAIL('Compare buffer data error');
|
||||||
|
end;
|
||||||
|
F.Position:=0;
|
||||||
|
{$ELSE}
|
||||||
|
lCheckInitV:=lReadPosition mod 10;
|
||||||
|
for k := 0 to Pred(lEffectiveRead) do begin
|
||||||
|
if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
|
||||||
|
FAIL('Expected data error');
|
||||||
|
end;
|
||||||
|
inc(lCheckInitV);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
inc(lReadPosition,lBytesToRead);
|
||||||
|
end;
|
||||||
|
// Writeln('CACHE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
|
||||||
|
|
||||||
|
RandSeed:=1;
|
||||||
|
Randomize;
|
||||||
|
lTick:=GetTickCount64;
|
||||||
|
lBytesToRead:=1;
|
||||||
|
lReadPosition:=0;
|
||||||
|
lStream.Position:=lReadPosition;
|
||||||
|
for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
|
||||||
|
|
||||||
|
lEffectiveRead:=lStream.Read(b,lBytesToRead);
|
||||||
|
|
||||||
|
lCheckInitV:=lReadPosition mod 10;
|
||||||
|
for k := 0 to Pred(lEffectiveRead) do begin
|
||||||
|
if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
|
||||||
|
FAIL('Expected data error');
|
||||||
|
end;
|
||||||
|
inc(lCheckInitV);
|
||||||
|
end;
|
||||||
|
inc(lReadPosition,lBytesToRead);
|
||||||
|
end;
|
||||||
|
// Writeln('FILE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
|
||||||
|
|
||||||
|
// Writeln('CACHE Trying read beyond limits');
|
||||||
|
lBufferedStream.Position:=lBufferedStream.Size-1;
|
||||||
|
lEffectiveRead:=lBufferedStream.Read(b,2);
|
||||||
|
if lEffectiveRead<>1 then begin
|
||||||
|
FAIL('Read beyond limits, returned bytes: '+inttostr(lEffectiveRead));
|
||||||
|
end else begin
|
||||||
|
// Writeln('CACHE OK, read beyond limits returns 0 bytes.');
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
lBufferedStream.Free;
|
||||||
|
lStream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBufferedFileStream.TestCacheWrite;
|
||||||
|
const
|
||||||
|
EXPECTED_SIZE=10000000;
|
||||||
|
TEST_ROUNDS=100000;
|
||||||
|
var
|
||||||
|
lBufferedStream: TBufferedFileStream;
|
||||||
|
lStream: TFileStream;
|
||||||
|
lVerifyStream1,lVerifyStream2: TFileStream;
|
||||||
|
b: array [0..10000-1] of char;
|
||||||
|
j: integer;
|
||||||
|
lBytesToWrite: integer;
|
||||||
|
lWritePosition: int64;
|
||||||
|
begin
|
||||||
|
// Writeln('Testing write cache');
|
||||||
|
// All test should return the same random sequence
|
||||||
|
RandSeed:=1;
|
||||||
|
Randomize;
|
||||||
|
for j := 0 to Pred(10000) do begin
|
||||||
|
b[j]:='0';
|
||||||
|
end;
|
||||||
|
lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate);
|
||||||
|
lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate);
|
||||||
|
try
|
||||||
|
for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do begin
|
||||||
|
lBufferedStream.Write(b,sizeof(b));
|
||||||
|
lStream.Write(b,sizeof(b));
|
||||||
|
end;
|
||||||
|
for j := 0 to Pred(Sizeof(b)) do begin
|
||||||
|
b[j]:=char(ord('0')+j mod 10);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
lBufferedStream.Free;
|
||||||
|
lStream.Free;
|
||||||
|
end;
|
||||||
|
lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite);
|
||||||
|
lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite);
|
||||||
|
try
|
||||||
|
for j := 0 to Pred(TEST_ROUNDS) do begin
|
||||||
|
if lStream.Size<>lBufferedStream.Size then begin
|
||||||
|
FAIL('Mismatched lengths');
|
||||||
|
end;
|
||||||
|
lWritePosition:=Random(EXPECTED_SIZE);
|
||||||
|
lBytesToWrite:=Random(sizeof(b));
|
||||||
|
lBufferedStream.Position:=lWritePosition;
|
||||||
|
lStream.Position:=lWritePosition;
|
||||||
|
lBufferedStream.Write(b,lBytesToWrite);
|
||||||
|
lStream.Write(b,lBytesToWrite);
|
||||||
|
// if j mod 1273 = 0 then write(j,' / ',TEST_ROUNDS,#13);
|
||||||
|
end;
|
||||||
|
// Writeln(TEST_ROUNDS,' / ',TEST_ROUNDS);
|
||||||
|
if lStream.Size<>lBufferedStream.Size then begin
|
||||||
|
FAIL('Mismatched lengths');
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
lBufferedStream.Free;
|
||||||
|
lStream.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Verify both generated files are identical.
|
||||||
|
lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite);
|
||||||
|
lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite);
|
||||||
|
try
|
||||||
|
if not CompareStreams(lVerifyStream1,lVerifyStream2) then begin
|
||||||
|
FAIL('Streams are different!!');
|
||||||
|
end else begin
|
||||||
|
// Writeln('Streams are identical. OK.');
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
lVerifyStream1.Free;
|
||||||
|
lVerifyStream2.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBufferedFileStream.TestCacheSeek;
|
||||||
|
var
|
||||||
|
lBufferedStream: TBufferedFileStream;
|
||||||
|
lStream: TFileStream;
|
||||||
|
bBuffered: array [0..10000] of BYTE;
|
||||||
|
bStream: array [0..10000] of BYTE;
|
||||||
|
bread : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
bBuffered[0]:=0; // Avoid initalization hint
|
||||||
|
bStream[0]:=0; // Avoid initalization hint
|
||||||
|
lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
|
||||||
|
lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
|
||||||
|
try
|
||||||
|
// Writeln('Set position=-1');
|
||||||
|
lStream.Position:=-1;
|
||||||
|
// Writeln('TFileStream position=',lStream.Position);
|
||||||
|
lBufferedStream.Position:=-1;
|
||||||
|
// Writeln('Buffered position=',lBufferedStream.Position);
|
||||||
|
if lStream.Position<>lBufferedStream.Position then begin
|
||||||
|
FAIL('Positions are not the same.');
|
||||||
|
end else begin
|
||||||
|
// Writeln('Positions are the same.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Writeln('Read data when position=-1');
|
||||||
|
bread:=lStream.Read(bBuffered[0],10);
|
||||||
|
// Writeln('TFileStream read bytes : ',bread);
|
||||||
|
// Writeln('TFileStream end position: ',lStream.Position);
|
||||||
|
bread:=lBufferedStream.Read(bStream[0],10);
|
||||||
|
// Writeln('Buffered read bytes: ',bread);
|
||||||
|
// Writeln('Buffered end position: ',lBufferedStream.Position);
|
||||||
|
if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
|
||||||
|
FAIL('Read data or positions are not the same.');
|
||||||
|
end else begin
|
||||||
|
// Writeln('Read data at -1 is the same.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Writeln('Testing Seek operations');
|
||||||
|
// Writeln('Seek -1 from beginning');
|
||||||
|
bread:=lStream.Seek(-1,soBeginning);
|
||||||
|
// Writeln('Stream seek result : ',bread);
|
||||||
|
bread:=lBufferedStream.Seek(-1,soBeginning);
|
||||||
|
// Writeln('Buffered seek result: ',);
|
||||||
|
|
||||||
|
// Writeln('Read data when Seek -1');
|
||||||
|
bread:=lStream.Read(bBuffered[0],10);
|
||||||
|
// Writeln('TFileStream read bytes : ',bread);
|
||||||
|
// Writeln('TFileStream end position: ',lStream.Position);
|
||||||
|
bread:=lBufferedStream.Read(bStream[0],10);
|
||||||
|
// Writeln('Buffered read bytes: ',bread);
|
||||||
|
// Writeln('Buffered end position: ',lBufferedStream.Position);
|
||||||
|
if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
|
||||||
|
FAIL('Read data or positions are not the same.');
|
||||||
|
end else begin
|
||||||
|
// Writeln('Read data at -1 is the same.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Writeln('Seek -current*2 from current');
|
||||||
|
bread:=lStream.Seek(lStream.Position*-2,soCurrent);
|
||||||
|
// Writeln('Stream seek result : ',bread);
|
||||||
|
bread:=lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent);
|
||||||
|
// Writeln('Buffered seek result: ',bread);
|
||||||
|
// Writeln('Read data when Seek from current -current*2');
|
||||||
|
bread:=lStream.Read(bBuffered[0],10);
|
||||||
|
// Writeln('TFileStream read bytes : ',bread);
|
||||||
|
// Writeln('TFileStream end position: ',lStream.Position);
|
||||||
|
bread:=lBufferedStream.Read(bStream[0],10);
|
||||||
|
// Writeln('Buffered read bytes: ',);
|
||||||
|
// Writeln('Buffered end position: ',lBufferedStream.Position);
|
||||||
|
if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
|
||||||
|
FAIL('Read data or positions are not the same.');
|
||||||
|
end else begin
|
||||||
|
// Writeln('Read data at -current*2 is the same.');
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
lBufferedStream.Free;
|
||||||
|
lStream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBufferedFileStream.SetUp;
|
||||||
|
var
|
||||||
|
F: TFileStream;
|
||||||
|
b: array [0..10000-1] of char;
|
||||||
|
j: integer;
|
||||||
|
begin
|
||||||
|
for j := 0 to Pred(10000) do begin
|
||||||
|
b[j]:=char(ord('0')+j mod 10);
|
||||||
|
end;
|
||||||
|
F:=TFileStream.Create(TEST_FILENAME,fmCreate);
|
||||||
|
for j := 0 to Pred(1000) do begin
|
||||||
|
F.Write(b,sizeof(b));
|
||||||
|
end;
|
||||||
|
F.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBufferedFileStream.TearDown;
|
||||||
|
begin
|
||||||
|
DeleteFile(TEST_FILENAME);
|
||||||
|
DeleteFile(TEST_WRITEC_FILE);
|
||||||
|
DeleteFile(TEST_WRITEF_FILE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTestBufferedFileStream.CompareStreams(const aStream1: TStream;
|
||||||
|
const aStream2: TStream): Boolean;
|
||||||
|
const
|
||||||
|
BUFFER_SIZE=5213; // Odd number
|
||||||
|
var
|
||||||
|
b1: array [0..BUFFER_SIZE-1] of BYTE;
|
||||||
|
b2: array [0..BUFFER_SIZE-1] of BYTE;
|
||||||
|
lReadBytes: integer;
|
||||||
|
lAvailable: integer;
|
||||||
|
lEffectiveRead1: integer;
|
||||||
|
lEffectiveRead2: integer;
|
||||||
|
begin
|
||||||
|
b1[0]:=0; // Avoid initalization hint
|
||||||
|
b2[0]:=0; // Avoid initalization hint
|
||||||
|
Result:=false;
|
||||||
|
if aStream1.Size<>aStream2.Size then exit;
|
||||||
|
aStream1.Position:=0;
|
||||||
|
aStream2.Position:=0;
|
||||||
|
while aStream1.Position<aStream1.Size do begin
|
||||||
|
lAvailable:=aStream1.Size-aStream1.Position;
|
||||||
|
if lAvailable>=BUFFER_SIZE then begin
|
||||||
|
lReadBytes:=BUFFER_SIZE;
|
||||||
|
end else begin
|
||||||
|
lReadBytes:=aStream1.Size-aStream1.Position;
|
||||||
|
end;
|
||||||
|
lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes);
|
||||||
|
lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes);
|
||||||
|
if lEffectiveRead1<>lEffectiveRead2 then exit;
|
||||||
|
if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit;
|
||||||
|
end;
|
||||||
|
Result:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterTest(TTestBufferedFileStream);
|
||||||
|
end.
|
||||||
|
|
@ -1033,7 +1033,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String) : Integer;
|
Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String; Recurse: Integer) : Integer;
|
||||||
|
|
||||||
|
|
||||||
Var
|
Var
|
||||||
@ -1056,13 +1056,29 @@ begin
|
|||||||
I:=0;
|
I:=0;
|
||||||
While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
|
While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
|
||||||
begin
|
begin
|
||||||
if (Ntohs(RR.AType)=DNSQRY_PTR) and (1=NtoHS(RR.AClass)) then
|
Case Ntohs(RR.AType) of
|
||||||
|
DNSQRY_PTR:
|
||||||
|
if (1=NtoHS(RR.AClass)) then
|
||||||
begin
|
begin
|
||||||
Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
|
Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
|
||||||
inc(Result);
|
inc(Result);
|
||||||
RR.RDLength := ntohs(RR.RDLength);
|
RR.RDLength := ntohs(RR.RDLength);
|
||||||
Inc(AnsStart,RR.RDLength);
|
Inc(AnsStart,RR.RDLength);
|
||||||
end;
|
end;
|
||||||
|
DNSQRY_CNAME:
|
||||||
|
begin
|
||||||
|
if Recurse >= MaxRecursion then
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
rr.rdlength := ntohs(rr.rdlength);
|
||||||
|
setlength(Address, rr.rdlength);
|
||||||
|
address := stringfromlabel(ans.payload, ansstart);
|
||||||
|
Result := ResolveAddressAt(Resolver, Address, Names, Recurse+1);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
Inc(I);
|
Inc(I);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1084,7 +1100,7 @@ begin
|
|||||||
S:=Format('%d.%d.%d.%d.in-addr.arpa',[nt.s_bytes[4],nt.s_bytes[3],nt.s_bytes[2],nt.s_bytes[1]]);
|
S:=Format('%d.%d.%d.%d.in-addr.arpa',[nt.s_bytes[4],nt.s_bytes[3],nt.s_bytes[2],nt.s_bytes[1]]);
|
||||||
While (Result=0) and (I<=high(DNSServers)) do
|
While (Result=0) and (I<=high(DNSServers)) do
|
||||||
begin
|
begin
|
||||||
Result:=ResolveAddressAt(I,S,Addresses);
|
Result:=ResolveAddressAt(I,S,Addresses,1);
|
||||||
Inc(I);
|
Inc(I);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1111,7 +1127,7 @@ begin
|
|||||||
I := 0;
|
I := 0;
|
||||||
While (Result=0) and (I<=high(DNSServers)) do
|
While (Result=0) and (I<=high(DNSServers)) do
|
||||||
begin
|
begin
|
||||||
Result:=ResolveAddressAt(I,S,Addresses);
|
Result:=ResolveAddressAt(I,S,Addresses,1);
|
||||||
Inc(I);
|
Inc(I);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
@ -1156,7 +1156,7 @@ var
|
|||||||
procedure ErrClearError;
|
procedure ErrClearError;
|
||||||
procedure ErrFreeStrings;
|
procedure ErrFreeStrings;
|
||||||
procedure ErrRemoveState(pid: cInt);
|
procedure ErrRemoveState(pid: cInt);
|
||||||
procedure RandScreen;
|
procedure RandScreen; deprecated 'Deprecated as of 1.1+';
|
||||||
function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
|
function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
|
||||||
function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
|
function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
|
||||||
procedure PKCS12free(p12: SslPtr);
|
procedure PKCS12free(p12: SslPtr);
|
||||||
@ -5663,8 +5663,6 @@ begin
|
|||||||
_SslLoadErrorStrings;
|
_SslLoadErrorStrings;
|
||||||
if assigned(_OPENSSLaddallalgorithms) then
|
if assigned(_OPENSSLaddallalgorithms) then
|
||||||
_OPENSSLaddallalgorithms;
|
_OPENSSLaddallalgorithms;
|
||||||
if assigned(_RandScreen) then
|
|
||||||
_RandScreen;
|
|
||||||
if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
|
if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
|
||||||
InitLocks;
|
InitLocks;
|
||||||
SSLloaded := True;
|
SSLloaded := True;
|
||||||
|
@ -145,6 +145,8 @@ type
|
|||||||
procedure DescrEndItalic; override;
|
procedure DescrEndItalic; override;
|
||||||
procedure DescrBeginEmph; override;
|
procedure DescrBeginEmph; override;
|
||||||
procedure DescrEndEmph; override;
|
procedure DescrEndEmph; override;
|
||||||
|
procedure DescrBeginUnderline; override;
|
||||||
|
procedure DescrEndUnderline; override;
|
||||||
procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
|
procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
|
||||||
procedure DescrWriteFileEl(const AText: DOMString); override;
|
procedure DescrWriteFileEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
||||||
@ -1101,6 +1103,16 @@ begin
|
|||||||
PopOutputNode;
|
PopOutputNode;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure THTMLWriter.DescrBeginUnderline;
|
||||||
|
begin
|
||||||
|
PushOutputNode(CreateEl(CurOutputNode, 'u'));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure THTMLWriter.DescrEndUnderline;
|
||||||
|
begin
|
||||||
|
PopOutputNode;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
|
procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
|
||||||
|
|
||||||
Var
|
Var
|
||||||
|
@ -87,6 +87,8 @@ Type
|
|||||||
procedure DescrEndItalic; override;
|
procedure DescrEndItalic; override;
|
||||||
procedure DescrBeginEmph; override;
|
procedure DescrBeginEmph; override;
|
||||||
procedure DescrEndEmph; override;
|
procedure DescrEndEmph; override;
|
||||||
|
procedure DescrBeginUnderline; override;
|
||||||
|
procedure DescrEndUnderline; override;
|
||||||
procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
|
procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
|
||||||
procedure DescrWriteFileEl(const AText: DOMString); override;
|
procedure DescrWriteFileEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
||||||
@ -287,6 +289,16 @@ begin
|
|||||||
Write('}');
|
Write('}');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TLaTeXWriter.DescrBeginUnderline;
|
||||||
|
begin
|
||||||
|
Write('\underline{');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLaTeXWriter.DescrEndUnderline;
|
||||||
|
begin
|
||||||
|
Write('}');
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TLaTeXWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
|
procedure TLaTeXWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
|
||||||
|
|
||||||
Var
|
Var
|
||||||
|
@ -121,6 +121,8 @@ type
|
|||||||
procedure DescrEndItalic; override;
|
procedure DescrEndItalic; override;
|
||||||
procedure DescrBeginEmph; override;
|
procedure DescrBeginEmph; override;
|
||||||
procedure DescrEndEmph; override;
|
procedure DescrEndEmph; override;
|
||||||
|
procedure DescrBeginUnderline; override;
|
||||||
|
procedure DescrEndUnderline; override;
|
||||||
procedure DescrWriteFileEl(const AText: DOMString); override;
|
procedure DescrWriteFileEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteVarEl(const AText: DOMString); override;
|
procedure DescrWriteVarEl(const AText: DOMString); override;
|
||||||
@ -344,6 +346,16 @@ begin
|
|||||||
Write('}')
|
Write('}')
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TRTFWriter.DescrBeginUnderline;
|
||||||
|
begin
|
||||||
|
Write('{\ul ');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRTFWriter.DescrEndUnderline;
|
||||||
|
begin
|
||||||
|
Write('}');
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString);
|
procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString);
|
||||||
begin
|
begin
|
||||||
Write('{\f0 ');
|
Write('{\f0 ');
|
||||||
|
@ -138,6 +138,8 @@ Type
|
|||||||
procedure DescrEndItalic; override;
|
procedure DescrEndItalic; override;
|
||||||
procedure DescrBeginEmph; override;
|
procedure DescrBeginEmph; override;
|
||||||
procedure DescrEndEmph; override;
|
procedure DescrEndEmph; override;
|
||||||
|
procedure DescrBeginUnderline; override;
|
||||||
|
procedure DescrEndUnderline; override;
|
||||||
procedure DescrWriteFileEl(const AText: DOMString); override;
|
procedure DescrWriteFileEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteVarEl(const AText: DOMString); override;
|
procedure DescrWriteVarEl(const AText: DOMString); override;
|
||||||
@ -425,6 +427,17 @@ begin
|
|||||||
NewLine;
|
NewLine;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TManWriter.DescrBeginUnderline;
|
||||||
|
begin
|
||||||
|
NewLine;
|
||||||
|
Write('.I '); //use ITALIC!
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TManWriter.DescrEndUnderline;
|
||||||
|
begin
|
||||||
|
NewLine;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TManWriter.DescrWriteFileEl(const AText: DOMString);
|
procedure TManWriter.DescrWriteFileEl(const AText: DOMString);
|
||||||
|
|
||||||
Var
|
Var
|
||||||
|
@ -89,6 +89,8 @@ Type
|
|||||||
procedure DescrEndItalic; override;
|
procedure DescrEndItalic; override;
|
||||||
procedure DescrBeginEmph; override;
|
procedure DescrBeginEmph; override;
|
||||||
procedure DescrEndEmph; override;
|
procedure DescrEndEmph; override;
|
||||||
|
procedure DescrBeginUnderline; override;
|
||||||
|
procedure DescrEndUnderline; override;
|
||||||
procedure DescrWriteFileEl(const AText: DOMString); override;
|
procedure DescrWriteFileEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
procedure DescrWriteKeywordEl(const AText: DOMString); override;
|
||||||
procedure DescrWriteVarEl(const AText: DOMString); override;
|
procedure DescrWriteVarEl(const AText: DOMString); override;
|
||||||
@ -270,6 +272,14 @@ procedure TTXTWriter.DescrEndEmph;
|
|||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTXTWriter.DescrBeginUnderline;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTXTWriter.DescrEndUnderline;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTXTWriter.DescrWriteFileEl(const AText: DOMString);
|
procedure TTXTWriter.DescrWriteFileEl(const AText: DOMString);
|
||||||
begin
|
begin
|
||||||
DescrWriteText(AText);
|
DescrWriteText(AText);
|
||||||
|
@ -117,6 +117,8 @@ type
|
|||||||
procedure DescrEndBold; virtual; abstract;
|
procedure DescrEndBold; virtual; abstract;
|
||||||
procedure DescrBeginItalic; virtual; abstract;
|
procedure DescrBeginItalic; virtual; abstract;
|
||||||
procedure DescrEndItalic; virtual; abstract;
|
procedure DescrEndItalic; virtual; abstract;
|
||||||
|
procedure DescrBeginUnderline; virtual; abstract;
|
||||||
|
procedure DescrEndUnderline; virtual; abstract;
|
||||||
procedure DescrBeginEmph; virtual; abstract;
|
procedure DescrBeginEmph; virtual; abstract;
|
||||||
procedure DescrEndEmph; virtual; abstract;
|
procedure DescrEndEmph; virtual; abstract;
|
||||||
procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual;
|
procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual;
|
||||||
@ -637,6 +639,12 @@ begin
|
|||||||
ConvertBaseShortList(AContext, Node, False);
|
ConvertBaseShortList(AContext, Node, False);
|
||||||
DescrEndEmph;
|
DescrEndEmph;
|
||||||
end else
|
end else
|
||||||
|
if Node.NodeName = 'u' then
|
||||||
|
begin
|
||||||
|
DescrBeginUnderline;
|
||||||
|
ConvertBaseShortList(AContext, Node, False);
|
||||||
|
DescrEndUnderline;
|
||||||
|
end else
|
||||||
if Node.NodeName = 'file' then
|
if Node.NodeName = 'file' then
|
||||||
DescrWriteFileEl(ConvertTextContent)
|
DescrWriteFileEl(ConvertTextContent)
|
||||||
else if Node.NodeName = 'kw' then
|
else if Node.NodeName = 'kw' then
|
||||||
|
Loading…
Reference in New Issue
Block a user