Create & Work with Database

Mit dem folgenden Beispiel lässt sich eine gute Datenbank erstellen, verändern und steuern.  Die Daten werden beim Hinzufügen gespeichert.

Unit DataBase.pas

unit DataBase;

interface

uses
  windows, messages, SysUtils;

const
  TFM_ENUMCALLBACK = WM_USER+74;
  TFM_MAXRECORDS   = WM_USER+75;
  TFM_ENUMRECORDS  = WM_USER+76;

{ Adjust the record as you need it }
type
  TRecord = packed record
    Index : DWORD; { DO NOT remove or rename this field!!! }
    Name, Vorname : string[20];
  end;

type
  TTypedFile = class
  private
    f : file of TRecord;
    FRecordsCount : DWORD;
    FMaxID : DWORD;
    procedure GetMaxID;
  public
    constructor Create(Filename : string);
    destructor Free;
    function GetRecordsCount : DWORD;
    procedure AddRecord(Data : TRecord);
    function FindRecord(Idx : DWORD) : Integer;
    function GetRecord(Idx : DWORD) : TRecord;
    function DeleteRecord(Idx : DWORD) : Boolean;
    procedure ModifyRecord(Data : TRecord; Idx : DWORD);
    procedure SwapIt(var Record1, Record2: TRecord);
    function EnumRecords(hWnd: Cardinal; var Data: TRecord): Boolean;
  end;

implementation

constructor TTypedFile.Create(Filename : string);
var
  Data : TRecord;
