32 Bit, TStringList, Textdatei mit 30Mio. Zeilen

[hoika]

Hallo,
nix gegen den, der das damals so programmiert hat ... (ich war es nicht).

Hier meine Unit.


Heiko

Delphi-Quellcode:

unit LargeStringList;

interface

uses
  Classes;

type
  TLargeStringList = class(TStrings)
    private
      FItems: array of String;

      function GetField(Index: Integer): String;
    public
      property Strings[Index: Integer]: String read GetField; default;

      constructor Create;
      destructor Destroy; override;
      function Count: Integer;
      function Add(const S: String): Integer; override;
      procedure Clear; override;
      procedure LoadFromFile(const DateiName: String); override;
      procedure SaveToFile(const DateiName: String); override;
      procedure AppendToFile(const DateiName: String);
      function Text: String;
      function TextKurz: String;
      function Get(Index: Integer): string; override;
      function GetCount: Integer; override;
      procedure Delete(Index: Integer); override;
      procedure Insert(Index: Integer; const S: String); override;
  end;

implementation

uses
  SysUtils;

{ TLargeStringList }

function TLargeStringList.Add(const S: String): Integer;
var
  iLaenge: Integer;
begin
  iLaenge := Length(FItems);
  SetLength(FItems, iLaenge+1);
  FItems[iLaenge] := S;

  Result := iLaenge;
end;

procedure TLargeStringList.Clear;
begin
  FItems := nil;
end;

function TLargeStringList.Count: Integer;
begin
  Result := Length(FItems);
end;

constructor TLargeStringList.Create;
begin
  inherited ;

  FItems := nil;
end;

destructor TLargeStringList.Destroy;
begin
  FItems := nil;

  inherited;
end;

function TLargeStringList.Get(Index: Integer): string;
begin
  Result := FItems[Index];
end;

function TLargeStringList.GetCount: Integer;
begin
  Result := Length(FItems);
end;

procedure TLargeStringList.Delete(Index: Integer);
begin
  raise Exception.Create('nicht implementiert');
end;

procedure TLargeStringList.Insert(Index: Integer; const S: String);
begin
  raise Exception.Create('nicht implementiert');
end;

function TLargeStringList.GetField(Index: Integer): String;
begin
  Result := FItems[Index];
end;

procedure TLargeStringList.LoadFromFile(const DateiName: String);
var
  TextDatei: TextFile;
  Puffer: array[0..16384] of AnsiChar;
  sZeile: String;
begin
  FItems := nil;

  System.SetTextBuf(TextDatei, Puffer);
  AssignFile(TextDatei, DateiName);
  Reset(TextDatei);
  try
    while not Eof(TextDatei) do
    begin
      ReadLn(TextDatei, sZeile);
      Add(sZeile);
    end;
  finally
    CloseFile(TextDatei);
  end;
end;

procedure TLargeStringList.SaveToFile(const DateiName: String);
var
  TextDatei: TextFile;
  Puffer: array[0..16384] of AnsiChar;
  iZeile: Integer;
  sZeile: String;
begin
  System.SetTextBuf(TextDatei, Puffer);
  AssignFile(TextDatei, DateiName);
  Rewrite(TextDatei);
  try
    for iZeile := 0 to Count-1 do
    begin
      sZeile := Strings[iZeile];
      WriteLn(TextDatei, sZeile);
    end;
  finally
    CloseFile(TextDatei);
  end;
end;

procedure TLargeStringList.AppendToFile(const DateiName: String);
var
  TextDatei: TextFile;
  Puffer: array[0..16384] of AnsiChar;
  iZeile: Integer;
  sZeile: String;
begin
  if FileExists(DateiName) then
  begin
    System.SetTextBuf(TextDatei, Puffer);
    AssignFile(TextDatei, DateiName);
    System.Append(TextDatei);
    try
      for iZeile := 0 to Count-1 do
      begin
        sZeile := Strings[iZeile];
        WriteLn(TextDatei, sZeile);
      end;
    finally
      CloseFile(TextDatei);
    end;
  end
  else
  begin
    SaveToFile(DateiName);
  end;
end;

function TLargeStringList.Text: String;
var
  iZeile: Integer;
  S: String;
begin
  S := '';

  for iZeile := Low(FItems) to High(FItems) do
  begin
    S:= S+#13#10+FItems[iZeile];
  end;

  Result := S;
end;

function TLargeStringList.TextKurz: String;
var
  iZeile: Integer;
  S: String;
begin
  S := '';

  for iZeile := Low(FItems) to High(FItems) do
  begin
    S:= S+#13#10+FItems[iZeile];

    if iZeile>1000 then
    begin
      break;
    end;
  end;

  Result := S;
end;

end.