[Страдалецъ]

Ну вот держите, когда-то писал для паскаля:

Код:

Unit DBase;

interface

Type
  TDic = record
   ID: Integer;
   Context: String[50];
   DicName: String[20];
  end;

  PDicList = ^TDicList;
  TDicList = record
   Data: TDic;
   Prev,Next: PDicList;
  end;

  TDictionary = object
   FileName: String;
   Items,First,Last: PDicList;
   constructor Create;
   procedure Add(id: Integer; Context, DicName: String);
   procedure Load(FN: String);
   procedure Save(FN: String);
   function GetContext(id: Integer): String;
   function GetID(Context, DicName: String): Integer;
  end;

  TData = record
   ID: Integer;
   ProductionID: Integer;
   Mark: String[50];
   Date: String[10];
   Completed: Boolean;
  end;

  PDataList = ^TDataList;
  TDataList = record
   Data: TData;
   Prev,Next: PDataList;
  end;

  TDatabase = object
   FileName: String;
   Items: PDataList;
   procedure Add(id, ProductionID: Integer; Mark,Date: String; Completed: Boolean);
   procedure Load(FN: String);
   procedure Save(FN: String);
  end;

implementation

constructor TDictionary.Create;
begin
 Items := nil;
 FileName := 'Dictionary.dat';
end;

procedure TDictionary.Add(id: Integer; Context, DicName: String);
Var
  P: PDicList;
begin
 New(P);
 P^.Data.ID := id;
 P^.Data.Context := Context;
 P^.Data.DicName := DicName;
 P^.Prev := nil;
 P^.Next := nil;
 if Items <> nil
 then begin
      Items^.Next := P;
      P^.Prev := Items;
      end
 else First := P;
 Items := P;
 Last := P;
end;

procedure TDictionary.Load(FN: String);
Var
  DicFile: file of TDic;
  Rec: TDic;
begin
 FileName := FN;
 Assign(DicFile, FileName);
 {$I-}Reset(DicFile);{$I+}
 if IOResult <> 0 then Exit;
 while not Eof(DicFile)
 do begin
    Read(DicFile, Rec);
    Add(Rec.ID, Rec.Context, Rec.DicName);
    end;
 Close(DicFile);
end;

procedure TDictionary.Save(FN: String);
Var
  DicFile: file of TDic;
  P: PDicList;
begin
 Assign(DicFile, FN);
 Rewrite(DicFile);
 P := Items;
 while P <> nil
 do begin
    Write(DicFile, P^.Data);
    P := P^.Prev;
    end;
 Close(DicFile);
end;

function TDictionary.GetContext(id: Integer): String;
Var
 P: PDicList;
begin
 GetContext := #0;
 P := Items;
 while P <> nil
 do begin
    if P^.Data.ID = id
    then begin
         GetContext := P^.Data.Context;
         Exit;
         end;
    P := P^.Prev;
    end;
end;

function TDictionary.GetID(Context,DicName: String): Integer;
Var
 P: PDicList;
begin
 GetID := -1;
 P := Items;
 while P <> nil
 do begin
    if (P^.Data.Context = Context) and (P^.Data.DicName = DicName)
    then begin
         GetID := P^.Data.ID;
         Exit;
         end;
    P := P^.Prev;
    end;
end;

procedure TDatabase.Add(id, ProductionID: Integer; Mark,Date: String; Completed: Boolean);
Var
  P: PDataList;
begin
 New(P);
 P^.Data.ID := id;
 P^.Data.ProductionID := ProductionID;
 P^.Data.Mark := Mark;
 P^.Data.Date := Date;
 P^.Data.Completed := Completed;
 P^.Prev := nil;
 P^.Next := nil;
 if Items <> nil
 then begin
      Items^.Next := P;
      P^.Prev := Items;
      end;
 Items := P;
end;

procedure TDatabase.Load(FN: String);
Var
  DataFile: file of TData;
  Rec: TData;
begin
 FileName := FN;
 Assign(DataFile, FileName);
 {$I-}Reset(DataFile);{$I+}
 if IOResult <> 0 then Exit;
 while not Eof(DataFile)
 do begin
    Read(DataFile, Rec);
    Add(Rec.ID, Rec.ProductionID, Rec.Mark, Rec.Date, Rec.Completed);
    end;
 Close(DataFile);
end;

procedure TDatabase.Save(FN: String);
Var
  DataFile: file of TData;
  P: PDataList;
begin
 Assign(DataFile, FN);
 Rewrite(DataFile);
 P := Items;
 while P <> nil
 do begin
    Write(DataFile, P^.Data);
    P := P^.Prev;
    end;
 Close(DataFile);
end;

end.