Przeglądaj źródła

* merge revs

git-svn-id: branches/fixes_3_2@43196 -
marco 5 lat temu
rodzic
commit
65ae9d2413

+ 1 - 0
.gitattributes

@@ -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/tests/fclbase-unittests.lpi 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/tchashlist.pp svneol=native#text/plain
 packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain

+ 591 - 3
packages/fcl-base/src/bufstream.pp

@@ -3,6 +3,7 @@
     Copyright (c) 1999-2000 by the Free Pascal development team
 
     Implement a buffered stream.
+    TBufferedFileStream contributed by José Mejuto, bug ID 30549.
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -27,8 +28,10 @@ Const
 
 Type
 
+{ ---------------------------------------------------------------------
+  TBufStream - simple read or write buffer, for sequential reading/writing
+  ---------------------------------------------------------------------}
 
-  { TBufStream }
   TBufStream = Class(TOwnerStream)
   Private
     FTotalPos : Int64;
@@ -70,12 +73,83 @@ Type
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
   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
 
 Resourcestring
-  SErrCapacityTooSmall = 'Capacity is less than actual buffer size.';
+  SErrCapacityTooSmall    = 'Capacity is less than actual buffer size.';
   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 }
 
@@ -257,4 +331,518 @@ begin
 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.

+ 4 - 2
packages/fcl-base/src/csvreadwrite.pp

@@ -124,7 +124,7 @@ Type
     // simple parsing
     procedure ParseValue;
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
     // Source data stream
     procedure SetSource(AStream: TStream); overload;
@@ -161,7 +161,7 @@ Type
     procedure AppendStringToStream(const AString: String; AStream: TStream);
     function  QuoteCSVString(const AValue: String): String;
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
     // Set output/destination stream.
     // If not called, output is sent to DefaultOutput
@@ -455,6 +455,7 @@ var
   b: packed array[0..2] of byte;
   n: Integer;
 begin
+  B[0]:=0; B[1]:=0; B[2]:=0;
   ClearOutput;
   FSourceStream.Seek(0, soFromBeginning);
   if FDetectBOM then
@@ -533,6 +534,7 @@ begin
   if StreamSize > 0 then
   begin
     SetLength(Result, StreamSize);
+    FDefaultOutput.Position:=0;
     FDefaultOutput.ReadBuffer(Result[1], StreamSize);
   end;
 end;

+ 2 - 9
packages/fcl-base/src/inifiles.pp

@@ -1381,17 +1381,10 @@ begin
       if FEncoding=nil then
         slLines.LoadFromFile(FFileName)
       else
-      begin
-        slLines.DefaultEncoding := FEncoding;
-        slLines.LoadFromFile(FFileName, nil);
-        if FEncoding <> slLines.Encoding then
         begin
-          if FOwnsEncoding then
-            FEncoding.Free;
-          FEncoding := slLines.Encoding;
-          FOwnsEncoding := not TEncoding.IsStandardEncoding(FEncoding);
+        slLines.DefaultEncoding := FEncoding; // TStrings clones the encoding.
+        slLines.LoadFromFile(FFileName, nil);
         end;
-      end;
       FillSectionList(slLines);
     finally
       slLines.Free;

+ 2 - 1
packages/fcl-base/src/maskutils.pp

@@ -308,7 +308,6 @@ end;
 // Clear (virtually) a single char in position Position
 function TMaskUtils.ClearChar(Position: Integer): Char;
 begin
-  Result := FMask[Position];
   //For Delphi compatibilty, only literals remain, all others will be blanked
   case CharToMask(FMask[Position]) Of
     Char_Number,
@@ -334,6 +333,8 @@ begin
     Char_AllFixedDownCase: Result := FSpaceChar;
     Char_HourSeparator: Result := DefaultFormatSettings.TimeSeparator;
     Char_DateSeparator: Result := DefaultFormatSettings.DateSeparator;
+  else
+    Result := FMask[Position];
   end;
 end;
 

+ 27 - 29
packages/fcl-base/src/streamex.pp

@@ -181,35 +181,33 @@ type
 
 
   TStreamHelper = class helper for TStream
