unit myStrUtils;

interface

uses Windows, Classes, SysUtils;

resourcestring
    SFCreateErrorEx = 'Cannot create file "%s". %s';
    SFOpenErrorEx   = 'Cannot open file "%s". %s';

const
    KB = Int64(1024);
    MB = 1024*KB;
    GB = 1024*MB;

    DEFAULT_BUFSIZE = 16*MB;
    MIN_BUFSIZE     = KB;
    MAX_BUFSIZE     = 16*MB;

type
    BigInt = Int64;
    TBufferedFileStream = class(TStream)
    private
        FHandle     : BigInt;
        FFileSize   : BigInt;
        FFileOffset : BigInt;
        FBuf        : PByte;
        FBufSize    : BigInt;
        FBufCount   : BigInt;
        FBufPos     : BigInt;
        FDirty      : Boolean;
        function GetPosition: Int64;
        procedure SetPosition(const Value: Int64);

    protected
        procedure   SetSize(const NewSize: Int64); override;
        function    GetFileSize: BigInt;
        procedure   Init(BufSize: BigInt);
        procedure   ReadFromFile;
        procedure   WriteToFile;
    public
        constructor Create(const FileName: string; Mode: Word; BufferSize: BigInt); overload;
        constructor Create(const FileName: string; Mode: Word; Rights: Cardinal; BufferSize: BigInt); overload;
        destructor  Destroy; override;

        procedure   Flush;
        function    BigRead(var Buffer; Count: BigInt): BigInt; overload;

        function    BigSeek(Offset: BigInt; Origin: Word): BigInt; overload;
        function    BigSeek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload;
        function    BigWrite(const Buffer; Count: BigInt): BigInt; overload;
        property    FastSize : BigInt read FFileSize;
        property    Position: Int64 read GetPosition write SetPosition;
    end;

    TCustomList = class(TList)
    private
        function GetStringItem(index: integer): AnsiString;
        function GetItemLength(index: integer): integer;
    protected
        FFromPos: Int64;
        FCurrentItemSize: integer;
        FBuffer: Pointer;
        FLastItem: Pointer;
        FBufferSize: int64;
        FItemsSize: int64;
        FSorted: boolean;
        FCurrentItem: Pointer;
        FCurrentItemIndex: integer;
        FStream: TBufferedFileStream;
        procedure FreeBuffer;
        function AllocateBuffer(const NewSize: BigInt): boolean;
        procedure ClearBuffer;
        procedure ScanBuffer;
    public
        constructor Create; overload;
        destructor Destroy; override;
        function LoadFromStream(const Stream: TBufferedFileStream; const AFromPos, AMaxLength: Int64): Int64;
        function SaveToStream(const Stream: TBufferedFileStream; const AFromPos: Int64): Int64;
        procedure Sort; overload;
        function InitMergeList(const AFileName: string; const AMaxLength: int64): boolean;
        procedure First;
        function Next: boolean;
        property CurrentItem: pointer read FCurrentItem;
        property CurrentItemSize: integer read FCurrentItemSize;
        property StringItem[index: integer]: AnsiString read GetStringItem;
        property ItemLength[index: integer]: integer read GetItemLength;
        property FromPos: Int64 read FFromPos;
        property ItemsSize: Int64 read FItemsSize;
    end;

function CustomCompareBuffer(S1, S2: Pointer): Integer;
function CustomCompareList(S1, S2: Pointer): Integer;
function Min(const IntOne, IntTwo: BigInt): BigInt;
function MakeString(const APointer: Pointer; const ASize: integer): AnsiString;
function ScanBuf(const AByte: Byte; const APointer: Pointer): integer;

implementation

uses RTLConsts;

function Min(const IntOne, IntTwo: BigInt): BigInt;
begin
    if IntOne > IntTwo then
        Result := IntTwo
    else
        Result := IntOne;
end;

