Homepage von Thomas Schwobe
Home Software Quelltext Impressum Datenschutzerklärung

Quelltext:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Contnrs, Vcl.StdCtrls, Utils;

type
  TTextItem = class(TObject)
  private

  public
    Position: Int64;
    Text: string;

    constructor Create;
    destructor Destroy; override;
  end;

  TTextList = class(TObject)
  private
    FItems: TObjectList;

    FFileName: string;
    FFileStream: TFileStream;

    function GetCount: Integer;
    function GetItems(Index: Integer): string;
    procedure SetItems(Index: Integer; Value: string);
  public
    constructor Create(fn: string);
    destructor Destroy; override;

    function Add(Value: string): Integer;
    procedure Delete(Index: Integer);
    procedure Clear;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: string read GetItems write SetItems;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    tl: TTextList;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ReadInteger(sm: TFileStream): Integer;
begin
  sm.Read(result, sizeof(Integer));
end;

function ReadString(sm: TFileStream): string;
var len: Integer;

begin
  result:='';

  sm.Read(len, sizeof(Integer));

  if len>0 then
  begin
    result:=StringOfChar(' ', len);
    sm.Read(result[1], len*sizeof(Char));
  end;
end;

procedure WriteInteger(sm: TFileStream; i: Integer);
begin
  sm.Write(i, sizeof(Integer));
end;

procedure WriteString(sm: TFileStream; s: string);
var len: Integer;

begin
  len:=Length(s);

  sm.Write(len, sizeof(Integer));

  if len>0 then
    sm.Write(s[1], len*sizeof(Char));
end;

//

constructor TTextItem.Create;
begin
  inherited Create;

  Position:=-1;
  Text:='';
end;

destructor TTextItem.Destroy;
begin

  inherited Destroy;
end;

//

constructor TTextList.Create(fn: string);
var i, c: Integer;

    ti: TTextItem;

begin
  inherited Create;

  FItems:=TObjectList.Create(True);

  //

  FFileName:=fn;

  if FileExists(FFileName) then
  begin
    CopyFile(PChar(fn), PChar(ChangeFileExt(FFileName, '.tmp')), False);

    FFileStream:=TFileStream.Create(ChangeFileExt(FFileName, '.tmp'), fmOpenRead);

    //

    c:=ReadInteger(FFileStream);

    for i:=0 to c-1 do
    begin
      ti:=TTextItem.Create;
      ti.Position:=FFileStream.Position;
      ti.Text:='';

      FItems.Add(ti);

      ReadString(FFileStream); //überspringen
    end;
  end
  else
    FFileStream:=nil;
end;

destructor TTextList.Destroy;
var i: Integer;
    s: string;

    ti: TTextItem;

    fs: TFileStream;

begin
  fs:=TFileStream.Create(FFileName, fmCreate);

  try
    WriteInteger(fs, Count);

    for i:=0 to Count-1 do
    begin
      s:=Items[i];

      WriteString(fs, s);
    end;

  finally
    fs.Free;
  end;

  //

  if FileExists(FFileName) and (FFileStream<>nil) then
  begin
    FFileStream.Free;

    DeleteFile(ChangeFileExt(FFileName, '.tmp'));
  end;

  //

  FItems.Free;

  inherited Destroy;
end;

//

function TTextList.GetCount: Integer;
begin
  result:=FItems.Count;
end;

function TTextList.GetItems(Index: Integer): string;
begin
  if (Index>=0) and (Index<FItems.Count) then
  begin
    if FileExists(FFileName) and (FFileStream<>nil) and (TTextItem(FItems[Index]).Position>-1) and (TTextItem(FItems[Index]).Position<FFileStream.Size) then
    begin
      FFileStream.Position:=TTextItem(FItems[Index]).Position;
      result:=ReadString(FFileStream);
    end
    else
      result:=TTextItem(FItems[Index]).Text;
  end
  else
    result:='';
end;

procedure TTextList.SetItems(Index: Integer; Value: string);
begin
  if (Index>=0) and (Index<FItems.Count) then
  begin
    TTextItem(FItems[Index]).Position:=-1;
    TTextItem(FItems[Index]).Text:=Value;
  end;
end;

//

function TTextList.Add(Value: string): Integer;
var ti: TTextItem;

begin
  ti:=TTextItem.Create;
  ti.Position:=-1;
  ti.Text:=Value;

  result:=FItems.Add(ti);
end;

procedure TTextList.Delete(Index: Integer);
begin
  if (Index>=0) and (Index<FItems.Count) then
    FItems.Delete(Index);
end;

procedure TTextList.Clear;
begin
  FItems.Clear;
end;

//

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;

begin
  tl:=TTextList.Create(AddBackSlash(ExtractFilePath(Application.Exename))+'Test.ttl');

  for i:=0 to tl.Count-1 do
    ListBox1.Items.Add(tl.Items[i]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  tl.Free;
end;

//

procedure TForm1.FormClick(Sender: TObject);
begin
  if ListBox1.ItemIndex>-1 then
  begin
    tl.Items[ListBox1.ItemIndex]:=Edit1.Text;

    ListBox1.Items[ListBox1.ItemIndex]:=Edit1.Text;
  end;
end;

//

procedure TForm1.Button1Click(Sender: TObject);
begin
  tl.Add(Edit1.Text);

  ListBox1.Items.Add(Edit1.Text);
end;

end.

© 2025 by Thomas Schwobe