Delphi 利用TStringList 构建简单数据库

 Delphi 利用TStringList 构建简单数据库
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;

    function GetFieldValue(FieldName: String): String;
    procedure SetFieldValue(FieldName: String;
                            Value: String);
    procedure GetFieldNames;
    function IsBof: Boolean;
    function IsEof: Boolean;
    function FRecCount: Integer;
    function GetFindCount: Integer;
    function GetCurRecord: PString;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(FileName: String);
    destructor Destroy; override;
    procedure First;
    procedure Last;
    procedure Previous;
    procedure Next;
    function FindNo(No: Integer): Boolean;
    property FieldValues[FieldName: String]: String
             read GetFieldValue write SetFieldValue;
    procedure InsertRec(Index: Integer);
    procedure AppendRec;
    procedure DeleteRec(Index: Integer);
    function FindRec(Field: String; Value: String): Boolean;
    function FindFirst: Boolean;
    function FindPrevious: Boolean;
    function FindNext: Boolean;
    function FindLast: Boolean;
    function IndexOfRec(Rec: Pointer): Integer;
    property CurrentRec: PString read GetCurRecord;
    function GetFields: String;
  published
    { Published declarations }
    property Bof: Boolean read IsBof;
    property Eof: Boolean read IsEof;
    property RecCount: Integer read FRecCount;
    property RecNo: Integer read FPoint;
    property FindCount: Integer read GetFindCount;
end;

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.

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