function MakeString(const APointer: Pointer; const ASize: integer): AnsiString;
begin
    SetLength(Result, ASize);
    if LongBool(ASize) then
        System.Move(APointer^, Result[1], ASize);
end;

function ScanBuf(const AByte: Byte; const APointer: Pointer): integer;
var i: integer;
    b: byte;
begin
    i := 0;
    repeat
        b := PByte(NativeInt(APointer)+i)^;
        if b = AByte then exit(i)
        else if b = 13 then break;
        inc(i);
    until false;
    result := -1;
end;

function CustomCompareBuffer(S1, S2: Pointer): Integer;
var i1, i2: integer;

    function CmpStr(const P1, P2: integer; const S1, S2: pointer): integer;
    var i, l1, l2: integer;
        b1, b2: integer;
    begin
        result := 0;
        i := 0;
        repeat
            b1 := PByte(NativeInt(S1)+P1+i)^;
            b2 := PByte(NativeInt(S2)+P2+i)^;
            result := b1 - b2;
            inc(i);
        until (result <> 0) or (b1 = 13) or (b2 = 13);
    end;

    function CmpInt(const P1, P2: integer; const S1, S2: pointer): integer;
    var i: integer;
    begin
        i := 0;
        result := P1 - P2;
        while (result = 0) and (i < P2) and (i < P1) do begin
            result := PByte(NativeInt(S1)+i)^-PByte(NativeInt(S2)+i)^;
            inc(i);
        end;
    end;

begin
    i1 := ScanBuf(Ord('.'), S1);
    i2 := ScanBuf(Ord('.'), S2);
    result := CmpStr(i1+2, i2+2, S1, S2);
    if result = 0 then
        result := CmpInt(i1, i2, S1, S2);
end;

function CustomCompareList(S1, S2: Pointer): Integer;
begin
    result := CustomCompareBuffer(TCustomList(S1).CurrentItem, TCustomList(S2).CurrentItem);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TBufferedFileStream.Init(BufSize: BigInt);
begin
    FBufSize := BufSize;
    if FBufSize < MIN_BUFSIZE then
        FBufsize := MIN_BUFSIZE
    else
    if FBufSize > MAX_BUFSIZE then
        FBufSize := MAX_BUFSIZE
    else
    if (FBufSize mod MIN_BUFSIZE) <> 0 then
        FBufSize := DEFAULT_BUFSIZE;
    GetMem(FBuf, FBufSize);
    FFileSize   := GetFileSize;
    FBufCount   := 0;
    FFileOffset := 0;
    FBufPos     := 0;
    FDirty      := False;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TBufferedFileStream.Create(const FileName: string; Mode: Word;
    BufferSize: BigInt);
begin
    Create(Filename, Mode, 0, BufferSize);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TBufferedFileStream.Create(const FileName : string; Mode: Word;
    Rights: Cardinal; BufferSize: BigInt);
begin
    inherited Create;
    FHandle := -1;
    FBuf    := nil;
    if Mode = fmCreate then
    begin
        FHandle := FileCreate(FileName, Mode, Rights);
        if FHandle < 0 then
            raise EFCreateError.CreateResFmt(@SFCreateErrorEx,
                                             [ExpandFileName(FileName),
                                             SysErrorMessage(GetLastError)]);
    end
    else begin
        FHandle := FileOpen(FileName, Mode);
        if FHandle < 0 then
            raise EFOpenError.CreateResFmt(@SFOpenErrorEx,
                                           [ExpandFileName(FileName),
                                           SysErrorMessage(GetLastError)]);
    end;
    Init(BufferSize);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TBufferedFileStream.Destroy;
begin
    if (FHandle >= 0) then begin
        if FDirty then
            WriteToFile;
        FileClose(FHandle);
    end;
    if FBuf <> nil then
        FreeMem(FBuf, FBufSize);
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBufferedFileStream.GetFileSize: BigInt;
var
    OldPos : BigInt;
