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