Delphi 利用TStringList 构建简单数据库

来源：互联网发布：少女终末旅行知乎编辑：程序博客网时间：2024/05/17 09:42

Delphi 的数据库功能很是强大。但是笔者使用中却面临着很多问题。其次开发一个小型数据库工程，也因为使用BDE 增加了文件的大小，和发布的难度。在笔者的使用途中发现了TStringList,的许多优点，下文通过TStringList 制作了一个简单的数据库，它不需要安装任何数据引擎，就可以工作:

unit UnitTextData;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TTextData = Class(TPersistent)
private
    { Private declarations }
    FBase: TStringList;
    FPath: String;
    FtmpStr: TStringList;
    FFieldNames: TStringList;
    FPoint: Integer;
    FFReSult: array of Integer;
    FFPoint: Integer;

implementation

constructor TTextData.Create(FileName: String);
begin
FPath := FileName;
FBase := TStringList.Create;
FtmpStr := TStringList.Create;
FFieldNames := TStringList.Create;

if not FileExists(FileName) then begin
FBase.Clear;
FBase.SaveToFile(FileName);
end;

FPoint := 0;
FBase.LoadFromFile(FileName);
GetFieldNames;
end;

destructor TTextData.Destroy;
begin
if FPath <> '' then
FBase.SaveToFile(FPath);
end;

procedure TTextData.GetFieldNames();
begin
FFieldNames.CommaText := FBase[0];
end;

function TTextData.GetFieldValue(FieldName: String): String;
var
IField: Integer;
begin
ReSult := '"';
for IField := 0 to FFieldNames.Count - 1 do begin
      if UpperCase(FFieldNames[IField]) =
         UpperCase(FieldName) then begin
         FtmpStr.CommaText := FBase[FPoint + 1];
         ReSult := FtmpStr[IField];
         Break;
      end;
end;
end;

procedure TTextData.SetFieldValue(FieldName: String;
                                  Value: String);
var
IField: Integer;
begin
for IField := 0 to FFieldNames.Count - 1 do begin
      if UpperCase(FFieldNames[IField]) =
         UpperCase(FieldName) then begin
         FtmpStr.CommaText := FBase[FPoint + 1];
         FtmpStr[IField] := Value;
         FBase[FPoint + 1] := FtmpStr.CommaText;
      end;
end;
end;

procedure TTextData.First;
begin
FPoint := 0;
end;

procedure TTextData.Last;
begin
FPoint := FBase.Count - 2;
end;

procedure TTextData.Previous;
begin
if FPoint > -1 then
FPoint := FPoint - 1;
end;

procedure TTextData.Next;
begin
if FPoint < FBase.Count - 1 then
FPoint := FPoint + 1;
end;

function TTextData.FindNo(No: Integer): Boolean;
begin
ReSult := False;
if (No > -1) And (No <= FBase.Count - 2) then begin
FPoint := No;
ReSult := True;
end;
end;

function TTextData.IsBof: Boolean;
begin
if FPoint = -1 then
ReSult := True
else
ReSult := False;
end;

function TTextData.IsEof: Boolean;
begin
if FPoint = FBase.Count - 1 then
ReSult := True
else
ReSult := False;
end;

function TTextData.FRecCount: Integer;
begin
ReSult := FBase.Count - 1;
end;

procedure TTextData.InsertRec(Index: Integer);
begin
FtmpStr.Clear;
While (FtmpStr.Count <> FFieldNames.Count) do
FTmpStr.Add('');
FBase.Insert(Index + 1,FTmpStr.CommaText);
FPoint := Index;
end;

procedure TTextData.AppendRec;
begin
FtmpStr.Clear;
While (FtmpStr.Count <> FFieldNames.Count) do
FTmpStr.Add('');
FBase.Add(FTmpStr.CommaText);
FPoint := FBase.Count - 2;
end;

procedure TTextData.DeleteRec(Index: Integer);
begin
FBase.Delete(Index + 1);
if Index < FBase.Count - 1 then
FPoint := Index
else
FPoint := FBase.Count - 1;
end;

function TTextData.FindRec(Field: String; Value: String): Boolean;
begin
ReSult := False;

FFPoint := 0;
SetLength(FFReSult,0);
First;
while (not Eof) do begin
        if UpperCase(FieldValues[Field]) = UpperCase(Value) then begin
             ReSult := True;
             SetLength(FFResult,Length(FFResult) + 1);
             FFResult[Length(FFResult) - 1] := FPoint;
        end;
        Next;
end;

if ReSult then FindFirst;
end;

function TTextData.FindFirst: Boolean;
begin
ReSult := False;
if Length(FFReSult) <> 0 then begin
     ReSult := True;
     FFPoint := 0;
     FPoint := FFReSult[FFPoint];
end;
end;

function TTextData.FindPrevious: Boolean;
begin
ReSult := False;
if Length(FFReSult) <> 0 then begin
     if FFPoint > 0 then begin
        FFPoint := FFPoint - 1;
        ReSult := True;
        FPoint := FFReSult[FFPoint];
     end;
end;
end;

function TTextData.FindNext: Boolean;
begin
ReSult := False;
if Length(FFReSult) <> 0 then begin
     if FFPoint < Length(FFReSult) - 1 then begin
        FFPoint := FFPoint + 1;
        ReSult := True;
        FPoint := FFReSult[FFPoint];
     end;
end;
end;

function TTextData.FindLast: Boolean;
begin
ReSult := False;
if Length(FFReSult) <> 0 then begin
     ReSult := True;
     FFPoint := Length(FFReSult) - 1;
     FPoint := FFReSult[FFPoint];
end;
end;

function TTextData.GetFindCount: Integer;
begin
ReSult := Length(FFReSult);
end;

function TTextData.GetCurRecord: PString;
begin
ReSult := PString(FBase[FPoint + 1]);
end;

function TTextData.IndexOfRec(Rec: Pointer): Integer;
var
IFind: Integer;
begin
ReSult := 0;
for IFind := 0 to FBase.Count - 1 do begin
      if Rec = Pointer(PString(FBase[IFind])) then begin
         ReSult := IFind - 1; Break;
      end;
end;
end;

function TTextData.GetFields: String;
begin
ReSult := FBase[0];
end;

end.

清不要忘记在结束的时候，释放所占用的空间~