begin
    OldPos := FileSeek(FHandle, Int64(0), soFromCurrent);
    Result := FileSeek(FHandle, Int64(0), soFromEnd);
    FileSeek(FHandle, OldPos, soFromBeginning);
    if Result < 0 then
        raise Exception.Create('Cannot determine correct file size');
end;


function TBufferedFileStream.GetPosition: Int64;
begin
    Result := BigSeek(Int64(0), soCurrent);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TBufferedFileStream.ReadFromFile;
var
    NewPos : BigInt;
begin
    NewPos := FileSeek(FHandle, FFileOffset, soFromBeginning);
    if (NewPos <> FFileOffset) then
        raise Exception.Create('Seek before read from file failed');
    FBufCount := FileRead(FHandle, FBuf^, FBufSize);
    if FBufCount = -1 then
        FBufCount := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TBufferedFileStream.WriteToFile;
var
    NewPos : BigInt;
    BytesWritten : BigInt;
begin
    NewPos := FileSeek(FHandle, FFileOffset, soFromBeginning);
    if (NewPos <> FFileOffset) then
        raise Exception.Create('Seek before write to file failed');
    BytesWritten := FileWrite(FHandle, FBuf^, FBufCount);
    if (BytesWritten <> FBufCount) then
        raise Exception.Create('Could not write to file');
    FDirty := False;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TBufferedFileStream.Flush;
begin
    if FDirty and (FHandle >= 0) and (FBuf <> nil) then
        WriteToFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBufferedFileStream.BigRead(var Buffer; Count: BigInt): BigInt;
var
    Remaining   : BigInt;
    Copied      : BigInt;
    DestPos     : BigInt;
begin
    Result := 0;
    if FHandle < 0 then Exit;
    Remaining := Min(Count, FFileSize - (FFileOffset + FBufPos));
    Result := Remaining;
    if (Remaining > 0) then
    begin
        if (FBufCount = 0) then
            ReadFromFile;
        Copied := Min(Remaining, FBufCount - FBufPos);
        Move(FBuf[FBufPos], TByteArray(Buffer)[0], Copied);
        Inc(FBufPos, Copied);
        Dec(Remaining, Copied);
        DestPos := 0;
        while Remaining > 0 do
        begin
            if FDirty then
                WriteToFile;
            FBufPos := 0;
            Inc(FFileOffset, FBufSize);
            ReadFromFile;
            Inc(DestPos, Copied);
            Copied := Min(Remaining, FBufCount - FBufPos);
            Move(FBuf[FBufPos], TByteArray(Buffer)[DestPos], Copied);
            Inc(FBufPos, Copied);
            Dec(Remaining, Copied);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBufferedFileStream.BigWrite(const Buffer; Count: BigInt): BigInt;
var
    Remaining : BigInt;
    Copied    : BigInt;
    DestPos   : BigInt;
begin
    Result := 0;
    if FHandle < 0 then Exit;
    Remaining := Count;
    Result := Remaining;
    if (Remaining > 0) then begin
        if (FBufCount = 0) and ((FFileOffset + FBufPos) <= FFileSize) then
            ReadFromFile;
        Copied := Min(Remaining, FBufSize - FBufPos);
        Move(PByte(Buffer), FBuf[FBufPos], Copied);
        FDirty := True;
        Inc(FBufPos, Copied);
        if (FBufCount < FBufPos) then begin
            FBufCount := FBufPos;
            FFileSize := FFileOffset + FBufPos;
        end;
        Dec(Remaining, Copied);
        DestPos := 0;
        while Remaining > 0 do begin
            WriteToFile;
            FBufPos := 0;
            Inc(FFileOffset, FBufSize);
            if (FFileOffset < FFileSize) then
                ReadFromFile
            else
                FBufCount := 0;
            Inc(DestPos, Copied);
            Copied := Min(Remaining, FBufSize - FBufPos);
            Move(TByteArray(Buffer)[DestPos], FBuf[0], Copied);
            FDirty := True;
            Inc(FBufPos, Copied);
            if (FBufCount < FBufPos) then begin
                FBufCount := FBufPos;
                FFileSize := FFileOffset + FBufPos;
            end;
            Dec(Remaining, Copied);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBufferedFileStream.BigSeek(Offset: BigInt; Origin: Word): BigInt;