begin
  AssignFile(f, Filename);
  { if exits open it }
  if FileExists(Filename) then
  begin
    //FileMode := fmShareExclusive;
    Reset(f);
  end
  { if not rewrite it }
  else
  begin
{$I-}
    Rewrite(f);
    if IOResult <> 0 then
    begin
      RaiseLastOSError;
{$I+}
      CloseFile(f);
      exit;
    end;
    FillChar(Data, sizeof(Data), #0);
    Data.Index := 0;
    { write the first emtpy record with the MaxID-Value }
    write(f, Data);
  end;
  { get the number of records }
  FRecordsCount := FileSize(f);
end;

destructor TTypedFile.Free;
begin
  CloseFile(f);
end;

procedure TTypedFile.GetMaxID;
var
  MyData : TRecord;
begin
  { first record }
  seek(f, 0);
  { read it and get the Index = FMaxID }
  read(f, MyData);
  FMaxID := MyData.Index;
  { increment it }
  MyData.Index := FMaxID + 1;
  { write it back }
  seek(f, 0);
  write(f, MyData);
end;

procedure TTypedFile.AddRecord(Data : TRecord);
begin
  { get a unique ID }
  GetMaxID;
  Data.Index := FMaxID;
  { jump to the end of the file }
  seek(f, FRecordsCount);
{$I-}
  { write the record to the file }
  write(f, Data);
  if IOResult <> 0 then
    RaiselastOSError();
{$I+}
  { update the number of records }
  FRecordsCount := FileSize(f);
end;

function TTypedFile.GetRecord(Idx : DWORD) : TRecord;
var
  Data : TRecord;
begin
  { go to the record }
  seek(f, Idx);
  { read the record }
  read(f, Data);
  { return the data }
  result := Data;
end;

function TTypedFile.FindRecord(Idx : DWORD) : Integer;
var
  i : Integer;
  Data : TRecord;
begin
  result := -1;
  { loop through the file }
  for i := 1 to FRecordsCount - 1 do
  begin
    seek(f, i);
    read(f, Data);
    { if the index matches the unique data-index, return the index }
    if Data.Index = Idx then
    begin
      result := i;
      exit;
    end;
  end;
end;

function TTypedFile.DeleteRecord(Idx : DWORD) : Boolean;
var
  LastRec : TRecord;
  idxRec : Integer;
begin
  result := FALSE;
  { file is empty as my pocket :-( }
  if FRecordsCount = 0 then
    exit;
  { get the last record }
  seek(f, FRecordsCount - 1);
  { store it in LastRec }
  read(f, LastRec);
  { find the record to delete }
  idxRec := FindRecord(Idx);
  { not found, FindRecord returns -1 }
  if idxRec = -1 then
    exit;
  { jump to the record to delete }
  seek(f, idxRec);
{$I-}
  { replace it with the last record }
  write(f, LastRec);
  if IOResult <> 0 then
  begin
    result := FALSE;
    RaiseLastOSError();
{$I+}
    exit;
  end;
  { jump to the last record - 1 }
  seek(f, FRecordsCount - 1);
  { cut the file off }
  Truncate(f);
  if IOResult <> 0 then
  begin
    result := FALSE;
    RaiseLastOSError();
{$I+}
    exit;
  end
  else
    result := TRUE;
  { adjust the number of records }
  Dec(FRecordsCount);
end;

procedure TTypedFile.ModifyRecord(Data : TRecord; Idx : DWORD);
begin
  { go to the appropriate record }
  seek(f, FindRecord(Idx));
  { the index field mustnt be empty }
  Data.Index := Idx;
  { modify the record }
{$I-}
  write(f, Data);
  if IOResult <> 0 then
    RaiseLastOSError();
{$I+}
end;

function TTypedFile.GetRecordsCount;
begin
  { minus 1 -> first record is empty, contains just the unique index }
  result := FRecordsCount - 1;
end;

procedure TTypedFile.SwapIt(var Record1, Record2: TRecord);
var
  TempRecord : TRecord;
begin
  TempRecord := Record1;
  Record1 := Record2;
  Record2 := TempRecord;
end;

function TTypedFile.EnumRecords(hWnd: Cardinal; var Data: TRecord): Boolean;
var
  i : Integer;
begin
  result := TRUE;
  SendMessage(hWnd, TFM_ENUMCALLBACK, TFM_MAXRECORDS, FRecordsCount);
  for i := 1 to FRecordsCount-1 do
  begin
    seek(f, i);
    read(f, Data);
    SendMessageCallback(hWnd, TFM_ENUMCALLBACK, TFM_ENUMRECORDS, Integer(@Data), nil, 0);
  end;
end;

end.

Unit1:

uses ComCtrls, DataBase

private
    { Private-Deklarationen }
    procedure UpdateStatusbar;
    procedure UpdateListbox;
  public
    { Public-Deklarationen }
    procedure HandleEnum(var msg: TMessage); message TFM_ENUMCALLBACK;
  end;

const
  DATAFILE = 'Data.dat'; // Datenbank

var
  Form1 : TForm1;
  CurrentRecord : DWORD;
  
//

procedure TForm1.HandleEnum(var msg: TMessage);
begin
  case msg.WParam of
    TFM_MAXRECORDS: Progressbar1.Max := msg.LParam-1;
    TFM_ENUMRECORDS:
    begin
      Listbox1.Items.Add(TRecord(Pointer(msg.lParam)^).Name);
      sleep(10);
      Progressbar1.StepIt;
    end;
  end;
end;

procedure TForm1.FormKeyDown(Sender : TObject; var Key : Word;
  Shift : TShiftState);
begin
  if Key = VK_ESCAPE then
    close;
end;

procedure TForm1.UpdateStatusbar;
var
  MyTypedFile : TTypedFile;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilePath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    Statusbar1.SimpleText := 'Datensatz: ' + IntToStr(CurrentRecord) + ' \ ' +
      IntToStr(MytypedFile.GetRecordsCount);
  finally
    MyTypedFile.Free;
  end;
end;

procedure TForm1.UpdateListbox;
var
  MyTypedFile : TTypedFile;
  MyRecord: TRecord;
begin
  ListBox1.Clear;
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' + DATAFILE);
  try
    MyTypedFile.EnumRecords(Handle, MyRecord);
  finally
    MyTypedFile.Free;
  end;
  Progressbar1.Position := 0;
end;

procedure TForm1.FormCreate(Sender : TObject);
var
  MyTypedFile : TTypedFile;
  MyRecordData : TRecord;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    if MyTypedFile.GetRecordsCount = 0 then
    begin
      btnBack.Enabled := FALSE;
      btnNext.Enabled := FALSE;
      btnModify.Enabled := FALSE;
      btnDelete.Enabled := FALSE;
      btnNew.Enabled := FALSE;
      CurrentRecord := 0;
    end
    else
    begin
      CurrentRecord := 1;
      MyRecordData := MyTypedFile.GetRecord(1);
      StaticText1.Caption := IntToStr(MyRecordData.Index);
      // Name ( Data1)
      Edit1.Text := MyRecordData.Name;
      // Vorname ( Data2)
      Edit2.Text := MyRecordData.Vorname;
    end;
  finally
    MyTypedFile.Free;
  end;
  UpdateStatusbar();
  UpdateListbox();
end;

// Button Neuer Eintrag
procedure TForm1.btnNewClick(Sender : TObject);
begin
  StaticText1.Caption := '';
  Edit1.Text := '';
  Edit2.Text := '';
  Edit1.SetFocus;
end;

// Button Hinzufügen (Speichern)
procedure TForm1.btnAddClick(Sender : TObject);
var
  MyTypedFile : TTypedFile;
  MyRecordData : TRecord;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    MyRecordData.Name := Edit1.Text;
    MyRecordData.Vorname := Edit2.Text;
    MyTypedFile.AddRecord(MyRecordData);
    Inc(CurrentRecord);
    btnNew.Enabled := TRUE;
    btnBack.Enabled := TRUE;
    btnNext.Enabled := TRUE;
  finally
    MyTypedFile.Free;
  end;
  UpdateStatusbar();
  UpdateListbox();
end;

// Button Nächster
procedure TForm1.btnNextClick(Sender : TObject);
var
  MyTypedFile : TTypedFile;
  MyRecordData : TRecord;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    if CurrentRecord < MyTypedFile.GetRecordsCount then
    begin
      Inc(CurrentRecord);
      MyRecordData := MyTypedFile.getRecord(CurrentRecord);
      StaticText1.Caption := IntToStr(MyRecordData.Index);
      Edit1.Text := MyRecordData.Name;
      Edit2.Text := MyRecordData.Vorname;
    end
  finally
    MyTypedFile.Free;
  end;
  UpdateStatusbar();
end;

// Button Zurück
procedure TForm1.btnBackClick(Sender : TObject);
var
  MyTypedFile : TTypedFile;
  MyRecordData : TRecord;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    if CurrentRecord > 1 then
    begin
      Dec(CurrentRecord);
      MyRecordData := MyTypedFile.GetRecord(CurrentRecord);
      StaticText1.Caption := IntToStr(MyRecordData.Index);
      Edit1.Text := MyRecordData.Name;
      Edit2.Text := MyRecordData.Vorname;
    end;
  finally
    MyTypedFile.Free;
  end;
  UpdateStatusbar();
end;

// Button Ändern
procedure TForm1.btnModifyClick(Sender : TObject);
var
  MyTypedFile : TTypedFile;
  MyRecordData : TRecord;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    MyRecordData.Name := Edit1.Text;
    MyRecordData.Vorname := Edit2.Text;
    MyTypedFile.ModifyRecord(MyRecordData, StrToInt(StaticText1.Caption));
  finally
    MyTypedFile.Free;
  end;
  UpdateListbox();
end;

// Button löschen
procedure TForm1.btnDeleteClick(Sender : TObject);
var
  MyTypedFile : TTypedFile;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' +
    DATAFILE);
  try
    MyTypedFile.DeleteRecord(StrToInt(StaticText1.Caption));
    Dec(CurrentRecord);
  finally
    MyTypedFile.Free;
  end;
  UpdateStatusbar();
  UpdateListbox();
end;

// Lesen der Daten
procedure TForm1.ListBox1Click(Sender: TObject);
var
  MyTypedFile : TTypedFile;
  MyRecordData : TRecord;
  s : String;
  i : Integer;
begin
  if Listbox1.ItemIndex = -1 then exit;
  s := ListBox1.Items[Listbox1.ItemIndex];
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' + DATAFILE);
  try
    for i := 1 to MytypedFile.GetRecordsCount-1 do
    begin
      MyRecordData := MyTypedFile.GetRecord(i);
      if MyRecordData.Name = s then
      begin
        Edit1.Text := MyRecordData.Name;
        Edit2.Text := MyRecordData.Vorname;
        StaticText1.Caption := IntToStr(MyRecordData.Index);
        break;
      end
      else
      begin
        Edit1.Text := '';
        Edit2.Text := '';
      end;
    end;
  finally
    MyTypedFile.Free;
  end;
end;

// Button Datenbank Sortieren
procedure TForm1.btnSortClick(Sender: TObject);
var
  MyTypedFile : TTypedFile;
  Record1, Record2 : TRecord;
  i, j : Integer;
begin
  MyTypedFile := TTypedFile.Create(ExtractFilepath(ParamStr(0)) + '\' + DATAFILE);
  try
    for i := MyTypedFile.GetRecordsCount downto 1 do
    begin
      for j := 2 to i do
      begin
        Record1 := MyTypedFile.GetRecord(j - 1);
        Record2 := MyTypedFile.GetRecord(j);
        if Record1.Name > Record2.Name then
        begin
          MyTypedFile.SwapIt(Record1, Record2);
          MyTypedFile.ModifyRecord(Record1, Record2.Index);
          MyTypedFile.ModifyRecord(Record2, Record1.Index);
        end;
      end;
    end;
  finally
    MyTypedFile.Free;
  end;
  UpdateListBox();
end;