-
-                     function  ReadWordLE :word;
-                     function  ReadDWordLE:dword;
-                     function  ReadQWordLE:qword;
-                     procedure WriteWordLE (w:word);
-  		     procedure WriteDWordLE(dw:dword);
-	             procedure WriteQWordLE(dq:qword);
-                     function  ReadWordBE :word;
-                     function  ReadDWordBE:dword;
-                     function  ReadQWordBE:qword;
-                     procedure WriteWordBE (w:word);
-  		     procedure WriteDWordBE(dw:dword);
-	             procedure WriteQWordBE(dq:qword);
-                     function  ReadSingle:Single;
-                     function  ReadDouble:Double;
-                     procedure WriteSingle(s:Single);
-                     procedure WriteDouble(d:double);
-
-                     {$ifndef FPC}
-                      function ReadByte  : Byte;
-                      function ReadWord  : Word;
-                      function ReadDWord : DWord;
-                      function ReadQWord : QWord;
-                      procedure WriteByte  (b : Byte);
-                      procedure WriteWord  (b : word);
-                      procedure WriteDWord (b : DWord);
-                      procedure WriteQWord (b : QWord);
-                     {$endif}
-                     end;
+    function  ReadWordLE :word;
+    function  ReadDWordLE:dword;
+    function  ReadQWordLE:qword;
+    procedure WriteWordLE (w:word);
+    procedure WriteDWordLE(dw:dword);
+    procedure WriteQWordLE(dq:qword);
+    function  ReadWordBE :word;
+    function  ReadDWordBE:dword;
+    function  ReadQWordBE:qword;
+    procedure WriteWordBE (w:word);
+    procedure WriteDWordBE(dw:dword);
+    procedure WriteQWordBE(dq:qword);
+    function  ReadSingle:Single;
+    function  ReadDouble:Double;
+    procedure WriteSingle(s:Single);
+    procedure WriteDouble(d:double);
+    {$ifndef FPC}
+    function ReadByte  : Byte;
+    function ReadWord  : Word;
+    function ReadDWord : DWord;
+    function ReadQWord : QWord;
+    procedure WriteByte  (b : Byte);
+    procedure WriteWord  (b : word);
+    procedure WriteDWord (b : DWord);
+    procedure WriteQWord (b : QWord);
+    {$endif}
+  end;
 
 Implementation
 

+ 16 - 10
packages/fcl-base/tests/fclbase-unittests.lpi

@@ -1,14 +1,15 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="fclbase-unittests"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
@@ -16,28 +17,29 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
         <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
-    <Units Count="6">
+    <Units Count="7">
       <Unit0>
         <Filename Value="fclbase-unittests.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fclbase_unittests"/>
       </Unit0>
       <Unit1>
         <Filename Value="tchashlist.pp"/>
@@ -59,6 +61,10 @@
         <Filename Value="tccsvreadwrite.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit5>
+      <Unit6>
+        <Filename Value="tcbufferedfilestream.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 1 - 1
packages/fcl-base/tests/fclbase-unittests.pp

@@ -4,7 +4,7 @@ program fclbase_unittests;
 
 uses
   Classes, consoletestrunner, tests_fptemplate, tchashlist,
-  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite;
+  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream;
 
 var
   Application: TTestRunner;

+ 393 - 0
packages/fcl-base/tests/tcbufferedfilestream.pp

@@ -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.
+

+ 26 - 10
packages/fcl-net/src/netdb.pp

@@ -1033,7 +1033,7 @@ begin
   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
@@ -1056,13 +1056,29 @@ begin
     I:=0;
     While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
       begin
-      if (Ntohs(RR.AType)=DNSQRY_PTR) and (1=NtoHS(RR.AClass)) then
-        begin
-        Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
-        inc(Result);
-        RR.RDLength := ntohs(RR.RDLength);
-        Inc(AnsStart,RR.RDLength);
-        end;
+      Case Ntohs(RR.AType) of
+        DNSQRY_PTR:
+          if (1=NtoHS(RR.AClass)) then
+            begin
+            Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
+            inc(Result);
+            RR.RDLength := ntohs(RR.RDLength);
+            Inc(AnsStart,RR.RDLength);
+            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);
       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]]);
   While (Result=0) and (I<=high(DNSServers)) do
     begin
-    Result:=ResolveAddressAt(I,S,Addresses);
+    Result:=ResolveAddressAt(I,S,Addresses,1);
     Inc(I);
     end;
 end;
@@ -1111,7 +1127,7 @@ begin
   I := 0;
   While (Result=0) and (I<=high(DNSServers)) do
     begin