begin
    Result := BigSeek(Int64(Offset), TSeekOrigin(Origin));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBufferedFileStream.BigSeek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var
    NewPos        : BigInt;
    NewFileOffset : BigInt;
begin
    Result := 0;
    if FHandle < 0 then Exit;

    if (Offset = 0) and (Origin = soCurrent) then begin
        Result := FFileOffset + FBufPos;
        Exit;
    end;

    case Origin of
        soBeginning : NewPos := Offset;
        soCurrent   : NewPos := (FFileOffset + FBufPos) + Offset;
        soEnd       : NewPos := FFileSize + Offset;
      else
        raise Exception.Create('Invalid seek origin');
    end;

    if (NewPos < 0) then
        NewPos := 0
    else
    if (NewPos > FFileSize) then
        FFileSize := FileSeek(FHandle, NewPos - FFileSize, soFromEnd);

    NewFileOffset := (NewPos div FBufSize) * FBufSize;

    if (NewFileOffset <> FFileOffset) then begin
        if FDirty then
            WriteToFile;
        FFileOffset := NewFileOffset;
        FBufCount := 0;
    end;
    FBufPos := NewPos - FFileOffset;
    Result  := NewPos;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TBufferedFileStream.SetPosition(const Value: Int64);
begin
    BigSeek(Int64(Value), soBeginning);
end;

procedure TBufferedFileStream.SetSize(const NewSize: Int64);
begin
    if FHandle < 0 then Exit;
    BigSeek(NewSize, soFromBeginning);
    if NewSize < FFileSize then
        FFileSize := FileSeek(FHandle, NewSize, soFromBeginning);
{$IFDEF MSWINDOWS}
    if not SetEndOfFile(FHandle) then
        RaiseLastOSError;
{$ELSE}
    if ftruncate(FHandle, Position) = -1 then
        raise EStreamError(sStreamSetSize);
{$ENDIF}
end;

{ TCustomList }

function TCustomList.AllocateBuffer(const NewSize: BigInt): boolean;
begin
    result := false;
    if LongBool(FBuffer) then begin
        if FBufferSize <> NewSize then begin
            FreeBuffer;
        end else
            exit(true);
    end;
    try
        GetMem(FBuffer, NewSize);
        FBufferSize := NewSize;
        result := true;
    except on E: EOutOfMemory do begin
        result := false;
    end;
    end;
end;

procedure TCustomList.ClearBuffer;
begin
    FSorted := false;
    FItemsSize := 0;
end;

constructor TCustomList.Create;
begin
    inherited;
end;

destructor TCustomList.Destroy;
begin
    FreeBuffer;
    if LongBool(FStream) then
        FStream.Free;
    inherited;
end;

procedure TCustomList.First;
begin
    FCurrentItem := FBuffer;
end;

procedure TCustomList.FreeBuffer;
begin
    FSorted := false;
    if LongBool(FBuffer) then begin
        FreeMem(FBuffer, FBufferSize);
        FBuffer := nil;
        FBufferSize := 0;
        FItemsSize := 0;
    end;
end;

function TCustomList.GetStringItem(index: integer): AnsiString;
begin
    Result := MakeString(items[index], ItemLength[index]);
end;

function TCustomList.InitMergeList(const AFileName: string; const AMaxLength: int64): boolean;
var pos: int64;
begin
    FreeBuffer;
    FStream := TBufferedFileStream.Create(AFileName, fmOpenRead+fmShareDenyWrite, 0);
    pos := LoadFromStream(FStream, -1, AMaxLength);
    result := pos > 0;
    if result then begin
        ScanBuffer;
        result := Next;
    end;
