{
   Double commander
   -------------------------------------------------------------------------
   This module contains classes with UTF8 file names support.

   Copyright (C) 2008-2024 Alexander Koblov (alexx2000@mail.ru)

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

}

unit DCClassesUtf8;

{$mode objfpc}{$H+}

interface

uses
  Classes, RtlConsts, SysUtils, IniFiles;

type
  { TFileStreamEx class }

  TFileStreamEx = class(THandleStream)
  private
    FDirty: Int64;
    FAutoSync: Boolean;
    FDirtyLimit: Int64;
    procedure SetAutoSync(AValue: Boolean);
  protected
    FFileName: String;
    procedure Sync(AWritten: Int64);
    procedure SetCapacity(const NewCapacity: Int64);
  public
    constructor Create(const AFileName: String; Mode: LongWord); virtual; overload;
    destructor Destroy; override;
    function Flush: Boolean;
    function Read(var Buffer; Count: LongInt): LongInt; override;
    function Write(const Buffer; Count: LongInt): LongInt; override;
    property DirtyLimit: Int64 read FDirtyLimit write FDirtyLimit;
    property AutoSync: Boolean read FAutoSync write SetAutoSync;
    property Capacity: Int64 write SetCapacity;
    property FileName: String read FFileName;
  end; 

  { TStringListEx }

  TStringListEx = class(TStringList)
  protected
    function DoCompareText(const S1, S2: String): PtrInt; override;
  public
    function IndexOfValue(const Value: String): Integer;
    procedure LoadFromFile(const FileName: String); override;
    procedure SaveToFile(const FileName: String); override;
  end;   

  { TIniFileEx }

  TIniFileEx = class(TMemIniFile)
  private
    FReadOnly: Boolean;
  public
    constructor Create(const AFileName: String; Mode: Word; AOptions: TIniFileOptions = []); virtual;
    constructor Create(const AFileName: String; AOptions: TIniFileOptions = []); override;
    procedure UpdateFile; override;
  public
    property ReadOnly: Boolean read FReadOnly;
  end;

implementation

uses
  DCOSUtils, LazUTF8;

{ TFileStreamEx }

procedure TFileStreamEx.SetAutoSync(AValue: Boolean);
const
  DIRTY_LIMIT = 1024 * 1024;
begin
  FAutoSync:= AValue;
  if AValue and (FDirtyLimit = 0) then
  begin
    FDirtyLimit:= DIRTY_LIMIT;
  end;
end;

procedure TFileStreamEx.Sync(AWritten: Int64);
const
  TARGET_LATENCY_LOW  = 900;
  TARGET_LATENCY_HIGH = 1100;
  DIRTY_LIMIT_LOW  = 512 * 1024;
  DIRTY_LIMIT_HIGH = MaxLongInt + 1;
var
  T1, T2: QWord;
  Elapsed: Double;
  Slowdown: Double;
begin
  FDirty+= AWritten;

  if FDirty < FDirtyLimit then
    Exit;

  FDirty:= 0;
  T1:= GetTickCount64;

  if not FileFlushData(Handle) then
    Exit;

  T2:= GetTickCount64;

  Elapsed:= (T2 - T1);

  if (Elapsed > TARGET_LATENCY_HIGH) then
  begin
    if (FDirtyLimit > DIRTY_LIMIT_LOW) then
    begin
      Slowdown:= Elapsed / TARGET_LATENCY_HIGH;

      if (Slowdown > 2) then
          FDirtyLimit := Round(FDirtyLimit / Slowdown)
       else begin
          FDirtyLimit := Round(FDirtyLimit * 0.7);
      end;

      if (FDirtyLimit < DIRTY_LIMIT_LOW) then
        FDirtyLimit := DIRTY_LIMIT_LOW
      else begin
        FDirtyLimit := (FDirtyLimit div 4096 * 4096);
      end;
    end;
  end
  else if (Elapsed < TARGET_LATENCY_LOW) then
  begin
    if FDirtyLimit < DIRTY_LIMIT_HIGH then
    begin
      FDirtyLimit := Round(FDirtyLimit * 1.3);

      if (FDirtyLimit > DIRTY_LIMIT_HIGH) then
        FDirtyLimit := DIRTY_LIMIT_HIGH
      else begin
        FDirtyLimit := (FDirtyLimit div 4096 * 4096);
      end;
    end;
  end;
end;

procedure TFileStreamEx.SetCapacity(const NewCapacity: Int64);
begin
  FileAllocate(Handle, NewCapacity);
end;

constructor TFileStreamEx.Create(const AFileName: String; Mode: LongWord);
var
  AHandle: System.THandle;