-    Result:=ResolveAddressAt(I,S,Addresses);
+    Result:=ResolveAddressAt(I,S,Addresses,1);
     Inc(I);
     end;
 end;

+ 1 - 3
packages/openssl/src/openssl.pas

@@ -1156,7 +1156,7 @@ var
   procedure ErrClearError;
   procedure ErrFreeStrings;
   procedure ErrRemoveState(pid: cInt);
-  procedure RandScreen;
+  procedure RandScreen; deprecated 'Deprecated as of 1.1+';
   function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
   function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
   procedure PKCS12free(p12: SslPtr);
@@ -5663,8 +5663,6 @@ begin
       _SslLoadErrorStrings;
     if assigned(_OPENSSLaddallalgorithms) then
       _OPENSSLaddallalgorithms;
-    if assigned(_RandScreen) then
-      _RandScreen;
     if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
       InitLocks;
     SSLloaded := True;

+ 12 - 0
utils/fpdoc/dw_html.pp

@@ -145,6 +145,8 @@ type
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
@@ -1101,6 +1103,16 @@ begin
   PopOutputNode;
 end;
 
+procedure THTMLWriter.DescrBeginUnderline;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'u'));
+end;
+
+procedure THTMLWriter.DescrEndUnderline;
+begin
+  PopOutputNode;
+end;
+
 procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
 
 Var

+ 12 - 0
utils/fpdoc/dw_latex.pp

@@ -87,6 +87,8 @@ Type
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
@@ -287,6 +289,16 @@ begin
   Write('}');
 end;
 
+procedure TLaTeXWriter.DescrBeginUnderline;
+begin
+  Write('\underline{');
+end;
+
+procedure TLaTeXWriter.DescrEndUnderline;
+begin
+  Write('}');
+end;
+
 procedure TLaTeXWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); 
 
 Var

+ 12 - 0
utils/fpdoc/dw_linrtf.pp

@@ -121,6 +121,8 @@ type
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
@@ -344,6 +346,16 @@ begin
   Write('}')
 end;
 
+procedure TRTFWriter.DescrBeginUnderline;
+begin
+  Write('{\ul ');
+end;
+
+procedure TRTFWriter.DescrEndUnderline;
+begin
+  Write('}');
+end;
+
 procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString);
 begin
   Write('{\f0 ');

+ 13 - 0
utils/fpdoc/dw_man.pp

@@ -138,6 +138,8 @@ Type
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
@@ -425,6 +427,17 @@ begin
   NewLine;
 end;
 
+procedure TManWriter.DescrBeginUnderline;
+begin
+  NewLine;
+  Write('.I '); //use ITALIC!
+end;
+
+procedure TManWriter.DescrEndUnderline;
+begin
+  NewLine;
+end;
+
 procedure TManWriter.DescrWriteFileEl(const AText: DOMString);
 
 Var

+ 10 - 0
utils/fpdoc/dw_txt.pp

@@ -89,6 +89,8 @@ Type
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
@@ -270,6 +272,14 @@ procedure TTXTWriter.DescrEndEmph;
 begin
 end;
 
+procedure TTXTWriter.DescrBeginUnderline;
+begin
+end;
+
+procedure TTXTWriter.DescrEndUnderline;
+begin
+end;
+
 procedure TTXTWriter.DescrWriteFileEl(const AText: DOMString);
 begin
   DescrWriteText(AText);

+ 8 - 0
utils/fpdoc/dwriter.pp

@@ -117,6 +117,8 @@ type
     procedure DescrEndBold; virtual; abstract;
     procedure DescrBeginItalic; virtual; abstract;
     procedure DescrEndItalic; virtual; abstract;
+    procedure DescrBeginUnderline; virtual; abstract;
+    procedure DescrEndUnderline; virtual; abstract;
     procedure DescrBeginEmph; virtual; abstract;
     procedure DescrEndEmph; virtual; abstract;
     procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual; 
@@ -637,6 +639,12 @@ begin
       ConvertBaseShortList(AContext, Node, False);
       DescrEndEmph;
     end else
+    if Node.NodeName = 'u' then
+    begin
+      DescrBeginUnderline;
+      ConvertBaseShortList(AContext, Node, False);
+      DescrEndUnderline;
+    end else
     if Node.NodeName = 'file' then
       DescrWriteFileEl(ConvertTextContent)
     else if Node.NodeName = 'kw' then