end;

function TCustomList.GetItemLength(index: integer): integer;
begin
    if (Index >=0) and (Index < Count) then begin
        if Items[index] = FLastItem then
            result := NativeInt(FBuffer)+FItemsSize-NativeInt(Items[index])
        else begin
            if FSorted then begin
                result := ScanBuf(13, Items[index])+2
            end else begin
                result := NativeInt(Items[index+1])-NativeInt(Items[index])
            end;
        end;
    end else
        Error(@SListIndexError, Index);
end;

function TCustomList.LoadFromStream(const Stream: TBufferedFileStream; const AFromPos, AMaxLength: Int64): Int64;
var CR: BigInt;
begin
    result := 0;
    FCurrentItem := nil;
    FCurrentItemIndex := 0;
    FCurrentItemSize := 0;
    if AllocateBuffer(AMaxLength) then begin
        if AFromPos <> -1 then
            Stream.BigSeek(AFromPos, soFromBeginning);
        result := Stream.BigRead(FBuffer^, FBufferSize);
        if result > 0 then begin
            cr := 0;
            while PByte(NativeInt(FBuffer)+result-cr)^ <> 10 do
                inc(cr);
            result := result-cr+1;
            Stream.BigSeek(-cr+1, soFromCurrent);
        end;
    end;
    FSorted := false;
    FFromPos := AFromPos;
    FItemsSize := result;
end;

function TCustomList.Next: boolean;
begin
    if FCurrentItem = FLastItem then begin
        result := LoadFromStream(FStream, -1, FBufferSize) > 0;
        if result then begin
            ScanBuffer;
            FCurrentItem := FBuffer;
            FCurrentItemSize := ItemLength[0];
        end else begin
            FCurrentItem := nil;
            FCurrentItemSize := 0;
        end;
    end else if LongBool(FCurrentItem) then begin
        inc(FCurrentItemIndex);
        FCurrentItem := Items[FCurrentItemIndex];
        FCurrentItemSize := ItemLength[FCurrentItemIndex];
        result := true;
    end else begin
        FCurrentItem := FBuffer;
        FCurrentItemSize := ItemLength[0];
        result := true;
    end;
    if not Result then
        FCurrentItemSize := 0;
end;

function TCustomList.SaveToStream(const Stream: TBufferedFileStream; const AFromPos: Int64): Int64;
var i: integer;
begin
    result := 0;
    Stream.BigSeek(AFromPos, 0);
    if FSorted then begin
        for I := 0 to Count-1 do
            Stream.BigWrite(Items[i]^, ItemLength[i]);
    end else begin
        Stream.BigWrite(FBuffer^, FItemsSize);
    end;
    FFromPos := AFromPos;
    result := Stream.Position - AFromPos;
end;

procedure TCustomList.ScanBuffer;
var StartIdx, EndIdx: bigInt;
begin
    Clear;
    if (not LongBool(FBuffer)) or (not LongBool(FItemsSize)) then exit;

    StartIdx := 0;
    EndIdx := 0;
    repeat
        if PByte(NativeInt(FBuffer)+EndIdx)^ = 13 then begin
            Add(PByte(NativeInt(FBuffer)+StartIdx));
            while (PByte(NativeInt(FBuffer)+EndIdx)^ in [10, 13])
                and (EndIdx < FItemsSize) do inc(EndIdx);
            StartIdx := EndIdx;
        end;
        inc(EndIdx);
    until EndIdx >= FItemsSize;
    if Count > 0 then
        FLastItem := Items[Count-1]
    else
        FLastItem := nil;
end;

procedure TCustomList.Sort;
begin
    ScanBuffer;
    if Count < 2 then exit;
    Sort(CustomCompareBuffer);
    FSorted := true;
end;

end.