begin
  if (Mode and fmCreate) <> 0 then
    begin
      AHandle:= mbFileCreate(AFileName, Mode);
      if AHandle = feInvalidHandle then
        raise EFCreateError.CreateFmt(SFCreateError + LineEnding + mbSysErrorMessage, [AFileName])
      else
        inherited Create(AHandle);
    end
  else
    begin 
      AHandle:= mbFileOpen(AFileName, Mode);
      if AHandle = feInvalidHandle then
        raise EFOpenError.CreateFmt(SFOpenError + LineEnding + mbSysErrorMessage , [AFilename])
      else
        inherited Create(AHandle);
    end;
  FFileName:= AFileName;
end;

destructor TFileStreamEx.Destroy;
begin
  inherited Destroy;
  // Close handle after destroying the base object, because it may use Handle in Destroy.
  if Handle <> feInvalidHandle then FileClose(Handle);
end;

function TFileStreamEx.Flush: Boolean;
begin
  Result:= FileFlush(Handle);
end;

function TFileStreamEx.Read(var Buffer; Count: LongInt): LongInt;
begin
  Result:= FileRead(Handle, Buffer, Count);
  if Result = -1 then
    raise EReadError.Create(mbSysErrorMessage(GetLastOSError));
end;

function TFileStreamEx.Write(const Buffer; Count: LongInt): LongInt;
begin
  Result:= inherited Write(Buffer, Count);
  if FAutoSync and (Result > 0) then Sync(Result);
end;

{ TStringListEx }

function TStringListEx.DoCompareText(const S1, S2: String): PtrInt;
begin
  if CaseSensitive then
    Result:= UTF8CompareStr(S1, S2)
  else
    Result:= UTF8CompareText(S1, S2);
end;

function TStringListEx.IndexOfValue(const Value: String): Integer;
var
  iStart: LongInt;
  sTemp: String;
begin
  CheckSpecialChars;
  Result:= 0;
  while (Result < Count) do
    begin
    sTemp:= Strings[Result];
    iStart:= Pos(NameValueSeparator, sTemp) + 1;
    if (iStart > 0) and (DoCompareText(Value, Copy(sTemp, iStart, MaxInt)) = 0) then
      Exit;
    Inc(result);
    end;
  Result:= -1;
end;

procedure TStringListEx.LoadFromFile(const FileName: String);
var
  fsFileStream: TFileStreamEx;
begin
  fsFileStream:= TFileStreamEx.Create(FileName, fmOpenRead or fmShareDenyNone);
  try
    LoadFromStream(fsFileStream);
  finally
    fsFileStream.Free;
  end;
end;

procedure TStringListEx.SaveToFile(const FileName: String);
var
  AMode: LongWord;
  fsFileStream: TFileStreamEx;
begin
  if not mbFileExists(FileName) then
    AMode:= fmCreate
  else begin
    AMode:= fmOpenWrite or fmShareDenyWrite;
  end;
  fsFileStream:= TFileStreamEx.Create(FileName, AMode);
  try
    SaveToStream(fsFileStream);
    if (AMode <> fmCreate) then fsFileStream.Size:= fsFileStream.Position;
  finally
    fsFileStream.Free;
  end;
end;

{ TIniFileEx }

constructor TIniFileEx.Create(const AFileName: String; Mode: Word;
  AOptions: TIniFileOptions);
var
  slLines : TStringListEx;
begin
  FReadOnly := ((Mode and $03) = fmOpenRead);

  inherited Create(EmptyStr, AOptions);

  if ((Mode and $03) <> fmOpenWrite) then
  begin
    if mbFileExists(AFileName) then
    begin
      slLines := TStringListEx.Create;
      try
        slLines.LoadFromFile(AFileName);
        SetStrings(slLines);
      finally
        slLines.Free;
      end;
    end;
  end;
  Rename(AFileName, False);
end;

constructor TIniFileEx.Create(const AFileName: String; AOptions: TIniFileOptions);
var
  Mode: Word;
begin
  if not mbFileExists(AFileName) then
    Mode := fmOpenWrite or fmShareDenyWrite
  else if mbFileAccess(AFileName, fmOpenReadWrite or fmShareDenyWrite) then
    Mode := fmOpenReadWrite or fmShareDenyWrite
  else begin
    Mode := fmOpenRead or fmShareDenyNone;
  end;
  Create(AFileName, Mode, AOptions);
end;

procedure TIniFileEx.UpdateFile;
var
  slLines: TStringListEx;
begin
  if not FReadOnly then
  begin
    slLines := TStringListEx.Create;
    try
      GetStrings(slLines);
      slLines.SaveToFile(FileName);
      PBoolean(@Dirty)^:= False;
    finally
      slLines.Free;
    end;
  end;
end;

end.