Browse Source

+ Initial read-only implementation

michael 26 years ago
parent
commit
61786422ce
14 changed files with 6598 additions and 0 deletions
  1. 322 0
      fcl/db/Dataset.txt
  2. 154 0
      fcl/db/Makefile
  3. 48 0
      fcl/db/README
  4. 39 0
      fcl/db/createds.pp
  5. 158 0
      fcl/db/database.inc
  6. 1267 0
      fcl/db/dataset.inc
  7. 1238 0
      fcl/db/db.pp
  8. 25 0
      fcl/db/dbs.inc
  9. 488 0
      fcl/db/ddg_ds.pp
  10. 24 0
      fcl/db/ddg_rec.pp
  11. 1718 0
      fcl/db/fields.inc
  12. 166 0
      fcl/db/mtest.pp
  13. 791 0
      fcl/db/mysqldb.pp
  14. 160 0
      fcl/db/testds.pp

+ 322 - 0
fcl/db/Dataset.txt

@@ -0,0 +1,322 @@
+Contents
+========
+
++ General remarks
++ Fields system
++ The buffers
++ Dataset implementation
++ Scalable Datasets.
+
+===============
+General remarks
+===============
+
+- All fields and descendents implemented.
+- No calculated fields.
+- No Datasource yet. (although DataEvent is implemented in TField)
+- No persistent fields; this must be added later.
+
+
+=============
+Fields system
+=============
+
+Buffers are completely handled by the Dataset. Fields don't handle
+their own buffers. Only during validation, the FValueBuffer of the 
+field is used. 
+
+This allows the dataset to allocate a number of buffers for the current
+record and the N next records. (getnextrecords/getpriorrecords method)
+
+This means that all field mechanisms MUST pass through GetData/SetData,
+since FValueBuffer is only valid during validation.
+
+===========
+The Buffers
+===========
+
+A buffer contains all the data for 1 record of the dataset, and also
+the bookmark information. (bookmarkinformation is REQUIRED)
+
+The dataset allocates by default 'DefultBufferCount+1' records(buffers)
+This constant can be changed, at the beginning of dataset.inc;
+if you know you'll be working with big datasets, you can 
+increase this constant.
+
+The buffers are stored as pchars in the FBuffers array;
+The following constants are userd when handling this array:
+
+FBuffercount : The number of buffers allocated, minus one.
+FRecordCount : The number of buffers that is actually filled in.
+FActiveBuffer : The index of the active record.
+FCurrentRecord : The current Buffer. Should be phased out.
+
+So the following picture follows from this:
+
++---------------+
+|  0            |
++---------------+
+|  1            |
++---------------+
+|               |
+   ...
+|               |
++---------------+
+| FActivebuffer |
++---------------+
+|               |
+    ...
+|               |
++---------------+
+|FRecordCount-1 |
++---------------+
+|               |
+  ...
+|               |
++---------------+
+| FBufferCount  |
++---------------+ 
+
+The array is zero based. 
+
+The following methods are used to manipulate the array:
+
+GetNextRecords: Tries to fill up the entire array, going forward
+GetPriorRecords: tries to fill up the entire array, going backward
+GetNextRecord: gets the next record. Shifts the array if FrecordCount=BufferCount-1
+GetPriorRecord: gets the previous record. Shifts the array if FrecordCount=BufferCount-1
+
+For the last 2 methods: the underlying record pointer must be on the 
+last/first record in the dataset, or it will go wrong.
+
+resync tries to refresh the array from the underlying dataset; it uses the
+bookmarks for that.
+
+=======================
+Dataset implementations
+=======================
+
+TDataset does most of the work associated with fields, buffers and
+navigating/editing/adding/removing records of some source of data. 
+There are, however, some methods that need to be filled in so that 
+a real TDataset can be implemented. 
+
+In order to have a working Dataset, the following Methods  need to be 
+overridden in order to make a dataset descendant:
+
+function AllocRecordBuffer: PChar; virtual; abstract;
+-----------------------------------------------------
+
+Must allocate enough memory to store a complete record in the dataset.
+Optionally, this buffer must contain enough memory to store bookmarkdata.
+The descendent must be able to construct a bookmark from this buffer.
+
+procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
+-----------------------------------------------------------------
+
+Must free the memory allocated in the AllocRecordBuffer call.
+
+procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
+---------------------------------------------------------------------------
+
+Puts the bookmarkdata for Buffer into the area pointed to by Data.
+
+function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
+--------------------------------------------------------------------------
+
+Returns the bookmarkflag associated with Buffer.
+
+function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
+----------------------------------------------------------------------------------
+
+Puts the data for field Field from the active buffer into Buffer. 
+This is called whenever a field value is demanded, so it must be
+efficient. 
+
+function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
+-----------------------------------------------------------------------------------
+
+This method must do 3 things:
+1) Get the record data for the next/current/previous record, depending
+   on the GetMode value. It should return 
+    grOK    if all was OK.
+    grBOF   if the previous record was requested, and we are at the start. 
+    grEOF   if the next record was requested, and we are at the end.
+    grError if an error occurred.
+   
+2) If DoCheck is True, and the result is grError, then an exception must be
+    raised.
+
+3) It should initialize bookmark data for this record with flag 'bfCurrent'
+   This data can be stored in the bufer, if space was allocated for it with
+   AllocRecordBuffer.
+ 
+function GetRecordSize: Word; virtual; abstract;
+------------------------------------------------
+
+Should return the record size; this includes ONLY the data portion
+of teh buffer; it excludes any bookmark or housekeeping info you may
+have put in the buffer.
+
+procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
+---------------------------------------------------------------------------------
+
+Adds a record to the dataset. The record's data is in Buffer and Append
+indicates whether the record should be appended (True) or Inserted (False).
+Note that for SQL based datasets, this has no meaning.
+
+procedure InternalClose; virtual; abstract;
+-------------------------------------------
+
+Closes the dataset. Any resources allocated in InternalOpen should be freed
+here.
+
+procedure InternalDelete; virtual; abstract;
+--------------------------------------------
+
+Deletes the current Record.
+
+procedure InternalFirst; virtual; abstract;
+-------------------------------------------
+
+This is called when 'First' is called; After this method, getrecord
+should return 'grBOF' if the previous record is requested, and it should
+return the next record if the next record is requested.
+
+procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
+----------------------------------------------------------------------
+
+Set the record position on the position that is associated with the
+ABookMark data. The ABookMark data is the data that is acquired through
+the GetBookMarkData call, and should be kept for each record.
+
+procedure InternalHandleException; virtual; abstract;
+-----------------------------------------------------
+
+Not needed yet. Just implement an empty call.
+
+procedure InternalInitFieldDefs; virtual; abstract;
+---------------------------------------------------
+
+This method should be called from InternalOpen, and should
+initialize FieldDef definitions for all fields in a record.
+It should add these definitions to the FFielddefs object.
+
+
+procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
+---------------------------------------------------------------
+
+This method is called to initialize a field buffer when the dataset
+is put into edit or append mode. Mostly,you'll want to zero out the 
+buffer.
+
+procedure InternalLast; virtual; abstract;
+------------------------------------------
+
+This is called when 'Last' is called; After this method, getrecord
+should return 'grEOF' if the next record is requested, and it should
+return the last record if the previous record is requested.
+
+procedure InternalOpen; virtual; abstract;
+------------------------------------------
+
+Open the dataset. You must call internalinitfielddefs; 
+if DefaultFields is True, then you must call CreateFields,
+which will create the necessary TFields from the fielddefs.
+
+procedure InternalPost; virtual; abstract;
+------------------------------------------
+
+Post the data in the active buffer to the underlying dataset.
+
+procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
+----------------------------------------------------------------
+
+Set the current record to the record in Buffer; if bookmark data 
+is specified in this buffer, that data can be used to determine which 
+record this should be.
+
+function IsCursorOpen: Boolean; virtual; abstract;
+--------------------------------------------------
+
+This function should return True if data is available, even if the dataset
+is not active.
+
+procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
+----------------------------------------------------------------------------------
+
+Set the bookmarkflag 'Value' on the data in Buffer.
+
+procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
+---------------------------------------------------------------------------
+
+Move the bookmarkdata in 'Data' to the bookmarkdata associated with Buffer
+
+procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
+--------------------------------------------------------------------------
+
+Move the data in associated with Field from Buffer to the activebuffer.
+
+=================
+Scalable datasets
+=================
+
+In order to have Scalable database access, the concept of TDatabase and
+TDBDataset is introduced. The idea is that, in a visual IDE, the change
+from one database to another is achieved by simply removing one TDatabase
+descendent (Say, TMySqlDatabase) with another (Say, TPostGreSQLDatabase)
+and that the Datasets remain untouched.
+
+In order to make this possible, the following scheme is used:
+
+when a TDBdataset descendant is put on Active, it requests a TRecordSet
+from the TDatabase. The TRecordSet is an abstract object that should be
+implemented together with each database. The TDBDataset then uses the
+TRecordSet to navigate through the records and edit/add/modify them.
+The TDBdataset implements the abstract methods of Tdataset in order to
+achive this.
+
+There will be 2 descendants of TDBdataset: TTable and TQuery; both will
+implement the last abstract methods of TDataset in order to achieve a
+complete TDataset implementation.
+
+TDBDataset implements most of the initialization of fields, so the
+implementation of TRecordSet will be as bare bones as possible.
+
+What is needed:
+---------------
+
+Some properties describing the data:
+
+FieldCount : Number of fields in a record;
+FieldTypes[Index] : Types of the fields (TFieldType), zero based.
+FieldNames[Index] : Names of the fields. Zero based.
+FieldSizes[index] : Size of the fields, zero based.
+BookmarkSize        : Size of a bookmark.
+
+Some properties with the data content:
+
+FieldBuffers[Index] : Buffers containing the actual data of the current record.
+                      (Nil if the field is empty)
+                      This data should be of size indicated FieldSizes, and 
+                      in a format that matches the fieldtype.
+BookMarkBuffer      : Buffer with the current bookmark.
+
+Some methods
+------------
+
+
+OpenRecordSet : Opens the recordset; it should initialize the FieldCount 
+                and FieldTypes, FieldNames, and FieldSizes array data.
+
+CloseRecordSet : Do whatever is needed to close the recordset.
+
+GotoBookMark : go to the record described by the bookmark. Returns True
+               if successfull, false if not.
+
+Next  : Goto the next record. Returns true or false 
+Prior : Goto previous record. Returns true or false
+First : Goto the first record. Returns True or false
+Last  : Goto the last record. Returns True or False
+
+AppendBuffer : Append a buffer to the records.

+ 154 - 0
fcl/db/Makefile

@@ -0,0 +1,154 @@
+#
+#   $Id$
+#   Copyright (c) 1999 by the Free Pascal Development Team
+#
+#   Makefile for database part of the Free Component Library 
+#
+#   See the file COPYING.FPC, included in this distribution,
+#   for details about the copyright.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+
+
+#####################################################################
+# Defaults
+#####################################################################
+
+# Default place of the makefile.fpc
+DEFAULTFPCDIR=../..
+
+# set target and cpu which are required
+#override OS_TARGET=linux
+override CPU=i386
+
+# Include files
+INC=../inc
+XML=../xml
+PROCINC=../$(CPU)
+
+# default library name
+LIBNAME=fpfcl
+
+# Where to place the files
+TARGETDIR=.
+
+# We need always -S2
+# add here the path to the mysql lib if it isn't in /usr/lib
+# Also add the path to the mysql units if not in the compiler path.
+NEEDOPT=-S2 -Fu../$(OS_TARGET)
+
+# we need lib gcc
+NEEDGCCLIB=yes
+
+# As default make only the units
+#DEFAULTUNITS=
+
+
+#####################################################################
+# Real targets
+#####################################################################
+
+# INCUNITS is defined in makefile.inc
+# They are default units for all platforms.
+include $(INC)/Makefile.inc
+include $(XML)/Makefile.inc
+
+UNITOBJECTS=db ddg_ds ddg_rec mysqldb
+EXEOBJECTS=testds createds mtest
+
+
+#####################################################################
+# Common targets
+#####################################################################
+
+.PHONY: all clean install info \
+	staticlib sharedlib libsclean \
+	staticinstall sharedinstall libinstall \
+
+all: testfpcmake fpc_all
+
+clean: testfpcmake fpc_clean
+
+install: testfpcmake fpc_install
+
+info: testfpcmake fpc_info
+
+staticlib: testfpcmake fpc_staticlib
+
+sharedlib: testfpcmake fpc_sharedlib
+
+libsclean: testfpcmake fpc_libsclean
+
+staticinstall: testfpcmake fpc_staticinstall
+
+sharedinstall: testfpcmake fpc_sharedinstall
+
+libinstall: testfpcmake fpc_libinstall
+
+
+#####################################################################
+# Include default makefile
+#####################################################################
+
+# test if FPCMAKE is still valid
+ifdef FPCMAKE
+ifeq ($(strip $(wildcard $(FPCMAKE))),)
+FPCDIR=
+FPCMAKE=
+endif
+endif
+
+ifndef FPCDIR
+ifdef DEFAULTFPCDIR
+FPCDIR=$(DEFAULTFPCDIR)
+endif
+endif
+
+ifndef FPCMAKE
+ifdef FPCDIR
+FPCMAKE=$(FPCDIR)/makefile.fpc
+else
+FPCMAKE=makefile.fpc
+endif
+endif
+
+override FPCMAKE:=$(strip $(wildcard $(FPCMAKE)))
+ifeq ($(FPCMAKE),)
+testfpcmake:
+	@echo makefile.fpc not found!
+	@echo Check the FPCMAKE and FPCDIR environment variables.
+	@exit
+else
+include $(FPCMAKE)
+testfpcmake:
+endif
+
+
+#####################################################################
+# Dependencies
+#####################################################################
+
+vpath %$(PASEXT) $(INC) $(XML)
+
+INCFILES=
+
+db$(PPUEXT): db.pp fields.inc dataset.inc dbs.inc
+
+ddg_ds$(PPUEXT): db$(PPUEXT) ddg_rec$(PPUEXT) ddg_ds$(PASEXT)
+
+testds$(EXEEXT): ddg_ds$(PPUEXT) testds$(PASEXT)
+
+createds$(EXEEXT): createds$(PASEXT) ddg_rec$(PPUEXT)
+
+mysqldb$(PPUEXT): db$(PPUEXT) mysqldb$(PASEXT)
+
+mtest$(EXEEXT): mysqldb$(PPUEXT) mtest$(PASEXT)
+
+#
+# $Log$
+# Revision 1.1  1999-10-24 16:15:38  michael
+# + Initial read-only implementation
+#

+ 48 - 0
fcl/db/README

@@ -0,0 +1,48 @@
+This is the Database directory of the Free Component Library.
+
+At the moment, there is a read-only implementation of TDataset.
+Also, there is no (tested) blob support yet.
+
+Compiling:
+
+Just run 'make' and all should go fine, provided
+1) The mysql unit is in the compiler path
+2) the mysqlclient library is in /usr/lib
+if these conditions are not satisfied, you should edit the makefile
+and add -Fl/path/to/libmysqlclient to NEEDOPTS as well as
+the -Fu/path/to/mysql/unit option.
+
+
+there are 2 descendents to demonstrate/test the TDataset:
+
+TddgDataset : 
+
+  Implemented in ddg_ds and ddg_rec. The dataset as
+  implemented in the Delphi 4 Developers Guide.
+  To test it, do a 
+   createds filename
+   testds filename
+  the first creates a flat file, filled with 100 records;
+  the second tests the methods of TDataset on this file.
+
+TMySQLdataset :
+  Implemented in mysqldb. You need the mysql units for this.
+  This is a temporary implementation based on the code from
+     Rangel Gustavo Reale ([email protected]) 
+  it will be used as a base for the DBdataset scalable dataset
+  implemntation.
+  To test it, do a 
+     mtest db user pwd SQL
+  this will run the query SQL on the database db with user
+  'user' and password 'pwd', and dump the result. Take care
+  that you don't specify blob fields.
+  To test it on the table created by the mkdb shell script
+  that comes with the Free Pascal mysql unit, I did a
+      mtest test michael pwd 'select * from FPdev'
+
+  I haven't tested Date or time fields yes, just string,float and
+  integer fields.
+
+Enjoy !
+
+Michael.              

+ 39 - 0
fcl/db/createds.pp

@@ -0,0 +1,39 @@
+program createds;
+
+uses ddg_rec,sysutils;
+
+Type IndexFile = File Of Longint;
+
+Var F : TDDGDataFile;
+    I : Integer;
+    S : String;
+    L : IndexFile;
+    TableName : String;
+    IndexName : String;
+    ARec : TDDGData;
+    
+begin
+  If ParamCount<>1 then
+    begin
+    Writeln('Usage: createds tablename');
+    Halt(1);
+    end;
+  TableName:=ChangeFileExt(paramstr(1),'.ddg');
+  IndexName:=ChangeFileExt(TableName,'.ddx');
+  Assign(F,TableName);
+  Rewrite(F);
+  For I:=1 to 100 do
+    begin
+    S:=Format('This is person %d.',[i]);
+    ARec.Name:=S; 
+    ARec.ShoeSize:=I;
+    ARec.height:=I*0.001;
+    Write(F,ARec);
+    end;
+  Close(F);
+  Assign(L,IndexName);
+  Rewrite(L);
+  For I:=0 to 100-1 do
+    Write(L,I);
+  Close(L);  
+end.

+ 158 - 0
fcl/db/database.inc

@@ -0,0 +1,158 @@
+
+{ ---------------------------------------------------------------------
+    TDatabase
+  ---------------------------------------------------------------------}
+
+Procedure TDatabase.CheckConnected;
+
+begin
+  If Not Connected Then
+    DatabaseError(SNotConnected,Self);
+end;
+
+
+Procedure TDatabase.CheckDisConnected;
+begin
+  If Connected Then
+    DatabaseError(SConnected,Self);
+end;
+  
+procedure TDataBase.Loaded;
+
+begin
+  //!! To be implemented.
+end;
+
+procedure TDataBase.SetConnected (Value : boolean);
+
+begin
+  If Value<>FConnected then
+    begin
+    If Value then 
+      DoInternalConnect
+    else
+      begin
+      Closedatasets;
+      DoInternalDisConnect;
+      end;
+    FConnected:=Value;
+    end;
+end;
+
+
+procedure TDatabase.Notification(AComponent: TComponent; Operation: TOperation);
+
+begin
+  //!! To be implemented.
+end;
+
+constructor TDatabase.Create(AOwner: TComponent);
+
+begin
+  Inherited Create(AOwner);
+end;
+
+destructor TDatabase.Destroy;
+
+begin
+  Connected:=False;
+  RemoveDatasets;
+  FDatasets.Free;
+  Inherited Destroy;
+end;
+
+procedure TDatabase.Close;
+
+begin
+  Connected:=False;
+end;
+
+procedure TDatabase.CloseDataSets;
+
+Var I : longint;
+
+begin
+  If Assigned(FDatasets) then 
+    begin
+    For I:=FDatasets.Count-1 downto 0 do
+      TDBDataset(FDatasets[i]).Close;
+    end;
+end;
+
+procedure TDatabase.RemoveDataSets;
+
+Var I : longint;
+
+begin
+  If Assigned(FDatasets) then 
+    For I:=FDataSets.Count-1 downto 0 do
+      TDBDataset(FDataSets[i]).Database:=Nil;
+end;
+
+procedure TDatabase.Open;
+
+begin
+  Connected:=True;
+end;
+
+
+Function TDatabase.GetDataSetCount : Longint;
+
+begin
+  If Assigned(FDatasets) Then
+    Result:=FDatasets.Count
+  else
+    Result:=0;
+end;
+
+
+Function TDatabase.GetDataset(Index : longint) : TDBDataset;
+
+begin
+  If Assigned(FDatasets) then
+    Result:=TDBDataset(FDatasets[Index])
+  else
+    DatabaseError(SNoDatasets);
+end;
+
+procedure TDatabase.RegisterDataset (DS : TDBDataset);
+
+Var I : longint;
+
+begin
+  I:=FDatasets.IndexOf(DS);
+  If I=-1 then
+    FDatasets.Add(DS)
+  else
+    DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
+end;
+
+procedure TDatabase.UnRegisterDataset (DS : TDBDataset);
+
+Var I : longint;
+
+begin
+  I:=FDatasets.IndexOf(DS);
+  If I<>-1 then
+    FDatasets.Delete(I)
+  else
+    DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
+end;
+
+{ ---------------------------------------------------------------------
+    TDBdataset
+  ---------------------------------------------------------------------}
+
+Procedure TDBDataset.SetDatabase (Value : TDatabase);
+
+begin
+  CheckInactive;
+  If Value<>FDatabase then
+    begin
+    If Assigned(FDatabase) then
+      FDatabase.UnregisterDataset(Self);
+    If Value<>Nil Then
+      Value.RegisterDataset(Self);
+    FDatabase:=Value; 
+    end;
+end;  

+ 1267 - 0
fcl/db/dataset.inc

@@ -0,0 +1,1267 @@
+{ ---------------------------------------------------------------------
+    TDataSet
+  ---------------------------------------------------------------------}
+
+Const
+  DefaultBufferCount = 10;
+
+constructor TDataSet.Create(AOwner: TComponent);
+
+begin
+  Inherited Create(AOwner);
+  FFieldDefs:=TFieldDefs.Create(Self);
+  FFieldList:=TFields.Create(Self);
+end;
+
+
+
+destructor TDataSet.Destroy;
+
+begin
+  Active:=False;
+  FFieldDefs.Free;
+  FFieldList.Free;
+  Inherited Destroy;
+end;
+
+
+procedure TDataset.ActivateBuffers; 
+
+begin
+  FBOF:=False;
+  FEOF:=False;
+  FRecordCount:=1;
+  FActiveRecord:=0;
+end;
+
+procedure TDataset.UpdateFieldDefs; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.BindFields(Binding: Boolean);
+
+Var I : longint;
+
+begin
+  {
+     Here some magic will be needed later; for now just simply set
+     Just set fieldno from listindex...
+     Later we should take it from the fielddefs.
+  }   
+  For I:=0 to FFieldList.Count-1 do
+    FFieldList[i].FFieldNo:=I;
+end;
+
+function TDataset.BookmarkAvailable: Boolean;
+
+Const BookmarkStates = [dsBrowse,dsEdit,dsInsert];
+
+begin
+  Result:=(Not IsEmpty) and (State in BookmarkStates) 
+          and (getBookMarkFlag(ActiveBuffer)=bfCurrent);
+end;
+
+procedure TDataset.CalculateFields(Buffer: PChar); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.CheckActive; 
+
+begin
+  If Not Active then
+    DataBaseError(SInactiveDataset);
+end;
+
+procedure TDataset.CheckInactive; 
+
+begin
+  If Active then
+    DataBaseError(SActiveDataset);
+end;
+
+procedure TDataset.ClearBuffers; 
+
+begin
+  FRecordCount:=0;
+  FactiveRecord:=0;
+  FCurrentRecord:=-1;
+  FBOF:=True;
+  FEOF:=True;
+end;
+
+procedure TDataset.ClearCalcFields(Buffer: PChar); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.CloseBlob(Field: TField); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.CloseCursor; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.CreateFields;
+
+Var I : longint;
+
+begin
+{$ifdef DSDebug}
+  Writeln ('Creating fields');
+{$endif}
+  For I:=0 to fielddefs.Count-1 do
+    With Fielddefs.Items[I] do
+      If DataType<>ftUnknown then
+        CreateField(self);
+end;
+
+procedure TDataset.DataEvent(Event: TDataEvent; Info: Longint); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.DestroyFields; 
+
+begin
+  FFieldList.Clear;
+end;
+
+procedure TDataset.DoAfterCancel; 
+
+begin
+ If assigned(FAfterCancel) then 
+   FAfterCancel(Self);
+end;
+
+procedure TDataset.DoAfterClose; 
+
+begin
+ If assigned(FAfterClose) then 
+   FAfterClose(Self);
+end;
+
+procedure TDataset.DoAfterDelete; 
+
+begin
+ If assigned(FAfterDelete) then 
+   FAfterDelete(Self);
+end;
+
+procedure TDataset.DoAfterEdit; 
+
+begin
+ If assigned(FAfterEdit) then 
+   FAfterEdit(Self);
+end;
+
+procedure TDataset.DoAfterInsert; 
+
+begin
+ If assigned(FAfterInsert) then 
+   FAfterInsert(Self);
+end;
+
+procedure TDataset.DoAfterOpen; 
+
+begin
+ If assigned(FAfterOpen) then 
+   FAfterOpen(Self);
+end;
+
+procedure TDataset.DoAfterPost; 
+
+begin
+ If assigned(FAfterPost) then 
+   FAfterPost(Self);
+end;
+
+procedure TDataset.DoAfterScroll; 
+
+begin
+ If assigned(FAfterScroll) then 
+   FAfterScroll(Self);
+end;
+
+procedure TDataset.DoBeforeCancel; 
+
+begin
+ If assigned(FBeforeCancel) then 
+   FBeforeCancel(Self);
+end;
+
+procedure TDataset.DoBeforeClose; 
+
+begin
+ If assigned(FBeforeClose) then 
+   FBeforeClose(Self);
+end;
+
+procedure TDataset.DoBeforeDelete; 
+
+begin
+ If assigned(FBeforeDelete) then 
+   FBeforeDelete(Self);
+end;
+
+procedure TDataset.DoBeforeEdit; 
+
+begin
+ If assigned(FBeforeEdit) then 
+   FBeforeEdit(Self);
+end;
+
+procedure TDataset.DoBeforeInsert; 
+
+begin
+ If assigned(FBeforeInsert) then 
+   FBeforeInsert(Self);
+end;
+
+procedure TDataset.DoBeforeOpen; 
+
+begin
+ If assigned(FBeforeOpen) then 
+   FBeforeOpen(Self);
+end;
+
+procedure TDataset.DoBeforePost; 
+
+begin
+ If assigned(FBeforePost) then 
+   FBeforePost(Self);
+end;
+
+procedure TDataset.DoBeforeScroll; 
+
+begin
+ If assigned(FBeforeScroll) then 
+   FBeforeScroll(Self);
+end;
+
+Procedure TDataset.DoInternalOpen;
+
+begin
+  FBufferCount:=0;
+  FDefaultFields:=FieldCount=0;
+  DoBeforeOpen;
+  Try
+    InternalOpen;
+    FBOF:=True;
+    SetState(dsBrowse);
+    SetBufListSize(DefaultBufferCount);
+    GetNextRecords;
+    DoAfterOpen;
+    DoAfterScroll;
+  except 
+    SetState(dsInactive);   
+    DoInternalClose;
+    raise;
+  end;
+end;
+
+Function TDataset.RequiredBuffers : longint;
+{
+  If later some datasource requires more buffers (grids etc)
+  then it should be taken into account here...
+} 
+
+begin
+  Result:=0;
+end;
+
+Procedure TDataset.DoInternalClose;
+
+begin
+  FreeFieldBuffers;
+  ClearBuffers;
+  SetState(dsInactive);
+  InternalClose;
+end;
+
+procedure TDataset.DoOnCalcFields; 
+
+begin
+ If assigned(FOnCalcfields) then 
+   FOnCalcFields(Self);
+end;
+
+procedure TDataset.DoOnNewRecord; 
+
+begin
+ If assigned(FOnNewRecord) then 
+   FOnNewRecord(Self);
+end;
+
+function TDataset.FieldByNumber(FieldNo: Longint): TField;
+
+begin
+  Result:=FFieldList.FieldByNumber(FieldNo);
+end;
+
+function TDataset.FindRecord(Restart, GoForward: Boolean): Boolean; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.FreeFieldBuffers; 
+
+Var I : longint;
+
+begin
+  For I:=0 to FFieldList.Count-1 do
+    FFieldList[i].FreeBuffers;
+end;
+
+function TDataset.GetBookmarkStr: TBookmarkStr; 
+
+begin
+  Result:='';
+  If BookMarkAvailable then
+    begin
+    SetLength(Result,FBookMarkSize);
+    GetBookMarkData(ActiveBuffer,Pointer(Result));
+    end
+end;
+
+Function TDataset.GetBuffer (Index : longint) : Pchar;  
+
+begin
+  Result:=FBuffers[Index];
+end;
+
+procedure TDataset.GetCalcFields(Buffer: PChar); 
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.GetCanModify: Boolean; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent); 
+
+begin
+  //!! To be implemented
+end;
+
+Function TDataset.GetField (Index : Longint) : TField;
+
+begin
+  Result:=FFIeldList[index];
+end;
+
+{
+  This is not yet allowed, FPC doesn't allow typed consts of Classes...
+
+Const 
+  DefFieldClasses : Array [TFieldType] of TFieldClass =
+    ( { ftUnknown} Tfield,
+      { ftString} TStringField,
+      { ftSmallint} TLongIntField,
+      { ftInteger} TLongintField,
+      { ftWord} TLongintField,
+      { ftBoolean} TBooleanField,
+      { ftFloat} TFloatField,
+      { ftDate} TDateField,
+      { ftTime} TTimeField,
+      { ftDateTime} TDateTimeField,
+      { ftBytes} TBytesField,
+      { ftVarBytes} TVarBytesField,
+      { ftAutoInc} TAutoIncField,
+      { ftBlob} TBlobField,
+      { ftMemo} TMemoField,
+      { ftGraphic} TGraphicField,
+      { ftFmtMemo} TMemoField,
+      { ftParadoxOle} Nil,
+      { ftDBaseOle} Nil,
+      { ftTypedBinary} Nil,
+      { ftCursor} Nil
+    );
+}
+
+function TDataset.GetFieldClass(FieldType: TFieldType): TFieldClass; 
+
+begin
+  Case FieldType of 
+     ftUnknown : Result:=Tfield;
+     ftString: Result := TStringField;
+     ftSmallint: Result := TLongIntField;
+     ftInteger: Result := TLongintField;
+     ftWord: Result := TLongintField;
+     ftBoolean: Result := TBooleanField;
+     ftFloat: Result := TFloatField;
+     ftDate: Result := TDateField;
+     ftTime: Result := TTimeField;
+     ftDateTime: Result := TDateTimeField;
+     ftBytes: Result := TBytesField;
+     ftVarBytes: Result := TVarBytesField;
+     ftAutoInc: Result := TAutoIncField;
+     ftBlob: Result := TBlobField;
+     ftMemo: Result := TMemoField;
+     ftGraphic: Result := TGraphicField;
+     ftFmtMemo: Result := TMemoField;
+     ftParadoxOle: Result := Nil;
+     ftDBaseOle: Result := Nil;
+     ftTypedBinary: Result := Nil;
+     ftCursor: Result := Nil;
+  end;
+end;
+
+function TDataset.GetIsIndexField(Field: TField): Boolean; 
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.GetNextRecord: Boolean; 
+
+Var Shifted : Boolean;
+
+begin
+{$ifdef dsdebug}
+  Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
+{$endif}  
+  Shifted:=FRecordCount=FBufferCount;
+  If Shifted then
+    begin
+    ShiftBuffers(1);
+    Dec(FRecordCount);
+    end;
+{$ifdef dsdebug}
+  Writeln ('Getting data into buffer : ',FRecordCount);
+{$endif}  
+  Result:=GetRecord(FBuffers[FRecordCount],gmNext,True)=grOK;
+  If Result then
+    begin
+    If FRecordCount=0 then 
+      ActivateBuffers
+    else
+      If FRecordCount<FBufferCount then
+        Inc(FRecordCount);
+    FCurrentRecord:=FRecordCount;  
+    end
+  else
+    begin
+    if shifted then
+      begin
+      ShiftBuffers(-1);
+      inc(FRecordCount);
+      end;
+    CursorPosChanged;
+    end;
+{$ifdef dsdebug}
+  Writeln ('Result getting next record : ',Result);  
+{$endif}  
+end;
+
+function TDataset.GetNextRecords: Longint; 
+
+begin
+  Result:=0;
+{$ifdef dsdebug}
+  Writeln ('Getting next record(s), need :',FBufferCount);
+{$endif}  
+  While (FRecordCount<FBufferCount) and GetNextRecord do
+    Inc(Result);
+{$ifdef dsdebug}
+  Writeln ('Result Getting next record(s), GOT :',RESULT);
+{$endif}  
+end;
+
+function TDataset.GetPriorRecord: Boolean; 
+
+Var Shifted : boolean;
+
+begin
+{$ifdef dsdebug}
+  Writeln ('Getting previous record');
+{$endif}  
+  Shifted:=FRecordCount>0;
+  If Shifted Then 
+    begin
+    SetCurrentRecord(0);
+    ShiftBuffers(-1);
+    end;
+  Result:=GetRecord(FBuffers[0],gmPrior,True)=grOK;
+  If Result then
+    begin
+    If FRecordCount=0 then 
+      ActivateBuffers
+    else
+      begin
+      If FrecordCount<FBufferCount then
+        Inc(FRecordCount);
+      end;
+    FCurrentRecord:=0;    
+    end
+  else
+    begin
+    If Shifted then 
+      begin
+      ShiftBuffers(1);
+      end;
+    CursorPosChanged;
+    end;
+end;
+
+function TDataset.GetPriorRecords: Longint; 
+
+begin
+  Result:=0;
+{$ifdef dsdebug}
+  Writeln ('Getting previous record(s), need :',FBufferCount);
+{$endif}  
+  While (FRecordCount<FbufferCount) and GetPriorRecord do
+    Inc(Result);
+end;
+
+function TDataset.GetRecNo: Longint; 
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.GetRecordCount: Longint; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.InitFieldDefs; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.InitRecord(Buffer: PChar); 
+
+begin
+  InternalInitRecord(Buffer);
+  ClearCalcFields(Buffer);
+end;
+
+procedure TDataset.InternalCancel; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.InternalEdit; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.InternalRefresh; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.Loaded; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.OpenCursor(InfoQuery: Boolean); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.RefreshInternalCalcFields(Buffer: PChar); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.RestoreState(const Value: TDataSetState);
+
+begin
+  //!! To be implemented
+end;
+
+Procedure TDataset.SetActive (Value : Boolean);
+
+begin
+  If Value<>Factive then
+    If Value then
+      DoInternalOpen
+    else
+      DoInternalClose;
+  FActive:=Value;
+end;
+
+procedure TDataset.SetBookmarkStr(const Value: TBookmarkStr); 
+
+begin
+  GotoBookMark(Pointer(Value))
+end;
+
+procedure TDataset.SetBufListSize(Value: Longint);
+
+Var I : longint;
+
+begin
+  If Value=FBufferCount Then exit;
+  I:=RequiredBuffers; // Save 1 call.
+  If Value<I Then
+    Value:=I;
+  If Value>FBufferCount then
+    begin
+    ReAllocMem(FBuffers,(FBufferCount+1)*SizeOf(PChar),(Value+1)*SizeOf(PChar));
+    FillChar(FBuffers[FBufferCount+1],(Value-FBufferCount)*SizeOF(Pchar),#0);
+    Try
+      For I:=FBufferCount to Value do
+        FBuffers[i]:=AllocRecordBuffer;
+    except
+      I:=FBufferCount;
+      While (I<=Value) and (FBuffers[i]<>Nil) do
+        begin
+        FreeRecordBuffer(FBuffers[i]);
+        Inc(i);
+        end;
+      raise;          
+    end;   
+    end
+  else
+    begin
+    For I:=Value+1 to FBufferCount do
+      FreeRecordBuffer(FBuffers[i]);
+    ReAllocMem(FBuffers,FBufferCount*SizeOf(Pchar),Value*SizeOf(Pchar));  
+    end;
+  FBufferCount:=Value;   
+end;
+
+procedure TDataset.SetChildOrder(Component: TComponent; Order: Longint); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetCurrentRecord(Index: Longint); 
+
+begin
+  If FCurrentRecord<>Index then
+    begin
+    Writeln ('Setting current record to',index);
+    Case GetBookMarkFlag(FBuffers[Index]) of
+      bfCurrent : InternalSetToRecord(FBuffers[Index]);
+      bfBOF : InternalFirst;
+      bfEOF : InternalLast;
+      end; 
+    FCurrentRecord:=index;
+    end;
+end;
+
+Procedure TDataset.SetField (Index : Longint;Value : TField);
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetFilterOptions(Value: TFilterOptions); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetFilterText(const Value: string); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetFiltered(Value: Boolean); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetFound(const Value: Boolean);
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetModified(Value: Boolean);
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetName(const Value: TComponentName); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetOnFilterRecord(const Value: TFilterRecordEvent); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetRecNo(Value: Longint); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.SetState(Value: TDataSetState);
+
+begin
+  If Value<>FState then
+    begin
+    FState:=Value;
+    end;
+end;
+
+function TDataset.SetTempState(const Value: TDataSetState): TDataSetState;
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.TempBuffer: PChar;
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.UpdateIndexDefs; 
+
+begin
+  //!! To be implemented
+end;
+
+
+
+function TDataset.ControlsDisabled: Boolean;
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.ActiveBuffer: PChar;
+
+
+begin
+{$ifdef dsdebug}
+//  Writeln ('Active buffer requested. Returning:',ActiveRecord);
+{$endif}  
+  Result:=FBuffers[ActiveRecord];
+end;
+
+procedure TDataset.Append;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.AppendRecord(const Values: array of const);
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.BookmarkValid(ABookmark: TBookmark): Boolean; 
+{
+  Should be overridden by descendant objects.
+}
+begin
+  Result:=False
+end;
+
+procedure TDataset.Cancel; 
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.CheckBrowseMode;
+
+begin
+  CheckActive;
+  If State In [dsedit,dsinsert] then
+    begin
+    UpdateRecord;
+    If Modified then
+      Post
+    else
+      Cancel;
+    end;
+end;
+
+procedure TDataset.ClearFields;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.Close;
+
+
+begin
+  Active:=False;
+end;
+
+function TDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; 
+
+
+begin
+  Result:=0;
+end;
+
+function TDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; 
+
+
+begin
+  Result:=Nil;
+end;
+
+procedure TDataset.CursorPosChanged;
+
+
+begin
+  FCurrentRecord:=-1;
+end;
+
+procedure TDataset.Delete;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.DisableControls;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.Edit;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.EnableControls;
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.FieldByName(const FieldName: string): TField;
+
+
+begin
+  Result:=FindField(FieldName);
+  If Result=Nil then
+    DatabaseErrorFmt(SFieldNotFound,[FieldName],Self);
+end;
+
+function TDataset.FindField(const FieldName: string): TField;
+
+
+begin
+  Result:=FFieldList.FindField(FieldName);
+end;
+
+function TDataset.FindFirst: Boolean;
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.FindLast: Boolean;
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.FindNext: Boolean;
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.FindPrior: Boolean;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.First;
+
+
+begin
+  CheckBrowseMode;
+  DoBeforeScroll;
+  ClearBuffers;
+  try
+    InternalFirst;
+    GetNextRecords;
+  finally
+    FBOF:=True;
+    DoAfterScroll;
+  end;
+end;
+
+procedure TDataset.FreeBookmark(ABookmark: TBookmark); 
+
+
+begin
+  FreeMem(ABookMark,FBookMarkSize);
+end;
+
+function TDataset.GetBookmark: TBookmark; 
+
+
+begin
+  if BookmarkAvailable then 
+    begin
+    GetMem (Result,FBookMarkSize);
+    GetBookMarkdata(ActiveBuffer,Result);
+    end
+  else
+    Result:=Nil;
+end;
+
+function TDataset.GetCurrentRecord(Buffer: PChar): Boolean; 
+
+
+begin
+  Result:=False;
+end;
+
+procedure TDataset.GetFieldList(List: TList; const FieldNames: string);
+
+
+begin
+  
+end;
+
+procedure TDataset.GetFieldNames(List: TStrings);
+
+
+begin
+  FFieldList.GetFieldNames(List);
+end;
+
+procedure TDataset.GotoBookmark(ABookmark: TBookmark);
+
+
+begin
+  If Assigned(ABookMark) then
+    begin
+    CheckBrowseMode;
+    DoBeforeScroll;
+    InternalGotoBookMark(ABookMark);
+    Resync([rmExact,rmCenter]);
+    DoAfterScroll;
+    end;
+end;
+
+procedure TDataset.Insert;
+
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.InsertRecord(const Values: array of const);
+
+
+begin
+  //!! To be implemented
+end;
+
+function TDataset.IsEmpty: Boolean;
+
+begin
+  Result:=(Bof and Eof);
+end;
+
+function TDataset.IsSequenced: Boolean; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.Last;
+
+begin
+  CheckBrowseMode;
+  DoBeforeScroll;
+  ClearBuffers;
+  try
+    InternalLast;
+    GetPriorRecords;
+    FActiveRecord:=FRecordCount-1;
+  finally
+    FEOF:=true;
+    DoAfterScroll;
+  end;
+end;
+
+function TDataset.MoveBy(Distance: Longint): Longint;
+
+  Procedure Scrollforward;
+  
+  begin
+{$ifdef dsdebug}
+    Writeln('Scrolling forward :',Distance);
+    Writeln('Active buffer : ',FActiveRecord);
+    Writeln('RecordCunt    : ',FRecordCount);
+{$endif}    
+    While (Distance>0) and not FEOF do
+      begin
+      If FActiveRecord<FRecordCount-1 then
+        begin
+        Inc(FActiveRecord);
+        Dec(Distance)
+        end
+      else
+        begin
+       {$ifdef dsdebug}
+           Writeln('Moveby : need next record');
+       {$endif}    
+        If GetNextRecord then
+          Dec(Distance)
+        else
+          FEOF:=true;
+        end;
+      end
+  end;
+
+  Procedure ScrollBackward;
+  
+  begin
+
+{$ifdef dsdebug}
+    Writeln('Scrolling backward:',Abs(Distance));
+    Writeln('Active buffer : ',FActiveRecord);
+    Writeln('RecordCunt    : ',FRecordCount);
+{$endif}    
+    While (Distance<0) and not FBOF do
+      begin
+      If FActiveRecord>0 then
+        begin
+        Dec(FActiveRecord);
+        Inc(Distance)
+        end
+      else
+        begin
+       {$ifdef dsdebug}
+           Writeln('Moveby : need next record');
+       {$endif}    
+        If GetPriorRecord then
+          Inc(Distance)
+        else
+          FBOF:=true;
+        end;
+      end
+  end;
+
+begin
+  CheckBrowseMode;
+  Result:=0;
+  DoBeforeScroll;
+  If ((Distance>0) and FEOF) or
+     ((Distance<0) and FBOF) then
+    exit;
+  Try
+    If Distance>0 then 
+      ScrollForward
+    else 
+      ScrollBackward;
+  finally
+     DoAfterScroll;
+  end;
+end;
+
+procedure TDataset.Next;
+
+begin
+  MoveBy(1);
+end;
+
+procedure TDataset.Open;
+
+begin
+  Active:=True;
+end;
+
+procedure TDataset.Post; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.Prior;
+
+begin
+  MoveBy(-1);
+end;
+
+procedure TDataset.Refresh;
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.Resync(Mode: TResyncMode); 
+
+Var Count,ShiftCount : Longint;
+
+begin
+  // See if we can find the requested record.
+  If rmExact in Mode then
+    begin
+    { throw an exception if not found.
+      Normally the descendant should do this if DoCheck is true. }  
+    If GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk Then
+      DatabaseError(SNoSuchRecord,Self);
+    end
+  else
+    { Can we find a record in the neighbourhood ?
+      Use Shortcut evaluation for this, or we'll have some funny results. }
+    If (GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk) and
+       (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) and 
+       (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) then
+       begin
+       // nothing found, invalidate buffer and bail out.
+       ClearBuffers;
+       Exit;
+       end; 
+  If (rmCenter in Mode) then     
+    ShiftCount:=FbufferCount div 2
+  else
+    // keep current position.
+    ShiftCount:=FActiveRecord;  
+  // Reposition on 0
+  ShiftBuffers(FRecordCount-1);
+  ActivateBuffers;
+  Count:=0;
+  Writeln ('Getting previous',ShiftCount,' records');
+  While (Count<ShiftCount) and GetPriorRecord do Inc(Count);
+  FActiveRecord:=Count;
+  // fill rest of buffers, adjust ActiveBuffer.
+  SetCurrentRecord(FRecordCount-1);
+  GetNextRecords;
+  Inc(FActiveRecord,GetPriorRecords);
+end;
+
+procedure TDataset.SetFields(const Values: array of const);
+
+Var I  : longint;
+
+begin
+  For I:=0 to high(Values) do
+    Case Values[I].vtype of
+      vtInteger : FieldByNumber(i).AsLongInt:=Values[I].VInteger;
+      // needs Completion..
+    end;
+end;
+
+procedure TDataset.Translate(Src, Dest: PChar; ToOem: Boolean); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.UpdateCursorPos;
+
+begin
+  //!! To be implemented
+end;
+
+procedure TDataset.UpdateRecord;
+
+begin
+  //!! To be implemented
+end;
+
+Procedure TDataset.RemoveField (Field : TField);
+
+begin
+  //!! To be implemented
+end;
+
+Function TDataset.Getfieldcount : Longint;
+
+begin
+  Result:=FFieldList.Count;
+end;
+
+Procedure TDataset.ShiftBuffers (Distance : longint);
+
+Var Temp : Pointer;
+    MoveSize : Longint;
+      
+  Procedure ShiftBuffersUp;
+  begin
+    {$ifdef DSDEBUG}
+    writeln ('Shifting buffers up with distance :',Distance);
+    writeln ('Moving ',(FBufferCount-Distance), ' Buffers at ',Distance);
+    {$endif}
+    Move(FBuffers[0],Temp^,MoveSize);
+    Move(FBuffers[Distance],FBuffers[0],(FBufferCount-Distance)*SizeOf(Pchar));
+    Move(Temp^,FBuffers[FBufferCount-Distance],MoveSize);
+  end;
+
+  Procedure ShiftBuffersDown;
+  
+  begin
+    // Distance is NEGATIVE
+    {$ifdef DSDEBUG}
+    writeln ('Shifting buffers down with distance :',Abs(Distance));
+    writeln ('Moving ',Movesize div 4,' Buffers at ',FBufferCount+Distance);
+    {$endif}
+    Move(FBuffers[FbufferCount+Distance],Temp^ ,MoveSize);
+    Move(FBuffers[0],FBuffers[Abs(Distance)],(FBufferCount+Distance)*SizeOf(Pchar));
+    Move(Temp^ ,FBuffers[0],MoveSize);
+  end;
+
+begin
+  If Abs(Distance)>=BufferCount then Exit;
+  try
+    MoveSize:=SizeOf(Pchar)*Abs(Distance);
+    GetMem(Temp,MoveSize);
+    If Distance<0 Then
+      ShiftBuffersDown
+    else If Distance>0 then
+      ShiftBuffersUp;
+  Finally  
+    FreeMem(temp);
+  end;
+end;

+ 1238 - 0
fcl/db/db.pp

@@ -0,0 +1,1238 @@
+unit db;
+
+{$mode objfpc}
+{$h+}
+
+interface
+
+uses Classes,Sysutils;
+
+const
+
+  dsMaxBufferCount = MAXINT div 8;
+  dsMaxStringSize = 8192;
+ 
+  // Used in AsBoolean for string fields to determine
+  // whether it's true or false.
+  YesNoChars : Array[Boolean] of char = ('Y','N');
+  
+type
+
+{ Auxiliary type }
+  TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
+
+{ Misc Dataset types }
+
+  TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
+    dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
+
+  TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
+    deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
+    deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
+
+  TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
+
+{ Forward declarations }
+
+  TFieldDef = class;
+  TFieldDefs = class;
+  TField = class;
+  TFields = Class;
+  TDataSet = class;
+  TDataBase = Class;
+
+{ Exception classes }
+
+  EDatabaseError = class(Exception);
+
+{ TFieldDef }
+
+  TFieldClass = class of TField;
+
+  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
+    ftBoolean, ftFloat, ftDate, ftTime, ftDateTime,
+    ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
+    ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
+
+  TFieldDef = class(TComponent)
+  Private
+    FDataType : TFieldType;
+    FFieldNo : Longint;
+    FInternalCalcField : Boolean;
+    FPrecision : Longint;
+    FRequired : Boolean;
+    FSize : Word;
+    FName : String;
+    Function GetFieldClass : TFieldClass;
+  public
+    constructor Create(AOwner: TFieldDefs; const AName: string;
+      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
+    destructor Destroy; override;
+    function CreateField(AOwner: TComponent): TField;
+    property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
+    property DataType: TFieldType read FDataType;
+    property FieldClass: TFieldClass read GetFieldClass;
+    property FieldNo: Longint read FFieldNo;
+    property Name: string read FName;
+    property Precision: Longint read FPrecision write FPrecision; 
+    property Required: Boolean read FRequired;
+    property Size: Word read FSize;
+  end;
+
+{ TFieldDefs }
+
+  TFieldDefs = class(TComponent)
+  private
+    FDataSet: TDataSet;
+    FItems: TList;
+    FUpdated: Boolean;
+    function GetCount: Longint;
+    function GetItem(Index: Longint): TFieldDef;
+  public
+    constructor Create(ADataSet: TDataSet);
+    destructor Destroy; override;
+    procedure Add(const AName: string; ADataType: TFieldType; ASize: Word;
+      ARequired: Boolean);
+    procedure Assign(FieldDefs: TFieldDefs);
+    procedure Clear;
+    function Find(const AName: string): TFieldDef;
+    function IndexOf(const AName: string): Longint;
+    procedure Update;
+    property Count: Longint read GetCount;
+    property Items[Index: Longint]: TFieldDef read GetItem; default;
+  end;
+
+{ TField }
+
+  TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
+  TFieldKinds = Set of TFieldKind;
+  
+  TFieldNotifyEvent = procedure(Sender: TField) of object;
+  TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
+    DisplayText: Boolean) of object;
+  TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
+  TFieldRef = ^TField;
+  TFieldChars = set of Char;
+  { TAlignment may need to come from somewhere else }
+  TAlignMent = (taLeftjustify,taCenter,taRightJustify);
+  
+  TField = class(TComponent)
+  Private
+    FAlignMent : TAlignment;
+    FAttributeSet : String;
+    FBuffers : ppchar;
+    FCalculated : Boolean;
+    FCanModify : Boolean;
+    FConstraintErrorMessage : String;
+    FCustomConstraint : String;
+    FDataSet : TDataSet;
+    FDataSize : Word;
+    FDataType : TFieldType;
+    FDefaultExpression : String;
+    FDisplayLabel : String;
+    FDisplayWidth : Longint;
+    FEditText : String;
+    FFieldKind : TFieldKind;
+    FFieldName : String;
+    FFieldNo : Longint;
+    FFields : TFields;
+    FHasConstraints : Boolean;
+    FImportedConstraint : String;
+    FIsIndexField : Boolean;
+    FKeyFields : String;
+    FLookupCache : Boolean;
+    FLookupDataSet : TDataSet;
+    FLookupKeyfields : String;
+    FLookupresultField : String;
+    FOffset : Word;
+    FOnChange : TNotifyEvent;
+    FOnGetText: TFieldGetTextEvent;
+    FOnSetText: TFieldSetTextEvent;
+    FOnValidate: TFieldNotifyEvent;
+    FOrigin : String;
+    FReadOnly : Boolean;
+    FRequired : Boolean;
+    FSize : Word;
+    FValidChars : TFieldChars;
+    FValueBuffer : Pointer;
+    FValidating : Boolean;
+    FVisible : Boolean;
+    Function GetIndex : longint;
+    Procedure SetDataset(VAlue : TDataset);
+  protected
+    function AccessError(const TypeName: string): EDatabaseError;
+    procedure CheckInactive;
+    class procedure CheckTypeSize(AValue: Longint); virtual;
+    procedure Change; virtual;
+    procedure DataChanged;
+    procedure FreeBuffers; virtual;
+    function GetAsBoolean: Boolean; virtual;
+    function GetAsDateTime: TDateTime; virtual;
+    function GetAsFloat: Extended; virtual;
+    function GetAsLongint: Longint; virtual;
+    function GetAsString: string; virtual;
+    function GetCanModify: Boolean; virtual;
+    function GetDataSize: Word; virtual;
+    function GetDefaultWidth: Longint; virtual;
+    function GetIsNull: Boolean; virtual;
+    function GetParentComponent: TComponent; override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
+    function HasParent: Boolean; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure PropertyChanged(LayoutAffected: Boolean);
+    procedure ReadState(Reader: TReader); override;
+    procedure SetAsBoolean(AValue: Boolean); virtual;
+    procedure SetAsDateTime(AValue: TDateTime); virtual;
+    procedure SetAsFloat(AValue: Extended); virtual;
+    procedure SetAsLongint(AValue: Longint); virtual;
+    procedure SetAsString(const AValue: string); virtual;
+    procedure SetDataType(AValue: TFieldType);
+    procedure SetSize(AValue: Word); virtual;
+    procedure SetParentComponent(AParent: TComponent); override;
+    procedure SetText(const AValue: string); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Assign(Source: TPersistent); override;
+    procedure Clear; virtual;
+    procedure FocusControl;
+    function GetData(Buffer: Pointer): Boolean;
+    class function IsBlob: Boolean; virtual;
+    function IsValidChar(InputChar: Char): Boolean; virtual;
+    procedure SetData(Buffer: Pointer);
+    procedure SetFieldType(AValue: TFieldType); virtual;
+    procedure Validate(Buffer: Pointer);
+    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
+    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
+    property AsFloat: Extended read GetAsFloat write SetAsFloat;
+    property AsLongint: Longint read GetAsLongint write SetAsLongint;
+    property AsString: string read GetAsString write SetAsString;
+    property AttributeSet: string read FAttributeSet write FAttributeSet;
+    property Calculated: Boolean read FCalculated write FCalculated;
+    property CanModify: Boolean read FCanModify;
+    property DataSet: TDataSet read FDataSet write SetDataSet;
+    property DataSize: Word read GetDataSize;
+    property DataType: TFieldType read FDataType;
+    property FieldNo: Longint read FFieldNo;
+    property IsIndexField: Boolean read FIsIndexField;
+    property IsNull: Boolean read GetIsNull;
+    property Offset: word read FOffset;
+    property Size: Word read FSize write FSize;
+    property Text: string read FEditText write FEditText;
+    property ValidChars : TFieldChars Read FValidChars;
+  published
+    property AlignMent : TAlignMent Read FAlignMent write FAlignment;
+    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
+    property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
+    property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
+    property DisplayLabel: string read FDisplayLabel write FDisplayLabel;
+    property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
+    property FieldKind: TFieldKind read FFieldKind write FFieldKind;
+    property FieldName: string read FFieldName write FFieldName;
+    property HasConstraints: Boolean read FHasConstraints;
+    property Index: Longint read GetIndex;
+    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
+    property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
+    property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
+    property LookupResultField: string read FLookupResultField write FLookupResultField;
+    property KeyFields: string read FKeyFields write FKeyFields;
+    property LookupCache: Boolean read FLookupCache write FLookupCache;
+    property Origin: string read FOrigin write FOrigin;
+    property ReadOnly: Boolean read FReadOnly write FReadOnly;
+    property Required: Boolean read FRequired write FRequired;
+    property Visible: Boolean read FVisible write FVisible;
+    property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
+    property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
+    property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
+    property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
+  end;
+
+{ TStringField }
+
+  TStringField = class(TField)
+  protected
+    class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsBoolean: Boolean; override;
+    function GetAsDateTime: TDateTime; override;
+    function GetAsFloat: Extended; override;
+    function GetAsLongint: Longint; override;
+    function GetAsString: string; override;
+    function GetDataSize: Word; override;
+    function GetDefaultWidth: Longint; override;
+    procedure GetText(var AText: string; DisplayText: Boolean); override;
+    function GetValue(var AValue: string): Boolean;
+    procedure SetAsBoolean(AValue: Boolean); override;
+    procedure SetAsDateTime(AValue: TDateTime); override;
+    procedure SetAsFloat(AValue: Extended); override;
+    procedure SetAsLongint(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Value: string read GetAsString write SetAsString;
+  published
+    property Size default 20;
+  end;
+
+{ TNumericField }
+  TNumericField = class(TField)
+  Private
+    FDisplayFormat : String;
+    FEditFormat : String;
+  protected
+    procedure RangeError(AValue, Min, Max: Extended);
+    procedure SetDisplayFormat(const AValue: string);
+    procedure SetEditFormat(const AValue: string);
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
+    property EditFormat: string read FEditFormat write SetEditFormat;
+  end;
+
+{ TLongintField }
+
+  TLongintField = class(TNumericField)
+  private
+    FMinValue,
+    FMaxValue,
+    FMinRange,
+    FMAxRange  : Longint;
+    Procedure SetMinValue (AValue : longint);
+    Procedure SetMaxValue (AValue : longint);
+  protected
+    function GetAsFloat: Extended; override;
+    function GetAsLongint: Longint; override;
+    function GetAsString: string; override;
+    function GetDataSize: Word; override;
+    procedure GetText(var AText: string; DisplayText: Boolean); override;
+    function GetValue(var AValue: Longint): Boolean;
+    procedure SetAsFloat(AValue: Extended); override;
+    procedure SetAsLongint(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    Function CheckRange(AValue : longint) : Boolean;
+    property Value: Longint read GetAsLongint write SetAsLongint;
+  published
+    property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
+    property MinValue: Longint read FMinValue write SetMinValue default 0;
+  end;
+  TIntegerField = TLongintField;
+  
+{ TSmallintField }
+
+  TSmallintField = class(TLongintField)
+  protected
+    function GetDataSize: Word; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TWordField }
+
+  TWordField = class(TLongintField)
+  protected
+    function GetDataSize: Word; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TAutoIncField }
+
+  TAutoIncField = class(TLongintField)
+  Protected
+    Procedure SetAsLongInt(AValue : Longint); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TFloatField }
+
+  TFloatField = class(TNumericField)
+  private 
+    FMaxValue : Extended;
+    FMinValue : Extended;
+    FPrecision : Longint;
+  protected
+    function GetAsFloat: Extended; override;
+    function GetAsLongint: Longint; override;
+    function GetAsString: string; override;
+    function GetDataSize: Word; override;
+    procedure GetText(var theText: string; DisplayText: Boolean); override;
+    procedure SetAsFloat(AValue: Extended); override;
+    procedure SetAsLongint(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    Function CheckRange(AValue : Extended) : Boolean;
+    property Value: Extended read GetAsFloat write SetAsFloat;
+    
+  published
+    property MaxValue: Extended read FMaxValue write FMaxValue;
+    property MinValue: Extended read FMinValue write FMinValue;
+    property Precision: Longint read FPrecision write FPrecision default 15;
+  end;
+
+
+{ TBooleanField }
+
+  TBooleanField = class(TField)
+  private
+    FDisplayValues : String;
+    // First byte indicates uppercase or not.
+    FDisplays : Array[Boolean,Boolean] of string;
+    Procedure SetDisplayValues(AValue : String);
+  protected
+    function GetAsBoolean: Boolean; override;
+    function GetAsString: string; override;
+    function GetDataSize: Word; override;
+    function GetDefaultWidth: Longint; override;
+    procedure SetAsBoolean(AValue: Boolean); override;
+    procedure SetAsString(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Value: Boolean read GetAsBoolean write SetAsBoolean;
+  published
+    property DisplayValues: string read FDisplayValues write SetDisplayValues;
+  end;
+
+{ TDateTimeField }
+
+  TDateTimeField = class(TField)
+  private
+    FDisplayFormat : String;
+  protected
+    function GetAsDateTime: TDateTime; override;
+    function GetAsFloat: Extended; override;
+    function GetAsString: string; override;
+    function GetDataSize: Word; override;
+    procedure GetText(var theText: string; DisplayText: Boolean); override;
+    procedure SetAsDateTime(AValue: TDateTime); override;
+    procedure SetAsFloat(AValue: Extended); override;
+    procedure SetAsString(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Value: TDateTime read GetAsDateTime write SetAsDateTime;
+  published
+    property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
+  end;
+
+{ TDateField }
+
+  TDateField = class(TDateTimeField)
+  protected
+    function GetDataSize: Word; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TTimeField }
+
+  TTimeField = class(TDateTimeField)
+  protected
+    function GetDataSize: Word; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TBinaryField }
+
+  TBinaryField = class(TField)
+  protected
+    class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsString: string; override;
+    procedure GetText(var TheText: string; DisplayText: Boolean); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetText(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Size default 16;
+  end;
+
+{ TBytesField }
+
+  TBytesField = class(TBinaryField)
+  protected
+    function GetDataSize: Word; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TVarBytesField }
+
+  TVarBytesField = class(TBytesField)
+  protected
+    function GetDataSize: Word; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TBCDField }
+
+  TBCDField = class(TNumericField)
+  private
+  protected
+    class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsFloat: Extended; override;
+    function GetAsLongint: Longint; override;
+    function GetAsString: string; override;
+    function GetDataSize: Word; override;
+    function GetDefaultWidth: Longint; override;
+    procedure GetText(var TheText: string; DisplayText: Boolean); override;
+    procedure SetAsFloat(AValue: Extended); override;
+    procedure SetAsLongint(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Size default 4;
+  end;
+
+{ TBlobField }
+  TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
+  TBlobType = ftBlob..ftTypedBinary;
+
+  TBlobField = class(TField)
+  private
+    FBlobSize : Longint;
+    FBlobType : TBlobType;
+    FModified : Boolean;
+    FTransliterate : Boolean;
+    Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
+  protected
+    procedure AssignTo(Dest: TPersistent); override;
+    procedure FreeBuffers; override;
+    function GetAsString: string; override;
+    function GetBlobSize: Longint; virtual;
+    function GetIsNull: Boolean; override;
+    procedure GetText(var TheText: string; DisplayText: Boolean); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetText(const AValue: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Assign(Source: TPersistent); override;
+    procedure Clear; override;
+    class function IsBlob: Boolean; override;
+    procedure LoadFromFile(const FileName: string);
+    procedure LoadFromStream(Stream: TStream);
+    procedure SaveToFile(const FileName: string);
+    procedure SaveToStream(Stream: TStream);
+    procedure SetFieldType(AValue: TFieldType); override;
+    property BlobSize: Longint read FBlobSize;
+    property Modified: Boolean read FModified write FModified;
+    property Value: string read GetAsString write SetAsString;
+    property Transliterate: Boolean read FTransliterate write FTransliterate;
+  published
+    property BlobType: TBlobType read FBlobType write FBlobType;
+    property Size default 0;
+  end;
+
+{ TMemoField }
+
+  TMemoField = class(TBlobField)
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Transliterate default True;
+  end;
+
+{ TGraphicField }
+
+  TGraphicField = class(TBlobField)
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TIndexDef }
+
+  TIndexDefs = class;
+
+  TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
+    ixCaseInsensitive, ixExpression);
+
+  TIndexDef = class
+  Private 
+    FExpression : String;
+    FFields : String;
+    FName : String;
+    FOptions : TIndexOptions;
+    FSource : String;
+  public
+    constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
+      TheOptions: TIndexOptions);
+    destructor Destroy; override;
+    property Expression: string read FExpression;
+    property Fields: string read FFields;
+    property Name: string read FName;
+    property Options: TIndexOptions read FOptions;
+    property Source: string read FSource write FSource;
+  end;
+
+{ TIndexDefs }
+
+  TIndexDefs = class
+  Private
+    FCount : Longint;
+    FUpDated : Boolean;
+    Function GetItem (Index : longint) : TindexDef;
+  public
+    constructor Create(DataSet: TDataSet);
+    destructor Destroy; override;
+    procedure Add(const Name, Fields: string; Options: TIndexOptions);
+    procedure Assign(IndexDefs: TIndexDefs);
+    procedure Clear;
+    function FindIndexForFields(const Fields: string): TIndexDef;
+    function GetIndexForFields(const Fields: string;
+      CaseInsensitive: Boolean): TIndexDef;
+    function IndexOf(const Name: string): Longint;
+    procedure Update;
+    property Count: Longint read FCount;
+    property Items[Index: Longint]: TIndexDef read GetItem; default;
+    property Updated: Boolean read FUpdated write FUpdated;
+  end;
+
+{ TCheckConstraint }
+
+  TCheckConstraint = class(TCollectionItem)
+  Private
+    FCustomConstraint : String;
+    FErrorMessage : String;
+    FFromDictionary : Boolean;
+    FImportedConstraint : String;
+  public
+    procedure Assign(Source: TPersistent); override;
+  //  function GetDisplayName: string; override;
+  published
+    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
+    property ErrorMessage: string read FErrorMessage write FErrorMessage;
+    property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
+    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
+  end;
+
+{ TCheckConstraints }
+
+  TCheckConstraints = class(TCollection)
+  Private 
+   Function GetItem(Index : Longint) : TCheckConstraint; 
+   Procedure SetItem(index : Longint; Value : TCheckConstraint);
+  protected
+    function GetOwner: TPersistent; override;
+  public
+    constructor Create(Owner: TPersistent);
+    function Add: TCheckConstraint;
+    property Items[Index: Longint]: TCheckConstraint read GetItem write SetItem; default;
+  end;
+
+{ TFields }
+
+  Tfields = Class(TObject)
+    Private
+      FDataset : TDataset;
+      FFieldList : TList;
+      FOnChange : TNotifyEvent;
+      FValidFieldKinds : TFieldKinds;
+    Protected
+      Procedure Changed;
+      Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
+      Function GetCount : Longint;
+      Function GetField (Index : longint) : TField;
+      Procedure SetFieldIndex (Field : TField;Value : Integer);
+      Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
+      Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
+    Public
+      Constructor Create(ADataset : TDataset);
+      Destructor Destroy;override;
+      Procedure Add(Field : TField);
+      Procedure CheckFieldName (Const Value : String);
+      Procedure CheckFieldNames (Const Value : String);
+      Procedure Clear;
+      Function FindField (Const Value : String) : TField;
+      Function FieldByName (Const Value : String) : TField;
+      Function FieldByNumber(FieldNo : Integer) : TField;
+      Procedure GetFieldNames (Values : TStrings);
+      Function IndexOf(Field : TField) : Longint;
+      procedure Remove(Value : TField);
+      Property Count : Integer Read GetCount;
+      Property Dataset : TDataset Read FDataset;
+      Property Fields [Index : Integer] : TField Read GetField; default;
+    end;
+    
+
+{ TDataSet }
+
+  TBookmark = Pointer;
+  TBookmarkStr = string;
+
+  PBookmarkFlag = ^TBookmarkFlag;
+  TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
+
+  PBufferList = ^TBufferList;
+  TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
+
+  TGetMode = (gmCurrent, gmNext, gmPrior);
+
+  TGetResult = (grOK, grBOF, grEOF, grError);
+
+  TResyncMode = set of (rmExact, rmCenter);
+
+  TDataAction = (daFail, daAbort, daRetry);
+
+  TUpdateKind = (ukModify, ukInsert, ukDelete);
+
+
+  TLocateOption = (loCaseInsensitive, loPartialKey);
+  TLocateOptions = set of TLocateOption;
+
+  TDataOperation = procedure of object;
+
+  TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
+  TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
+    var Action: TDataAction) of object;
+
+  TFilterOption = (foCaseInsensitive, foNoPartialCompare);
+  TFilterOptions = set of TFilterOption;
+
+  TFilterRecordEvent = procedure(DataSet: TDataSet;
+    var Accept: Boolean) of object;
+
+  TDatasetClass = Class of TDataset;
+  TBufferArray = ^pchar;
+     
+  TDataSet = class(TComponent)
+  Private
+    FActive: Boolean;
+    FActiveRecord: Longint;
+    FAfterCancel: TDataSetNotifyEvent;
+    FAfterClose: TDataSetNotifyEvent;
+    FAfterDelete: TDataSetNotifyEvent;
+    FAfterEdit: TDataSetNotifyEvent;
+    FAfterInsert: TDataSetNotifyEvent;
+    FAfterOpen: TDataSetNotifyEvent;
+    FAfterPost: TDataSetNotifyEvent;
+    FAfterScroll: TDataSetNotifyEvent;
+    FAutoCalcFields: Boolean;
+    FBOF: Boolean;
+    FBeforeCancel: TDataSetNotifyEvent;
+    FBeforeClose: TDataSetNotifyEvent;
+    FBeforeDelete: TDataSetNotifyEvent;
+    FBeforeEdit: TDataSetNotifyEvent;
+    FBeforeInsert: TDataSetNotifyEvent;
+    FBeforeOpen: TDataSetNotifyEvent;
+    FBeforePost: TDataSetNotifyEvent;
+    FBeforeScroll: TDataSetNotifyEvent;
+    FBlobFieldCount: Longint;
+    FBookmark: TBookmarkStr;
+    FBookmarkSize: Longint;
+    FBuffers : TBufferArray;
+    FBufferCount: Longint;
+    FCalcBuffer: PChar;
+    FCalcFieldsSize: Longint;
+    FCanModify: Boolean;
+    FConstraints: TCheckConstraints;
+    FCurrentRecord: Longint;
+    FDefaultFields: Boolean;
+    FEOF: Boolean;
+    FFieldList : TFields;
+    FFieldCount : Longint;
+    FFieldDefs: TFieldDefs;
+    FFilterOptions: TFilterOptions;
+    FFilterText: string;
+    FFiltered: Boolean;
+    FFound: Boolean;
+    FInternalCalcFields: Boolean;
+    FModified: Boolean;
+    FOnCalcFields: TDataSetNotifyEvent;
+    FOnDeleteError: TDataSetErrorEvent;
+    FOnEditError: TDataSetErrorEvent;
+    FOnFilterRecord: TFilterRecordEvent;
+    FOnNewRecord: TDataSetNotifyEvent;
+    FOnPostError: TDataSetErrorEvent;
+    FRecNo: Longint;
+    FRecordCount: Longint;
+    FRecordSize: Word;
+    FState: TDataSetState;
+    Procedure DoInternalOpen;
+    Procedure DoInternalClose;
+    Function  GetBuffer (Index : longint) : Pchar;  
+    Function  GetField (Index : Longint) : TField;
+    Procedure RemoveField (Field : TField);
+    Procedure SetActive (Value : Boolean);
+    Procedure SetField (Index : Longint;Value : TField);
+    Procedure ShiftBuffers (Distance : Longint);
+    Procedure UpdateFieldDefs;
+  protected
+    procedure ActivateBuffers; virtual;
+    procedure BindFields(Binding: Boolean);
+    function  BookmarkAvailable: Boolean;
+    procedure CalculateFields(Buffer: PChar); virtual;
+    procedure CheckActive; virtual;
+    procedure CheckInactive; virtual;
+    procedure ClearBuffers; virtual;
+    procedure ClearCalcFields(Buffer: PChar); virtual;
+    procedure CloseBlob(Field: TField); virtual;
+    procedure CloseCursor; virtual;
+    procedure CreateFields;
+    procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
+    procedure DestroyFields; virtual;
+    procedure DoAfterCancel; virtual;
+    procedure DoAfterClose; virtual;
+    procedure DoAfterDelete; virtual;
+    procedure DoAfterEdit; virtual;
+    procedure DoAfterInsert; virtual;
+    procedure DoAfterOpen; virtual;
+    procedure DoAfterPost; virtual;
+    procedure DoAfterScroll; virtual;
+    procedure DoBeforeCancel; virtual;
+    procedure DoBeforeClose; virtual;
+    procedure DoBeforeDelete; virtual;
+    procedure DoBeforeEdit; virtual;
+    procedure DoBeforeInsert; virtual;
+    procedure DoBeforeOpen; virtual;
+    procedure DoBeforePost; virtual;
+    procedure DoBeforeScroll; virtual;
+    procedure DoOnCalcFields; virtual;
+    procedure DoOnNewRecord; virtual;
+    function  FieldByNumber(FieldNo: Longint): TField;
+    function  FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
+    procedure FreeFieldBuffers; virtual;
+    function  GetBookmarkStr: TBookmarkStr; virtual;
+    procedure GetCalcFields(Buffer: PChar); virtual;
+    function  GetCanModify: Boolean; virtual;
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+    function  GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
+    Function  GetfieldCount : Integer;
+    function  GetIsIndexField(Field: TField): Boolean; virtual;
+    function  GetNextRecords: Longint; virtual;
+    function  GetNextRecord: Boolean; virtual;
+    function  GetPriorRecords: Longint; virtual;
+    function  GetPriorRecord: Boolean; virtual;
+    function  GetRecordCount: Longint; virtual;
+    function  GetRecNo: Longint; virtual;
+    procedure InitFieldDefs; virtual;
+    procedure InitRecord(Buffer: PChar); virtual;
+    procedure InternalCancel; virtual;
+    procedure InternalEdit; virtual;
+    procedure InternalRefresh; virtual;
+    procedure Loaded; override;
+    procedure OpenCursor(InfoQuery: Boolean); virtual;
+    procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
+    Function  RequiredBuffers : longint;
+    procedure RestoreState(const Value: TDataSetState);
+    procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
+    procedure SetBufListSize(Value: Longint);
+    procedure SetChildOrder(Component: TComponent; Order: Longint); override;
+    procedure SetCurrentRecord(Index: Longint); virtual;
+    procedure SetFiltered(Value: Boolean); virtual;
+    procedure SetFilterOptions(Value: TFilterOptions); virtual;
+    procedure SetFilterText(const Value: string); virtual;
+    procedure SetFound(const Value: Boolean);
+    procedure SetModified(Value: Boolean);
+    procedure SetName(const Value: TComponentName); override;
+    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
+    procedure SetRecNo(Value: Longint); virtual;
+    procedure SetState(Value: TDataSetState);
+    function SetTempState(const Value: TDataSetState): TDataSetState;
+    function TempBuffer: PChar;
+    procedure UpdateIndexDefs; virtual;
+    property ActiveRecord: Longint read FActiveRecord;
+    property CurrentRecord: Longint read FCurrentRecord;
+    property BlobFieldCount: Longint read FBlobFieldCount;
+    property BookmarkSize: Longint read FBookmarkSize write FBookmarkSize;
+    property Buffers[Index: Longint]: PChar read GetBuffer;
+    property BufferCount: Longint read FBufferCount;
+    property CalcBuffer: PChar read FCalcBuffer;
+    property CalcFieldsSize: Longint read FCalcFieldsSize;
+    property InternalCalcFields: Boolean read FInternalCalcFields;
+    property Constraints: TCheckConstraints read FConstraints write FConstraints;
+  protected { abstract methods }
+    function AllocRecordBuffer: PChar; virtual; abstract;
+    procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
+    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
+    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
+    function GetRecordSize: Word; virtual; abstract;
+    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
+    procedure InternalClose; virtual; abstract;
+    procedure InternalDelete; virtual; abstract;
+    procedure InternalFirst; virtual; abstract;
+    procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
+    procedure InternalHandleException; virtual; abstract;
+    procedure InternalInitFieldDefs; virtual; abstract;
+    procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
+    procedure InternalLast; virtual; abstract;
+    procedure InternalOpen; virtual; abstract;
+    procedure InternalPost; virtual; abstract;
+    procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
+    function IsCursorOpen: Boolean; virtual; abstract;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function ActiveBuffer: PChar;
+    procedure Append;
+    procedure AppendRecord(const Values: array of const);
+    function BookmarkValid(ABookmark: TBookmark): Boolean; virtual;
+    procedure Cancel; virtual;
+    procedure CheckBrowseMode;
+    procedure ClearFields;
+    procedure Close;
+    function  ControlsDisabled: Boolean;
+    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; virtual;
+    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
+    procedure CursorPosChanged;
+    procedure Delete;
+    procedure DisableControls;
+    procedure Edit;
+    procedure EnableControls;
+    function FieldByName(const FieldName: string): TField;
+    function FindField(const FieldName: string): TField;
+    function FindFirst: Boolean;
+    function FindLast: Boolean;
+    function FindNext: Boolean;
+    function FindPrior: Boolean;
+    procedure First;
+    procedure FreeBookmark(ABookmark: TBookmark); virtual;
+    function GetBookmark: TBookmark; virtual;
+    function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
+    procedure GetFieldList(List: TList; const FieldNames: string);
+    procedure GetFieldNames(List: TStrings);
+    procedure GotoBookmark(ABookmark: TBookmark);
+    procedure Insert;
+    procedure InsertRecord(const Values: array of const);
+    function IsEmpty: Boolean;
+    function IsSequenced: Boolean; virtual;
+    procedure Last;
+    function MoveBy(Distance: Longint): Longint;
+    procedure Next;
+    procedure Open;
+    procedure Post; virtual;
+    procedure Prior;
+    procedure Refresh;
+    procedure Resync(Mode: TResyncMode); virtual;
+    procedure SetFields(const Values: array of const);
+    procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
+    procedure UpdateCursorPos;
+    procedure UpdateRecord;
+    property BOF: Boolean read FBOF;
+    property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
+    property CanModify: Boolean read GetCanModify;
+    property DefaultFields: Boolean read FDefaultFields;
+    property EOF: Boolean read FEOF;
+    property FieldCount: Longint read GetFieldCount;
+    property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
+    property Fields[Index: Longint]: TField read GetField write SetField;
+    property Found: Boolean read FFound;
+    property Modified: Boolean read FModified;
+    property RecordCount: Longint read GetRecordCount;
+    property RecNo: Longint read FRecNo write FRecNo;
+    property RecordSize: Word read FRecordSize;
+    property State: TDataSetState read FState;
+    property Fields : TFields Read FFieldList;
+    property Filter: string read FFilterText write FFilterText;
+    property Filtered: Boolean read FFiltered write FFiltered default False;
+    property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
+    property Active: Boolean read FActive write SetActive default False;
+    property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
+    property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
+    property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
+    property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
+    property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
+    property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
+    property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
+    property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
+    property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
+    property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
+    property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
+    property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
+    property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
+    property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
+    property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
+    property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
+    property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
+    property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
+    property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
+    property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
+    property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
+    property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
+    property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
+  end;
+
+ { TDBDataset }
+
+  TDBDatasetClass = Class of TDBDataset;
+  TDBDataset = Class(TDataset)
+    Private
+      FDatabase : TDatabase;
+      Procedure SetDatabase (Value : TDatabase);
+    Published
+      Property DataBase : TDatabase Read FDatabase Write SetDatabase;
+    end;
+  
+  { TDatabase }
+    
+  TLoginEvent = procedure(Database: TDatabase;
+    LoginParams: TStrings) of object;
+
+  TDatabaseClass = Class Of TDatabase;
+  
+  TDatabase = class(TComponent)
+  private
+    FConnected : Boolean;
+    FDataBaseName : String;
+    FDataSets : TList;
+    FDirectOry : String;
+    FKeepConnection : Boolean;
+    FLoginPrompt : Boolean;
+    FOnLogin : TLoginEvent;
+    FParams : TStrings;
+    FSQLBased : Boolean;
+    Function GetDataSetCount : Longint;
+    Function GetDataset(Index : longint) : TDBDataset;
+    procedure SetConnected (Value : boolean);
+    procedure RegisterDataset (DS : TDBDataset);
+    procedure UnRegisterDataset (DS : TDBDataset);
+    procedure RemoveDataSets;
+  protected
+    Procedure CheckConnected;
+    Procedure CheckDisConnected;
+    procedure Loaded; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    Procedure DoInternalConnect; Virtual;Abstract;
+    Procedure DoInternalDisConnect; Virtual;Abstract;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Close;
+    procedure Open;
+    procedure CloseDataSets;
+    procedure StartTransaction; virtual; abstract;
+    procedure EndTransaction; virtual; abstract;
+    property DataSetCount: Longint read GetDataSetCount;
+    property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
+    property Directory: string read FDirectory write FDirectory;
+    property IsSQLBased: Boolean read FSQLBased;
+  published
+    property Connected: Boolean read FConnected write SetConnected;
+    property DatabaseName: string read FDatabaseName write FDatabaseName;
+    property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
+    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
+    property Params : TStrings read FParams Write FParams;
+    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
+  end;
+
+Const
+  Fieldtypenames : Array [TFieldType] of String[15] =
+    ( 'Unknown',
+      'String',
+      'Smallint',
+      'Integer',
+      'Word',
+      'Boolean',
+      'Float',
+      'Date',
+      'Time',
+      'DateTime',
+      'Bytes',
+      'VarBytes',
+      'AutoInc',
+      'Blob',
+      'Memo',
+      'Graphic',
+      'FmtMemo',
+      'ParadoxOle',
+      'DBaseOle',
+      'TypedBinary',
+      'Cursor'
+    );
+{ Auxiliary functions }
+
+Procedure DatabaseError (Const Msg : String);
+Procedure DatabaseError (Const Msg : String; Comp : TComponent);
+Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
+Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const; 
+                            Comp : TComponent);
+
+implementation
+
+{ ---------------------------------------------------------------------
+    Auxiliary functions
+  ---------------------------------------------------------------------}
+  
+
+
+Procedure DatabaseError (Const Msg : String);
+
+begin
+  Raise EDataBaseError.Create(Msg);
+end;
+
+Procedure DatabaseError (Const Msg : String; Comp : TComponent);
+
+begin
+  Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
+end;
+
+Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
+
+begin
+  Raise EDatabaseError.CreateFmt(Fmt,Args);
+end;
+
+Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const; 
+                            Comp : TComponent);
+begin
+  Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
+end;
+
+
+{$i dbs.inc}
+
+{ TIndexDef }
+
+constructor TIndexDef.Create(Owner: TIndexDefs; const AName, TheFields: string;
+      TheOptions: TIndexOptions);
+
+begin
+  //!! To be implemented
+end;
+
+
+      
+destructor TIndexDef.Destroy; 
+
+begin
+  //!! To be implemented
+end;
+
+
+{ TIndexDefs }
+
+Function TIndexDefs.GetItem (Index : longint) : TindexDef;
+
+begin
+  //!! To be implemented
+end;
+
+
+constructor TIndexDefs.Create(DataSet: TDataSet);
+
+begin
+  //!! To be implemented
+end;
+
+
+destructor TIndexDefs.Destroy;
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TIndexDefs.Clear;
+
+begin
+  //!! To be implemented
+end;
+
+
+function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
+
+begin
+  //!! To be implemented
+end;
+
+
+function TIndexDefs.GetIndexForFields(const Fields: string;
+  CaseInsensitive: Boolean): TIndexDef;
+
+begin
+  //!! To be implemented
+end;
+
+
+function TIndexDefs.IndexOf(const Name: string): Longint;
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TIndexDefs.Update;
+
+begin
+  //!! To be implemented
+end;
+
+
+
+{ TCheckConstraint }
+
+procedure TCheckConstraint.Assign(Source: TPersistent); 
+
+begin
+  //!! To be implemented
+end;
+
+
+
+{ TCheckConstraints }
+
+Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint; 
+
+begin
+  //!! To be implemented
+end;
+
+
+Procedure TCheckConstraints.SetItem(index : Longint; Value : TCheckConstraint);
+
+begin
+  //!! To be implemented
+end;
+
+
+function TCheckConstraints.GetOwner: TPersistent;
+
+begin
+  //!! To be implemented
+end;
+
+
+constructor TCheckConstraints.Create(Owner: TPersistent);
+
+begin
+  //!! To be implemented
+end;
+
+
+function TCheckConstraints.Add: TCheckConstraint;
+
+begin
+  //!! To be implemented
+end;
+
+
+
+{$i dataset.inc}
+{$i fields.inc}
+{$i database.inc}
+
+end.

+ 25 - 0
fcl/db/dbs.inc

@@ -0,0 +1,25 @@
+Const
+  SUnknownFieldType = 'Unknown field type : %s';
+  SUnknownField = 'No field named "%s" was found in dataset "%s"';
+  SNeedFieldName = 'Field needs a name';  
+  SInvalidTypeConversion = 'Invalid type conversion to %s in field %s';
+  SReadOnlyField = 'Field %s cannot be modified, it is read-only.';
+  SInvalidFieldSize = 'Invalid field size : %d';
+  SNoDataset = 'No dataset asssigned for field : "%s"';
+  SDuplicateFieldName = 'Duplicate fieldname : "%s"';
+  SFieldNotFound = 'Field not found : "%s"';
+  SInvalidFieldKind = '%s : invalid field kind : ';
+  SRangeError = '%f is not between %f and %f for %s';
+  SNotAninteger = '"%s" is not a valid integer';
+  SCantSetAutoIncFields = 'AutoInc Fields are read-only';
+  SNotAFloat = '"%s" is not a valid float';
+  SInvalidDisplayValues = '"%s" are not valid boolean displayvalues';
+  SNotABoolean = '"%s" is not a valid boolean';
+  SInactiveDataset = 'Operation cannot be performed on an inactive dataset';
+  SActiveDataset = 'Operation cannot be performed on an active dataset';
+  SNoDatasets = 'No datasets are attached to the database';
+  SDatasetRegistered = 'Dataset already registered : "%s"';
+  SNoDatasetRegistered = 'No such dataset registered : "%s"';
+  SNotConnected = 'Operation cannot be performed on an disconnected database';
+  SConnected = 'Operation cannot be performed on an connected database';
+  SNoSuchRecord = 'Could not find the requested record.';  

+ 488 - 0
fcl/db/ddg_ds.pp

@@ -0,0 +1,488 @@
+unit DDG_DS;
+
+interface
+
+uses Db, Classes, DDG_Rec;
+
+type
+
+  PInteger =  ^Integer;
+  
+  // Bookmark information record to support TDataset bookmarks:
+  PDDGBookmarkInfo = ^TDDGBookmarkInfo;
+  TDDGBookmarkInfo = record
+    BookmarkData: Integer;
+    BookmarkFlag: TBookmarkFlag;
+  end;
+
+  // List used to maintain access to file of record:
+  TIndexList = class(TList)
+  public
+    procedure LoadFromFile(const FileName: string); virtual;
+    procedure LoadFromStream(Stream: TStream); virtual;
+    procedure SaveToFile(const FileName: string); virtual;
+    procedure SaveToStream(Stream: TStream); virtual;
+  end;
+
+  // Specialized DDG TDataset descendant for our "table" data:
+  TDDGDataSet = class(TDataSet)
+  private
+    function GetDataFileSize: Integer;
+  public
+    FDataFile: TDDGDataFile;
+    FIdxName: string;
+    FIndexList: TIndexList;
+    FTableName: string;
+    FRecordPos: Integer;
+    FRecordSize: Integer;
+    FBufferSize: Integer;
+    procedure SetTableName(const Value: string);
+  protected
+    { Mandatory overrides }
+    // Record buffer methods:
+    function AllocRecordBuffer: PChar; override;
+    procedure FreeRecordBuffer(var Buffer: PChar); override;
+    procedure InternalInitRecord(Buffer: PChar); override;
+    function GetRecord(Buffer: PChar; GetMode: TGetMode;
+      DoCheck: Boolean): TGetResult; override;
+    function GetRecordSize: Word; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+    // Bookmark methods:
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+    procedure InternalGotoBookmark(ABookmark: Pointer); override;
+    procedure InternalSetToRecord(Buffer: PChar); override;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    // Navigational methods:
+    procedure InternalFirst; override;
+    procedure InternalLast; override;
+    // Editing methods:
+    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
+    procedure InternalDelete; override;
+    procedure InternalPost; override;
+    // Misc methods:
+    procedure InternalClose; override;
+    procedure InternalHandleException; override;
+    procedure InternalInitFieldDefs; override;
+    procedure InternalOpen; override;
+    function IsCursorOpen: Boolean; override;
+    { Optional overrides }
+    function GetRecordCount: Integer; override;
+    function GetRecNo: Integer; override;
+    procedure SetRecNo(Value: Integer); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+
+    // Additional procedures
+    procedure EmptyTable;
+  published
+    property Active;
+    property TableName: string read FTableName write SetTableName;
+    property BeforeOpen;
+    property AfterOpen;
+    property BeforeClose;
+    property AfterClose;
+    property BeforeInsert;
+    property AfterInsert;
+    property BeforeEdit;
+    property AfterEdit;
+    property BeforePost;
+    property AfterPost;
+    property BeforeCancel;
+    property AfterCancel;
+    property BeforeDelete;
+    property AfterDelete;
+    property BeforeScroll;
+    property AfterScroll;
+    property OnDeleteError;
+    property OnEditError;
+
+    // Additional Properties
+    property DataFileSize: Integer read GetDataFileSize;
+  end;
+
+implementation
+
+uses SysUtils;
+
+const
+  feDDGTable = '.ddg';
+  feDDGIndex = '.ddx';
+  // note that file is not being locked!
+
+{ TIndexList }
+
+procedure TIndexList.LoadFromFile(const FileName: string);
+var
+  F: TFileStream;
+begin
+  F := TFileStream.Create(FileName, fmOpenRead);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TIndexList.LoadFromStream(Stream: TStream);
+var
+  Value: Integer;
+begin
+  while Stream.Position < Stream.Size do
+  begin
+    Stream.Read(Value, SizeOf(Value));
+    Add(Pointer(Value));
+  end;
+end;
+
+procedure TIndexList.SaveToFile(const FileName: string);
+var
+  F: TFileStream;
+begin
+  F := TFileStream.Create(FileName, fmCreate);
+  try
+    SaveToStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TIndexList.SaveToStream(Stream: TStream);
+var
+  i: Integer;
+  Value: Integer;
+begin
+  for i := 0 to Count - 1 do
+  begin
+    Value := Integer(Items[i]);
+    Stream.Write(Value, SizeOf(Value));
+  end;
+end;
+
+{ TDDGDataSet }
+
+constructor TDDGDataSet.Create(AOwner: TComponent);
+begin
+  FIndexList := TIndexList.Create;
+  FRecordSize := SizeOf(TDDGData);
+  FBufferSize := FRecordSize + SizeOf(TDDGBookmarkInfo);
+  inherited Create(AOwner);
+end;
+
+destructor TDDGDataSet.Destroy;
+begin
+  inherited Destroy;
+  FIndexList.Free;
+end;
+
+function TDDGDataSet.AllocRecordBuffer: PChar;
+begin
+  Result := AllocMem(FBufferSize);
+end;
+
+procedure TDDGDataSet.FreeRecordBuffer(var Buffer: PChar);
+begin
+  FreeMem(Buffer);
+end;
+
+procedure TDDGDataSet.InternalInitRecord(Buffer: PChar);
+begin
+  FillChar(Buffer^, FBufferSize, 0);
+end;
+
+function TDDGDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
+  DoCheck: Boolean): TGetResult;
+var
+  IndexPos: Integer;
+begin
+ if FIndexList.Count < 1 then
+    Result := grEOF
+  else begin
+    Result := grOk;
+    case GetMode of
+      gmPrior:
+        if FRecordPos <= 0 then
+        begin
+          Result := grBOF;
+          FRecordPos := -1;
+        end
+        else
+          Dec(FRecordPos);
+      gmCurrent:
+        if (FRecordPos < 0) or (FRecordPos >= RecordCount) then
+           Result := grError;
+      gmNext:
+        if FRecordPos >= RecordCount-1 then
+          Result := grEOF
+        else
+          Inc(FRecordPos);
+    end;
+    if Result = grOk then
+    begin
+      IndexPos := Integer(FIndexList[FRecordPos]);
+      Seek(FDataFile, IndexPos);
+      BlockRead(FDataFile, PDDGData(Buffer)^, 1);
+      with PDDGBookmarkInfo(Buffer + FRecordSize)^ do
+      begin
+        BookmarkData := FRecordPos;
+        BookmarkFlag := bfCurrent;
+      end;
+    end
+    else if (Result = grError) and DoCheck then
+      DatabaseError('No records');
+  end;
+end;
+
+function TDDGDataSet.GetRecordSize: Word;
+begin
+  Result := FRecordSize;
+end;
+
+function TDDGDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
+begin
+  Result := True;
+  case Field.Index of
+    0:
+      begin
+        Move(ActiveBuffer^, Buffer^, Field.Size);
+        Result := PChar(Buffer)^ <> #0;
+      end;
+    1: Move(PDDGData(ActiveBuffer)^.Height, Buffer^, Field.DataSize);
+    2: Move(PDDGData(ActiveBuffer)^.ShoeSize, Buffer^, Field.DataSize);
+  end;
+end;
+
+procedure TDDGDataSet.SetFieldData(Field: TField; Buffer: Pointer);
+begin
+  case Field.Index of
+    0: Move(Buffer^, ActiveBuffer^, Field.Size);
+    1: Move(Buffer^, PDDGData(ActiveBuffer)^.Height, Field.DataSize);
+    2: Move(Buffer^, PDDGData(ActiveBuffer)^.ShoeSize, Field.DataSize);
+  end;
+  DataEvent(deFieldChange, Longint(Field));
+end;
+
+procedure TDDGDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  PInteger(Data)^ := PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkData;
+end;
+
+function TDDGDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
+begin
+  Result := PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag;
+end;
+
+procedure TDDGDataSet.InternalGotoBookmark(ABookmark: Pointer);
+begin
+  FRecordPos := PInteger(ABookmark)^;
+  Writeln ('Bookmark : Setting record position to : ',FrecordPos);
+end;
+
+procedure TDDGDataSet.InternalSetToRecord(Buffer: PChar);
+begin
+  // bookmark value is the same as an offset into the file
+  FRecordPos := PDDGBookmarkInfo(Buffer + FRecordSize)^.Bookmarkdata;
+end;
+
+procedure TDDGDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
+end;
+
+procedure TDDGDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
+begin
+  PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag := Value;
+end;
+
+procedure TDDGDataSet.InternalFirst;
+begin
+  FRecordPos := -1;
+end;
+
+procedure TDDGDataSet.InternalInitFieldDefs;
+begin
+  // create FieldDefs which map to each field in the data record
+  FieldDefs.Clear;
+  TFieldDef.Create(FieldDefs, 'Name', ftString, SizeOf(TNameStr), False, 1);
+  TFieldDef.Create(FieldDefs, 'Height', ftFloat, 0, False, 2);
+  TFieldDef.Create(FieldDefs, 'ShoeSize', ftInteger, 0, False, 3);
+end;
+
+procedure TDDGDataSet.InternalLast;
+begin
+  FRecordPos := FIndexList.Count;
+end;
+
+procedure TDDGDataSet.InternalClose;
+begin
+  if FileRec(FDataFile).Mode <> 0 then
+    CloseFile(FDataFile);
+  FIndexList.SaveToFile(FIdxName);
+  FIndexList.Clear;
+  if DefaultFields then
+    DestroyFields;
+  FRecordPos := -1;
+  FillChar(FDataFile, SizeOf(FDataFile), 0);
+end;
+
+procedure TDDGDataSet.InternalHandleException;
+begin
+  // standard implementation for this method:
+  // Application.HandleException(Self);
+end;
+
+procedure TDDGDataSet.InternalDelete;
+begin
+  FIndexList.Delete(FRecordPos);
+  if FRecordPos >= FIndexList.Count then Dec(FRecordPos);
+end;
+
+procedure TDDGDataSet.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
+var
+  RecPos: Integer;
+begin
+  Seek(FDataFile, FileSize(FDataFile));
+  BlockWrite(FDataFile, PDDGData(Buffer)^, 1);
+  if DoAppend then
+  begin
+    FIndexList.Add(Pointer(FileSize(FDataFile) - 1));
+    InternalLast;
+  end
+  else begin
+    if FRecordPos = -1 then RecPos := 0
+    else RecPos := FRecordPos;
+    FIndexList.Insert(RecPos, Pointer(FileSize(FDataFile) - 1));
+  end;
+  FIndexList.SaveToFile(FIdxName);
+end;
+
+procedure TDDGDataSet.InternalOpen;
+var
+  HFile: THandle;
+begin
+  // make sure table and index files exist
+  FIdxName := ChangeFileExt(FTableName, feDDGIndex);
+  if not (FileExists(FTableName) and FileExists(FIdxName)) then
+    begin
+ {
+    if MessageDlg('Table or index file not found.  Create new table?',
+      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
+    begin
+      HFile := FileCreate(FTableName);
+      if HFile = -1 then
+        DatabaseError('Error creating table file');
+      FileClose(HFile);
+      HFile := FileCreate(FIdxName);
+      if HFile = -1 then
+        DatabaseError('Error creating index file');
+      FileClose(HFile);
+    end
+   else
+ }  
+      DatabaseError('Could not open table');
+  end;
+  // open data file
+  FileMode := fmOpenRead;
+  Writeln ('OPening data file');
+  AssignFile(FDataFile, FTableName);
+  Reset(FDataFile);  
+  try
+    writeln ('Loading index file');
+    FIndexList.LoadFromFile(FIdxName); // initialize index TList from file
+    FRecordPos := -1;                  // initial record pos before BOF
+    BookmarkSize := SizeOf(Integer);   // initialize bookmark size for VCL
+    InternalInitFieldDefs;             // initialize FieldDef objects
+    // Create TField components when no persistent fields have been created
+    if DefaultFields then CreateFields;
+    BindFields(True);                  // bind FieldDefs to actual data
+  except
+    CloseFile(FDataFile);
+    FillChar(FDataFile, SizeOf(FDataFile), 0);
+    raise;
+  end;
+end;
+
+procedure TDDGDataSet.InternalPost;
+var
+  RecPos, InsPos: Integer;
+begin
+  if FRecordPos = -1 then
+    RecPos := 0
+  else begin
+    if State = dsEdit then RecPos := Integer(FIndexList[FRecordPos])
+    else RecPos := FileSize(FDataFile);
+  end;
+  Seek(FDataFile, RecPos);
+  BlockWrite(FDataFile, PDDGData(ActiveBuffer)^, 1);
+  if State <> dsEdit then
+  begin
+    if FRecordPos = -1 then InsPos := 0
+    else InsPos := FRecordPos;
+    FIndexList.Insert(InsPos, Pointer(RecPos));
+  end;
+  FIndexList.SaveToFile(FIdxName);
+end;
+
+function TDDGDataSet.IsCursorOpen: Boolean;
+begin
+  Result := FileRec(FDataFile).Mode <> 0;
+end;
+
+function TDDGDataSet.GetRecordCount: Integer;
+begin
+  Result := FIndexList.Count;
+end;
+
+function TDDGDataSet.GetRecNo: Integer;
+begin
+  UpdateCursorPos;
+  if (FRecordPos = -1) and (RecordCount > 0) then
+    Result := 1
+  else
+    Result := FRecordPos + 1;
+end;
+
+procedure TDDGDataSet.SetRecNo(Value: Integer);
+begin
+  if (Value >= 0) and (Value <= FIndexList.Count-1) then
+  begin
+    FRecordPos := Value - 1;
+    Resync([]);
+  end;
+end;
+
+procedure TDDGDataSet.SetTableName(const Value: string);
+begin
+  CheckInactive;
+  FTableName := Value;
+  if ExtractFileExt(FTableName) = '' then
+    FTableName := FTableName + feDDGTable;
+  FIdxName := ChangeFileExt(FTableName, feDDGIndex);
+end;
+
+function TDDGDataSet.GetDataFileSize: Integer;
+begin
+  Result := FileSize(FDataFile);
+end;
+
+procedure TDDGDataSet.EmptyTable;
+var
+  HFile: THandle;
+begin
+  Close;
+
+  DeleteFile(FTableName);
+  HFile := FileCreate(FTableName);
+  FileClose(HFile);
+
+  DeleteFile(FIdxName);
+  HFile := FileCreate(FIdxName);
+  FileClose(HFile);
+
+  Open;
+end;
+
+end.

+ 24 - 0
fcl/db/ddg_rec.pp

@@ -0,0 +1,24 @@
+unit DDG_Rec;
+
+interface
+
+type
+
+  // arbitary-length array of char used for name field
+  TNameStr = array[0..31] of char;
+
+  // this record info represents the "table" structure:
+  PDDGData = ^TDDGData;
+  TDDGData = record
+    Name: TNameStr;
+    Height: Extended;
+    ShoeSize: Integer;
+  end;
+
+  // Pascal file of record which holds "table" data:
+  TDDGDataFile = file of TDDGData;
+
+
+implementation
+
+end.

+ 1718 - 0
fcl/db/fields.inc

@@ -0,0 +1,1718 @@
+PRocedure DumpMem (P : Pointer;Size : Longint);
+
+Type PByte = ^Byte;
+
+Var i : longint;
+
+begin
+  Write ('Memory dump : ');
+  For I:=0 to Size-1 do
+    Write (Pbyte(P)[i],' ');
+  Writeln;  
+end;
+
+{ ---------------------------------------------------------------------
+    TFieldDef
+  ---------------------------------------------------------------------}
+     
+Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
+      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
+
+begin
+  Inherited Create(AOwner);
+  FName:=Aname;
+  FDatatype:=ADatatype;
+  FSize:=ASize;
+  FRequired:=ARequired;
+  FPrecision:=-1;
+  // Correct sizes.
+  If FDataType=ftFloat then
+    begin
+    If Not FSize in [4,8,10] then FSize:=10
+    end
+  else If FDataType in [ftWord,ftsmallint,ftinteger] Then
+    If Not FSize in [1,2,4] then FSize:=4;
+  FFieldNo:=AFieldNo;
+  AOwner.FItems.Add(Self);
+end;
+
+Destructor TFieldDef.Destroy;
+
+Var I : longint;
+
+begin
+  Inherited destroy;
+end;
+
+Function TFieldDef.CreateField(AOwner: TComponent): TField;
+
+Var TheField : TFieldClass;
+
+begin
+  Writeln ('Creating field');
+  TheField:=GetFieldClass;
+  if TheField=Nil then
+    DatabaseErrorFmt(SUnknownFieldType,[FName]);
+  Result:=Thefield.Create(AOwner);
+  Try
+    Result.Size:=FSize;
+    Result.Required:=FRequired;
+    Result.FieldName:=FName;
+    Result.SetFieldType(DataType);
+    Writeln ('Trying to set dataset');
+    Result.Dataset:=TFieldDefs(Owner).FDataset;
+    If Result is TFloatField then
+      TFloatField(Result).Precision:=FPrecision;
+  except
+    Result.Free;
+    Raise;
+  end;
+end;
+
+Function TFieldDef.GetFieldClass : TFieldClass;
+
+begin
+  //!! Should be owner as tdataset but that doesn't work ??
+  
+  If Assigned(Owner) then
+    Result:=TFieldDefs(Owner).FDataSet.GetFieldClass(FDataType)
+  else
+    Result:=Nil;  
+end;
+
+{ ---------------------------------------------------------------------
+    TFieldDefs
+  ---------------------------------------------------------------------}
+
+destructor TFieldDefs.Destroy;
+
+begin
+  FItems.Free;
+  // This will destroy all fielddefs since we own them...
+  Inherited Destroy;
+end;
+
+procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word;
+  ARequired: Boolean);
+
+begin
+  Writeln ('Adding fielddef');
+  If Length(Name)=0 Then 
+    DatabaseError(SNeedFieldName);
+  // the fielddef will register itself here as a owned component.
+  // fieldno is 1 based !
+  FItems.Add(TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,FItems.Count+1));
+end;
+
+function TFieldDefs.GetCount: Longint;
+
+begin
+  Result:=FItems.Count;
+end;
+
+function TFieldDefs.GetItem(Index: Longint): TFieldDef;
+
+begin
+  Result:=TFieldDef(FItems[Index]);
+end;
+
+constructor TFieldDefs.Create(ADataSet: TDataSet);
+
+begin
+  Inherited Create(ADataSet);
+  FItems:=TList.Create;
+  FDataset:=ADataset;
+end;
+
+procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
+
+Var I : longint;
+
+begin
+  Clear;
+  For i:=1 to FieldDefs.Count-1 do
+    With FieldDefs[i] do 
+      Add(Name,DataType,Size,Required);
+end;
+
+procedure TFieldDefs.Clear;
+
+Var I : longint;
+
+begin
+  For I:=FItems.Count-1 downto 0 do
+    TFieldDef(Fitems[i]).Free;
+end;
+
+function TFieldDefs.Find(const AName: string): TFieldDef;
+
+Var I : longint;
+
+begin
+  I:=IndexOf(AName);
+  If I=-1 Then
+    DataBaseErrorFmt(SUnknownField,[AName,FDataSet.Name]);
+  Result:=TFieldDef(Fitems[i]);
+end;
+
+function TFieldDefs.IndexOf(const AName: string): Longint;
+
+Var I : longint;
+
+begin
+  For I:=0 to Fitems.Count-1 do
+    If AnsiCompareText(TFieldDef(FItems[I]).Name,AName)=0 then
+      begin
+      Result:=I;
+      Exit;
+      end;
+  Result:=-1;
+end;
+
+procedure TFieldDefs.Update;
+
+begin
+  FDataSet.UpdateFieldDefs;
+end;
+
+{ ---------------------------------------------------------------------
+    TField
+  ---------------------------------------------------------------------}
+
+Const 
+  SBoolean = 'Boolean';
+  SDateTime = 'TDateTime';
+  SFloat = 'Float';
+  SInteger = 'Integer';
+  SString = 'String';
+
+constructor TField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  FVisible:=True;
+  FValidChars:=[#0..#155];
+end;
+
+destructor TField.Destroy; 
+
+begin
+  IF Assigned(FDataSet) then
+    begin
+    FDataSet.Active:=False;
+    FDataSet.RemoveField(Self);
+    end;
+  Inherited Destroy;
+end;
+
+function TField.AccessError(const TypeName: string): EDatabaseError;
+
+begin
+  Result:=EDatabaseError.CreateFmt(SinvalidTypeConversion,[TypeName,FFieldName]);
+end;
+
+procedure TField.Assign(Source: TPersistent); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TField.Change; 
+
+begin
+  If Assigned(FOnChange) Then 
+    FOnChange(Self);
+end;
+
+procedure TField.CheckInactive;
+
+begin
+  If Assigned(FDataSet) then 
+    FDataset.CheckInactive;
+end;
+
+procedure TField.Clear; 
+
+begin
+  SetData(Nil);
+end;
+
+procedure TField.DataChanged;
+
+begin
+  FDataset.DataEvent(deFieldChange,longint(Self));
+end;
+
+procedure TField.FocusControl;
+
+begin
+  FDataSet.DataEvent(deFocusControl,longint(Self));
+end;
+
+procedure TField.FreeBuffers; 
+
+begin
+  // Empty. Provided for backward compatibiliy;
+  // TDataset manages the buffers.
+end;
+
+function TField.GetAsBoolean: Boolean; 
+
+begin
+  AccessError(SBoolean);
+end;
+
+function TField.GetAsDateTime: TDateTime; 
+
+begin
+  AccessError(SdateTime);
+end;
+
+function TField.GetAsFloat: Extended; 
+
+begin
+  AccessError(SDateTime);
+end;
+
+function TField.GetAsLongint: Longint; 
+
+begin
+  AccessError(SInteger);
+end;
+
+function TField.GetAsString: string; 
+
+begin
+  AccessError(SString);
+end;
+
+function TField.GetCanModify: Boolean; 
+
+begin
+  Result:=Not ReadOnly;
+  If Result then 
+    begin
+    Result:=Assigned(DataSet);
+    If Result then
+      Result:=Not(DataSet.CanModify);
+    end;
+end;
+
+function TField.GetData(Buffer: Pointer): Boolean;
+
+begin
+  IF FDataset=Nil then
+    DatabaseErrorFmt(SNoDataset,[FieldName]);
+  If FVAlidating then
+    begin
+    result:=Not(FValueBuffer=Nil);
+    If Result then
+      Move (FValueBuffer^,Buffer^ ,DataSize);
+    end
+  else
+    Result:=FDataset.GetFieldData(Self,Buffer);
+end;
+
+function TField.GetDataSize: Word; 
+
+begin
+  Result:=0;
+end;
+
+function TField.GetDefaultWidth: Longint; 
+
+begin
+  Result:=10;
+end;
+
+function TField.getIndex : longint;
+
+begin
+  If Assigned(FDataset) then
+    Result:=FDataset.FFieldList.IndexOf(Self)
+  else
+    Result:=-1;
+end;
+
+function TField.GetIsNull: Boolean; 
+
+begin
+  Result:=Not(GetData (Nil));
+end;
+
+function TField.GetParentComponent: TComponent; 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TField.GetText(var AText: string; ADisplayText: Boolean); 
+
+begin
+  AText:=GetAsString;
+end;
+
+function TField.HasParent: Boolean; 
+
+begin
+  HasParent:=True;
+end;
+
+function TField.IsValidChar(InputChar: Char): Boolean; 
+
+begin
+  // FValidChars must be set in Create.
+  Result:=InputChar in FValidChars;
+end;
+
+procedure TField.Notification(AComponent: TComponent; Operation: TOperation); 
+
+begin
+  Inherited Notification(AComponent,Operation);
+end;
+
+procedure TField.PropertyChanged(LayoutAffected: Boolean);
+
+begin
+  If (FDataset<>Nil) and (FDataset.Active) then
+    If LayoutAffected then
+      FDataset.DataEvent(deLayoutChange,0)
+    else
+      FDataset.DataEvent(deDatasetchange,0);
+end;
+
+procedure TField.ReadState(Reader: TReader); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TField.SetAsBoolean(AValue: Boolean); 
+
+begin
+  AccessError(SBoolean);
+end;
+
+procedure TField.SetAsDateTime(AValue: TDateTime); 
+
+begin
+  AccessError(SDateTime);
+end;
+
+procedure TField.SetAsFloat(AValue: Extended); 
+
+begin
+  AccessError(SFloat);
+end;
+
+procedure TField.SetAsLongint(AValue: Longint); 
+
+begin
+  AccessError(SInteger);
+end;
+
+procedure TField.SetAsString(const AValue: string); 
+
+begin
+  AccessError(SString);
+end;
+
+procedure TField.SetData(Buffer: Pointer);
+
+begin
+  If Not Assigned(FDataset) then
+    EDatabaseError.CreateFmt(SNoDataset,[FieldName]);
+  FDataSet.SetFieldData(Self,Buffer);  
+end;
+
+Procedure TField.SetDataset (Value : TDataset);
+
+begin
+  Writeln ('Setting dataset');
+  If Value=FDataset then exit;
+  If Assigned(FDataset) Then FDataset.CheckInactive;
+  If Assigned(Value) then
+    begin
+    Value.CheckInactive;
+// ?? Identifier idents no member ??
+    Value.FFieldList.CheckFieldName(FFieldName);
+    end;
+  If Assigned(FDataset) then
+    FDataset.FFieldList.Remove(Self);
+  If Assigned(Value) then 
+    begin
+    Writeln('Adding field to list..');
+    Value.FFieldList.Add(Self);
+    end;
+  FDataset:=Value;    
+end;
+
+procedure TField.SetDataType(AValue: TFieldType);
+
+begin
+  FDataType := AValue;
+end;
+
+procedure TField.SetFieldType(AValue: TFieldType); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TField.SetParentComponent(AParent: TComponent); 
+
+begin
+  //!! To be implemented
+end;
+
+procedure TField.SetSize(AValue: Word); 
+
+begin
+  CheckInactive;
+  CheckTypeSize(AValue);
+  FSize:=AValue;
+end;
+
+procedure TField.SetText(const AValue: string); 
+
+begin
+  AsString:=AValue;
+end;
+
+procedure TField.Validate(Buffer: Pointer);
+
+begin
+  If assigned(OnValidate) Then
+    begin
+    FValueBuffer:=Buffer;
+    FValidating:=True;
+    Try
+      OnValidate(Self);
+    finally
+      FValidating:=False;
+    end;
+    end;   
+end;
+
+class function Tfield.IsBlob: Boolean; 
+
+begin
+  Result:=False;
+end;
+
+class procedure TField.CheckTypeSize(AValue: Longint); 
+
+begin
+  If (AValue<>0) and Not IsBlob Then
+    DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
+end;
+
+{ ---------------------------------------------------------------------
+    TStringField
+  ---------------------------------------------------------------------}
+  
+
+constructor TStringField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftString);
+  Size:=20;
+end;
+
+class procedure TStringField.CheckTypeSize(AValue: Longint); 
+
+begin
+  If (AValue<1) or (AValue>dsMaxStringSize) Then
+    databaseErrorFmt(SInvalidFieldSize,[AValue])
+end;
+
+function TStringField.GetAsBoolean: Boolean; 
+
+Var S : String;
+
+begin
+  S:=GetAsString;
+  result := (Length(S)>0) and (Upcase(S[1]) in ['T',YesNoChars[True]]);
+end;
+
+function TStringField.GetAsDateTime: TDateTime; 
+
+begin
+  Result:=StrToDateTime(GetAsString);
+end;
+
+function TStringField.GetAsFloat: Extended; 
+
+begin
+  Result:=StrToFloat(GetAsString);
+end;
+
+function TStringField.GetAsLongint: Longint; 
+
+begin
+  Result:=StrToInt(GetAsString);
+end;
+
+function TStringField.GetAsString: string; 
+
+begin
+  If Not GetValue(Result) then 
+    Result:='';
+end;
+
+function TStringField.GetDataSize: Word; 
+
+begin
+  Result:=Size+1;
+end;
+
+function TStringField.GetDefaultWidth: Longint; 
+
+begin
+  result:=Size;
+end;
+
+Procedure TStringField.GetText(var AText: string; DisplayText: Boolean); 
+
+begin
+    AText:=GetAsString;
+end;
+
+function TStringField.GetValue(var AValue: string): Boolean;
+
+Var Buf : TStringFieldBuffer;
+
+begin
+  Result:=GetData(@Buf);
+  If Result then
+    AValue:=Buf;
+end;
+
+procedure TStringField.SetAsBoolean(AValue: Boolean); 
+
+begin
+  If AValue Then
+    SetAsString('T')
+  else
+    SetAsString('F');
+end;
+
+procedure TStringField.SetAsDateTime(AValue: TDateTime); 
+
+begin
+  SetAsString(DateTimeToStr(AValue));
+end;
+
+procedure TStringField.SetAsFloat(AValue: Extended); 
+
+begin
+  SetAsString(FloatToStr(AValue));
+end;
+
+procedure TStringField.SetAsLongint(AValue: Longint); 
+
+begin
+  SetAsString(intToStr(AValue));
+end;
+
+procedure TStringField.SetAsString(const AValue: string); 
+
+Const NullByte : char = #0;
+
+begin
+  IF Length(AValue)=0 then
+    SetData(@NullByte)
+  else
+    SetData(@AValue[1]);  
+end;
+
+{ ---------------------------------------------------------------------
+    TNumericField
+  ---------------------------------------------------------------------}
+
+
+constructor TNumericField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  AlignMent:=taRightJustify;
+end;
+
+procedure TNumericField.RangeError(AValue, Min, Max: Extended);
+
+begin
+  DatabaseErrorFMT(SRangeError,[AValue,Min,Max,FieldName]);
+end;
+
+procedure TNumericField.SetDisplayFormat(const AValue: string);
+
+begin
+ If FDisplayFormat<>AValue then
+   begin
+   FDisplayFormat:=AValue;
+   PropertyChanged(True);
+   end;
+end;
+
+procedure TNumericField.SetEditFormat(const AValue: string);
+
+begin
+  If FEDitFormat<>AValue then
+    begin
+    FEDitFormat:=AVAlue;
+    PropertyChanged(True);
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+    TLongintField
+  ---------------------------------------------------------------------}
+
+
+constructor TLongintField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDatatype(ftinteger);
+  FMinRange:=$80000000;
+  FMaxRange:=$7fffffff;
+  FValidchars:=['+','-','0'..'9'];
+end;
+
+function TLongintField.GetAsFloat: Extended; 
+
+begin
+  Result:=GetAsLongint;
+end;
+
+function TLongintField.GetAsLongint: Longint; 
+
+begin
+  If Not GetValue(Result) then 
+    Result:=0;
+end;
+
+function TLongintField.GetAsString: string; 
+
+Var L : Longint;
+
+begin
+  If GetValue(L) then
+    Result:=IntTostr(L)
+  else
+    Result:='';
+end;
+
+function TLongintField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(Longint);
+end;
+
+procedure TLongintField.GetText(var AText: string; DisplayText: Boolean); 
+
+var l : longint;
+    fmt : string;
+
+begin
+  Atext:='';
+  If Not GetData(@l) then exit;
+  If DisplayText or (FEditFormat='') then
+    fmt:=FDisplayFormat
+  else
+    fmt:=FEditFormat;
+{  // no formatFloat yet
+  If length(fmt)<>0 then
+    AText:=FormatFloat(fmt,L)
+  else
+}
+    Str(L,AText);
+end;
+
+function TLongintField.GetValue(var AValue: Longint): Boolean;
+
+Type 
+  PSmallint = ^SmallInt;
+  PLongint = ^Longint;
+  PWord = ^Word;
+
+Var L : Longint;
+    P : PLongint;
+    
+begin
+  P:=@L;
+  Result:=GetData(P);
+  If Result then
+    Case Datatype of
+      ftInteger,ftautoinc  : AValue:=Plongint(P)^;
+      ftword               : Avalue:=Pword(P)^;
+      ftsmallint           : AValue:=PSmallint(P)^;
+    end;
+end;
+
+procedure TLongintField.SetAsFloat(AValue: Extended); 
+
+begin
+  SetAsLongint(Round(Avalue));
+end;
+
+procedure TLongintField.SetAsLongint(AValue: Longint); 
+
+begin
+  If CheckRange(AValue) then
+    SetData(@AValue)
+  else
+    RangeError(Avalue,FMinrange,FMaxRange);
+end;
+
+procedure TLongintField.SetAsString(const AValue: string); 
+
+Var L,Code : longint;
+
+begin
+  If length(AValue)=0 then
+    Clear
+  else
+    begin
+    Val(AVAlue,L,Code);
+    If Code=0 then
+      SetAsLongint(L)
+    else
+      DatabaseErrorFMT(SNotAnInteger,[Avalue]);
+    end;
+end;
+
+Function TLongintField.CheckRange(AValue : longint) : Boolean;
+
+begin
+  if FMaxValue=0 Then
+    Result:=(AValue<=FMaxRange) and (AValue>=FMinRange)
+  else
+    Result:=(AValue<=FMaxValue) and (AValue>=FMinValue);
+end;
+
+Procedure TLongintField.SetMaxValue (AValue : longint);
+
+begin
+  If (AValue>=FMinRange) and (AValue<=FMaxRange) then
+    FMaxValue:=AValue
+  else
+    RangeError(AValue,FMinRange,FMaxRange);
+end;
+
+Procedure TLongintField.SetMinValue (AValue : longint);
+
+begin
+  If (AValue>=FMinRange) and (AValue<=FMaxRange) then
+    FMinValue:=AValue
+  else
+    RangeError(AValue,FMinRange,FMaxRange);
+end;
+
+{ TSmallintField }
+
+function TSmallintField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(SmallInt);
+end;
+
+constructor TSmallintField.Create(AOwner: TComponent); 
+
+begin
+  inherited Create(AOwner);
+  SetDataType(ftSmallInt);
+  FMinRange:=-32768;
+  FMaxRange:=32767;
+end;
+
+
+{ TWordField }
+
+function TWordField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(Word);
+end;
+
+constructor TWordField.Create(AOwner: TComponent); 
+
+begin
+  inherited Create(AOwner);
+  SetDataType(ftWord);
+  FMinRange:=0;
+  FMaxRange:=65535;
+  FValidchars:=['+','0'..'9'];
+end;
+
+{ TAutoIncField }
+
+constructor TAutoIncField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOWner);
+  SetDataType(ftAutoInc);
+end;
+
+Procedure TAutoIncField.SetAsLongint(AValue : Longint); 
+
+begin
+  DataBaseError(SCantSetAutoIncfields);
+end;
+
+{ TFloatField }
+
+function TFloatField.GetAsFloat: Extended; 
+
+begin
+  If Not GetData(@Result) Then 
+    Result:=0.0;
+end;
+
+function TFloatField.GetAsLongint: Longint; 
+
+begin
+  Result:=Round(GetAsFloat);
+end;
+
+function TFloatField.GetAsString: string; 
+
+Var R : Extended;
+   
+begin
+  If GetData(@R) then 
+    Result:=FloatToStr(R)
+  else
+    Result:='';
+end;
+
+function TFloatField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(Extended);
+end;
+
+procedure TFloatField.GetText(var TheText: string; DisplayText: Boolean); 
+
+Var 
+    fmt : string;
+    E : Extended;
+    
+begin
+  text:='';
+  If Not GetData(@E) then exit;
+  If DisplayText or (Length(FEditFormat) = 0) Then
+    Fmt:=FDisplayFormat 
+  else
+    Fmt:=FEditFormat;
+{  // No formatfloat yet
+  If fmt<>'' then
+    TheText:=FormatFloat(fmt,E)
+  else
+}
+    Text:=FloatToStrF(E,ffgeneral,FPrecision,0);
+end;
+
+procedure TFloatField.SetAsFloat(AValue: Extended); 
+
+begin
+  If CheckRange(AValue) then
+    SetData(@Avalue)
+  else
+    RangeError(AValue,FMinValue,FMaxValue);
+end;
+
+procedure TFloatField.SetAsLongint(AValue: Longint); 
+
+begin
+  SetAsFloat(Avalue);
+end;
+
+procedure TFloatField.SetAsString(const AValue: string); 
+
+Var R : Extended;
+    Code : longint;
+
+begin
+  Val(AVAlue,R,Code);
+  If Code<>0 then
+    DatabaseErrorFmt(SNotAFloat,[AVAlue])
+  Else
+    SetAsFloat(R);
+end;
+
+constructor TFloatField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDatatype(ftfloat);
+end;
+
+Function TFloatField.CheckRange(AValue : Extended) : Boolean;
+
+begin
+  Result:=(AValue>=FMinValue) and (AVAlue<=FMAxValue);
+end;
+
+
+{ TBooleanField }
+
+function TBooleanField.GetAsBoolean: Boolean; 
+
+begin
+  If not GetData(@Result) then 
+    Result:=False;
+end;
+
+function TBooleanField.GetAsString: string; 
+
+Var B : boolean;
+
+begin
+  If Getdata(@B) then
+    Result:=FDisplays[False,B]
+  else
+    result:='';
+end;
+
+function TBooleanField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(Boolean);
+end;
+
+function TBooleanField.GetDefaultWidth: Longint; 
+
+begin
+  Result:=Length(FDisplays[false,false]);
+  If Result<Length(FDisplays[false,True]) then
+    Result:=Length(FDisplays[false,True]);
+end;
+
+procedure TBooleanField.SetAsBoolean(AValue: Boolean); 
+
+begin
+  SetData(@AValue);
+end;
+
+procedure TBooleanField.SetAsString(const AValue: string); 
+
+Var Temp : string;
+
+begin
+  Temp:=UpperCase(AValue);
+  If Temp=FDisplays[True,True] Then
+    SetAsBoolean(True)
+  else If Temp=FDisplays[True,False] then
+    SetAsBoolean(False)
+  else
+    DatabaseErrorFmt(SNotABoolean,[AValue]);
+end;
+
+constructor TBooleanField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  DisplayValues:='True;False';
+end;
+
+Procedure TBooleanField.SetDisplayValues(AValue : String);
+
+Var I : longint;
+
+begin
+  If FDisplayValues<>AValue then
+    begin
+    I:=Pos(';',AValue);
+    If (I<2) or (I=Length(AValue)) then
+      DatabaseErrorFmt(SInvalidDisplayValues,[AValue]);
+    FdisplayValues:=AValue;
+    // Store display values and their uppercase equivalents;
+    FDisplays[False,True]:=Copy(AValue,1,I-1);
+    FDisplays[True,True]:=UpperCase(FDisplays[False,True]);
+    FDisplays[False,False]:=Copy(AValue,I+1,Length(AValue)-i);
+    FDisplays[True,False]:=UpperCase(FDisplays[False,False]);
+    PropertyChanged(True);
+    end;
+end;
+
+{ TDateTimeField }
+
+
+function TDateTimeField.GetAsDateTime: TDateTime; 
+
+begin
+  If Not GetData(@Result) then
+    Result:=0;
+end;
+
+
+function TDateTimeField.GetAsFloat: Extended; 
+
+begin
+  Result:=GetAsdateTime;
+end;
+
+
+function TDateTimeField.GetAsString: string; 
+
+begin
+  GetText(Result,False);
+end;
+
+
+function TDateTimeField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(TDateTime);
+end;
+
+
+procedure TDateTimeField.GetText(var TheText: string; DisplayText: Boolean); 
+
+Var R : TDateTime;
+    F : String;
+
+begin
+  If Not Getdata(@R) then
+    TheText:=''
+  else
+    begin
+    If (DisplayText) and (Length(FDisplayFormat)<>0) then 
+      F:=FDisplayFormat
+    else
+      Case DataType of
+       ftTime : F:=ShortTimeFormat;
+       ftDate : F:=ShortDateFormat;
+      end;
+    TheText:=FormatDateTime(F,R);
+    end;
+end;
+
+
+procedure TDateTimeField.SetAsDateTime(AValue: TDateTime); 
+
+begin
+  SetData(@Avalue);
+end;
+
+
+procedure TDateTimeField.SetAsFloat(AValue: Extended); 
+
+begin
+  SetAsDateTime(AValue);
+end;
+
+
+procedure TDateTimeField.SetAsString(const AValue: string); 
+
+Var R : TDateTime;
+
+begin
+  R:=StrToDateTime(AVAlue);
+  SetData(@R);
+end;
+
+
+constructor TDateTimeField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftDateTime);
+end;
+
+{ TDateField }
+
+function TDateField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(TDateTime);
+end;
+
+
+constructor TDateField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftDate);
+end;
+
+
+
+{ TTimeField }
+
+function TTimeField.GetDataSize: Word; 
+
+begin
+  Result:=SizeOf(TDateTime);
+end;
+
+
+constructor TTimeField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftTime);
+end;
+
+
+
+{ TBinaryField }
+
+class procedure TBinaryField.CheckTypeSize(AValue: Longint); 
+
+begin
+  // Just check for really invalid stuff; actual size is 
+  // dependent on the record...
+  If AValue<1 then 
+    DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
+end;
+
+
+function TBinaryField.GetAsString: string; 
+
+begin
+  Setlength(Result,DataSize);
+  GetData(Pointer(Result));
+end;
+
+
+procedure TBinaryField.GetText(var TheText: string; DisplayText: Boolean); 
+
+begin
+  TheText:=GetAsString;
+end;
+
+
+procedure TBinaryField.SetAsString(const AValue: string); 
+
+Var Buf : PChar;
+    Allocated : Boolean;
+    
+begin
+  Allocated:=False;
+  If Length(AVAlue)=DataSize then
+    Buf:=PChar(Avalue)
+  else
+    begin
+    GetMem(Buf,DataSize);
+    Move(Pchar(Avalue)[0],Buf^,DataSize);
+    Allocated:=True;
+    end;
+  SetData(Buf);
+  If Allocated then
+    FreeMem(Buf,DataSize);
+end;
+
+
+procedure TBinaryField.SetText(const AValue: string); 
+
+begin
+  SetAsString(Avalue);
+end;
+
+
+constructor TBinaryField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+end;
+
+
+
+{ TBytesField }
+
+function TBytesField.GetDataSize: Word; 
+
+begin
+  Result:=Size;
+end;
+
+
+constructor TBytesField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftBytes);
+  Size:=16;
+end;
+
+
+
+{ TVarBytesField }
+
+function TVarBytesField.GetDataSize: Word; 
+
+begin
+  Result:=Size+2;
+end;
+
+
+constructor TVarBytesField.Create(AOwner: TComponent); 
+
+begin
+  INherited Create(AOwner);
+  SetDataType(ftvarbytes);
+  Size:=16;
+end;
+
+
+
+{ TBCDField }
+
+class procedure TBCDField.CheckTypeSize(AValue: Longint); 
+
+begin
+  //!! To be implemented
+end;
+
+
+function TBCDField.GetAsFloat: Extended; 
+
+begin
+  //!! To be implemented
+end;
+
+
+function TBCDField.GetAsLongint: Longint; 
+
+begin
+  //!! To be implemented
+end;
+
+
+function TBCDField.GetAsString: string; 
+
+begin
+  //!! To be implemented
+end;
+
+
+function TBCDField.GetDataSize: Word; 
+
+begin
+  //!! To be implemented
+end;
+
+
+function TBCDField.GetDefaultWidth: Longint; 
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TBCDField.GetText(var TheText: string; DisplayText: Boolean); 
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TBCDField.SetAsFloat(AValue: Extended); 
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TBCDField.SetAsLongint(AValue: Longint); 
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TBCDField.SetAsString(const AValue: string); 
+
+begin
+  //!! To be implemented
+end;
+
+
+constructor TBCDField.Create(AOwner: TComponent); 
+
+begin
+  DatabaseError('BCD fields not supported yet. Sorry !');
+end;
+
+
+
+{ TBlobField }
+
+
+procedure TBlobField.AssignTo(Dest: TPersistent); 
+
+begin
+  //!! To be implemented
+end;
+
+Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;
+
+begin
+  Result:=FDataset.CreateBlobStream(Self,Mode);
+end;
+
+procedure TBlobField.FreeBuffers; 
+
+begin
+end;
+
+
+function TBlobField.GetAsString: string; 
+
+begin
+  With GetBlobStream(bmRead) do
+    try
+      SetLength(Result,Size);
+      ReadBuffer(Pointer(Result)^,Size);
+    finally
+      Free
+    end;
+end;
+
+
+function TBlobField.GetBlobSize: Longint;
+
+begin
+  With GetBlobStream(bmread) do
+    try
+      Result:=Size;
+    finally
+      Free;
+    end;
+end;
+
+
+function TBlobField.GetIsNull: Boolean; 
+
+begin
+  If Not Modified then
+    result:= inherited GetIsnull
+  else
+    With GetBlobStream(bmread) do 
+      try
+        Result:=(Size=0);
+      Finally
+        Free;
+      end;
+end;
+
+
+procedure TBlobField.GetText(var TheText: string; DisplayText: Boolean); 
+
+begin
+  TheText:=GetAsString;
+end;
+
+
+procedure TBlobField.SetAsString(const AValue: string); 
+
+begin
+  With GetBlobStream(bmwrite) do
+    try
+      WriteBuffer(Pointer(Avalue)^,Length(Avalue));
+    finally
+      Free;
+    end;
+end;
+
+
+procedure TBlobField.SetText(const AValue: string); 
+
+begin
+  SetAsString(AValue);
+end;
+
+
+constructor TBlobField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOWner);
+  SetDataType(ftBlob);
+end;
+
+
+procedure TBlobField.Assign(Source: TPersistent); 
+
+begin
+  //!! To be implemented
+end;
+
+
+procedure TBlobField.Clear; 
+
+begin
+  GetBlobStream(bmWrite).free;
+end;
+
+
+class function TBlobField.IsBlob: Boolean; 
+
+begin
+  Result:=True;
+end;
+
+
+procedure TBlobField.LoadFromFile(const FileName: string);
+
+Var S : TFileStream;
+
+begin
+  S:=TFileStream.Create(FileName,fmOpenRead);
+  try
+    LoadFromStream(S);
+  finally
+    S.Free;
+  end;
+end;
+
+
+procedure TBlobField.LoadFromStream(Stream: TStream);
+
+begin
+  With GetBlobStream(bmWrite) do
+    Try
+      CopyFrom(Stream,0);
+    finally
+      Free;
+    end;
+end;
+
+
+procedure TBlobField.SaveToFile(const FileName: string);
+
+Var S : TFileStream;
+
+begin
+  S:=TFileStream.Create(FileName,fmCreate);
+  try
+    SaveToStream(S);
+  finally
+    S.Free;
+  end;
+end;
+
+
+procedure TBlobField.SaveToStream(Stream: TStream);
+
+Var S : TStream;
+
+begin
+  S:=GetBlobStream(bmRead);
+  Try
+    Stream.CopyFrom(S,0);
+  finally
+    S.Free;  
+  end;
+end;
+
+
+procedure TBlobField.SetFieldType(AValue: TFieldType); 
+
+begin
+  If AValue in [Low(TBlobType)..High(TBlobType)] then
+    SetDatatype(Avalue);
+end;
+
+
+
+{ TMemoField }
+
+constructor TMemoField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftMemo);
+end;
+
+
+{ TGraphicField }
+
+constructor TGraphicField.Create(AOwner: TComponent); 
+
+begin
+  Inherited Create(AOwner);
+  SetDataType(ftGraphic);
+end;
+
+
+{ TFields }
+
+Constructor TFields.Create(ADataset : TDataset);
+
+begin
+  FDataSet:=ADataset;
+  FFieldList:=TList.Create;
+  FValidFieldKinds:=[fkData..fkInternalcalc];
+end;
+
+Destructor TFields.Destroy;
+
+begin
+  FFieldList.Free;
+end;
+
+Procedure Tfields.Changed;
+
+begin
+  If Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+Procedure TFields.CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
+
+begin
+  If Not (FieldKind in ValidFieldKinds) Then
+    DatabaseErrorFmt(SInvalidFieldKind,[Field.FieldName]);
+end;
+
+Function Tfields.GetCount : Longint;
+
+begin
+  Result:=FFieldList.Count;
+end;
+
+
+Function TFields.GetField (Index : longint) : TField;
+
+begin
+  Result:=Tfield(FFieldList[Index]);
+end;
+
+Procedure TFields.SetFieldIndex (Field : TField;Value : Integer);
+
+Var Old : Longint;
+
+begin
+  Old := FFieldList.indexOf(Field);
+  If Old=-1 then
+    Exit;
+  // Check value
+  If Value<FFieldList.Count Then Value:=0;
+  If Value>=Count then Value:=Count-1;
+  If Value<>Old then
+    begin
+    FFieldList.Delete(Old);
+    FFieldList.Insert(Value,Field);
+    Field.PropertyChanged(True);
+    Changed;
+    end;
+end;
+
+Procedure TFields.Add(Field : TField);
+
+begin
+  CheckFieldName(Field.FieldName);
+  FFieldList.Add(Field);
+  Field.FFields:=Self;
+  Changed;
+end;
+
+Procedure TFields.CheckFieldName (Const Value : String);
+
+Var I : longint;
+    S : String;
+    
+begin
+  If FindField(Value)<>Nil then
+    begin
+    S:=UpperCase(Value);
+    For I:=0 To FFieldList.Count-1 do
+      If S=UpperCase(TField(FFieldList[i]).FieldName) Then
+        DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset);
+    end;
+end;
+
+Procedure TFields.CheckFieldNames (Const Value : String);
+
+
+Var I : longint;
+    S,T : String;
+begin
+  T:=Value;
+  Repeat
+    I:=Pos(T,';');
+    If I=0 Then I:=Length(T);
+    S:=Copy(T,1,I-1);
+    Delete(T,1,I);
+    // Will raise an error if no such field...
+    FieldByName(S);
+  Until (T='');
+end;
+
+Procedure TFields.Clear;
+
+begin
+end;
+
+Function TFields.FindField (Const Value : String) : TField;
+
+Var S : String;
+    I : longint;
+    
+begin
+  Result:=Nil;
+  S:=UpperCase(Value);
+  For I:=0 To FFieldList.Count-1 do
+    If S=UpperCase(TField(FFieldList[i]).FieldName) Then
+      Begin
+      Result:=TField(FFieldList[I]);
+      Exit;
+      end;
+end;
+
+Function TFields.FieldByName (Const Value : String) : TField;
+
+begin
+  Result:=FindField(Value);
+  If result=Nil then
+    DatabaseErrorFmt(SFieldNotFound,[Value],FDataset);
+end;
+
+Function TFields.FieldByNumber(FieldNo : Integer) : TField;
+
+Var i : Longint;
+
+begin
+  Result:=Nil;
+  For I:=0 to FFieldList.Count-1 do
+    If FieldNo=TField(FFieldList[I]).FieldNo then
+      begin
+      Result:=TField(FFieldList[i]);
+      Exit;
+      end;
+end;
+
+Procedure TFields.GetFieldNames (Values : TStrings);
+
+Var i : longint;
+
+begin
+  Values.Clear;
+  For I:=0 to FFieldList.Count-1 do
+    Values.Add(Tfield(FFieldList[I]).FieldName);
+end;
+
+Function TFields.IndexOf(Field : TField) : Longint;
+
+Var i : longint;
+
+begin
+  Result:=-1;
+  For I:=0 To FFieldList.Count-1 do
+    If Pointer(Field)=FFieldList[i] Then
+      Exit(I);
+end;
+
+procedure TFields.Remove(Value : TField);
+
+Var I : longint;
+
+begin
+  I:=IndexOf(Value);
+  If I<>0 then 
+    FFieldList.Delete(I); 
+end;
+

+ 166 - 0
fcl/db/mtest.pp

@@ -0,0 +1,166 @@
+program testds;
+
+uses db,sysutils,mysqldb;
+
+Procedure Log(Const Msg : String);
+begin
+  Writeln(Msg);
+end;
+
+Procedure DumpFieldDef(F : TfieldDef);
+
+begin
+  With F do
+    begin
+    Writeln ('Name              : ',Name); 
+    Writeln ('FieldNo           : ',FieldNo);
+    Writeln ('Size              : ',Size);
+    Writeln ('FieldClass        : ',FieldClass.ClassName); 
+    Writeln ('Required          : ',required);
+    Writeln ('Precision         : ',Precision); 
+    Writeln ('DataType          : ',FieldTypeNames[DataType]);
+    Writeln ('InternalCalcField : ',Internalcalcfield);
+    end;
+end;
+
+Procedure DumpField(F : Tfield);
+
+begin
+  With F do
+    begin
+    Writeln ('FieldName : ',FieldName); 
+    Writeln ('FieldNo   : ',FieldNo);
+    Writeln ('Index     : ',Index);
+    Writeln ('DataSize  : ',DataSize);
+    Writeln ('Size      : ',Size);
+    Writeln ('DataType  : ',FieldTypeNames[DataType]);
+    Writeln ('Class     : ',ClassName); 
+    Writeln ('Required  : ',required);
+    Writeln ('ReadOnly  : ',ReadOnly);
+    Writeln ('Visible   : ',Visible);
+    end;
+end;
+
+Procedure DumpFieldData (F : TField);
+
+begin
+  With F Do 
+    begin
+    Writeln ('Field     : ',FieldName);
+    Writeln ('Data type : ',FieldTypeNames[DataType]);
+    Writeln ('As String : ',Asstring);
+    Case Datatype of
+      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
+      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
+      ftFloat : Writeln ('As Float : ',AsFloat); 
+      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
+    end;
+    end;
+end;
+
+Var 
+  Data : TMysqldataset;
+  I,Count : longint;
+  Bookie : TBookMarkStr;
+  
+Procedure ScrollForward;
+
+begin
+  Writeln ('Browsing Forward:');
+  Writeln ('------------------');
+  With Data do
+    While NOT EOF do
+      begin
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Next;  
+      end;  
+end;
+
+Procedure ScrollBackWard;
+
+begin
+  Writeln ('Browsing Backward:');
+  Writeln ('-------------------');
+  With Data do
+    While NOT BOF do
+      begin
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Prior;
+      end;
+end;
+
+begin
+  if paramcount<>4 then
+    begin
+    Writeln ('Usage : mtest db user pwd sql');
+    Halt(1);
+    end;
+  Log ('Creating Dataset');
+  Data:=TMysqlDataset.Create(Nil);  
+  With Data do
+    begin
+    Log('Setting database');
+    Database:=Paramstr(1);
+    Log('Setting user');
+    User:=Paramstr(2);
+    Log('Setting password');
+    PassWord := Paramstr(3);
+    Log('Setting SQL');
+    SQL.text := Paramstr(4);
+    Log('Opening Dataset');
+    Open;
+    Log('Dumping fielddefs : ');
+    Writeln ('Fielddefs count : ',FieldDefs.Count);
+    For I:=0 to FieldDefs.Count-1 do
+      DumpFieldDef(FieldDefs.Items[i]);
+    Writeln ('Fields count : ',FieldCount);
+    For I:=0 to FieldCount-1 do
+      DumpField(Fields[i]);
+    ScrollForward;
+    ScrollBackWard;
+    Writeln ('Going to last :');
+    writeln ('---------------');
+    Last;
+    ScrollBackWard;
+    ScrollForward;
+    Writeln ('Going to first:');
+    First;
+    Count:=0;
+    Writeln ('Browsing Forward:');
+    Writeln ('------------------');
+    With Data do
+      While NOT EOF do
+        begin
+        Inc(Count);
+        If Count=recordCount div 2 then 
+          begin
+          Writeln ('Setting bookmark on record');
+          Bookie:=Bookmark;
+          Writeln ('Got data : "',Bookie,'"');
+          end;
+        For I:=0 to FieldCount-1 do
+          DumpFieldData(Fields[I]);
+        Next;  
+        end;
+    Writeln ('Jumping to bookmark',Bookie);
+    BookMark:=Bookie;
+    Writeln ('Dumping Record : ');
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+    Next;
+    Writeln ('Dumping Next Record : ');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[I]);
+    Prior;
+    Prior;
+    Writeln ('Dumping Previous Record : ');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[I]);
+    Log('Closing Dataset');
+    Close;
+    Log('End.');
+    Free;
+    end;    
+end.

+ 791 - 0
fcl/db/mysqldb.pp

@@ -0,0 +1,791 @@
+unit MySQLDB;
+
+{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, db, mysql,mysql_com;
+
+type
+  PMySQLDatasetBookmark = ^TMySQLDatasetBookmark;
+  TMySQLDatasetBookmark = record
+                          BookmarkData: Integer;
+                          BookmarkFlag: TBookmarkFlag;
+                          end;
+
+  Pinteger = ^Integer;
+  
+  TMySQLDataset = class(TDataSet)
+  private
+    FSQL: TStrings;
+    FDatabase: string;
+    FHost: string;
+    FPort: Integer;
+    FUser: string;
+    FPassword: string;
+
+    FRecordSize: Integer;
+    FBufferSize: Integer;
+
+    // MySQL data
+    FMYSQL: PMYSQL;
+    FMYSQLRES: PMYSQL_RES;
+
+    FCurrentRecord: Integer;              { Record pointer }
+
+    FServerInfo: string;
+    FHostInfo: string;
+
+    FAffectedRows: Integer;
+    FLastInsertID: Integer;
+    FLoadingFieldDefs: Boolean;
+
+    procedure DoOpen;
+    procedure DoClose;
+    procedure DoQuery;
+    procedure DoGetResult;
+
+    procedure CalculateSizes;
+    procedure LoadBufferFromData(Buffer: PChar);
+    function GetServerStatus: string;
+  protected
+    procedure SetDatabase(const Value: string);
+    procedure SetSQL(const Value: TStrings);
+    function GetClientInfo: string;
+
+    function InternalStrToFloat(S: string): Extended;
+    function InternalStrToDate(S: string): TDateTime;
+    function InternalStrToTime(S: string): TDateTime;
+    function InternalStrToDateTime(S: string): TDateTime;
+    function InternalStrToTimeStamp(S: string): TDateTime;
+
+    function MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
+         var NewType: TFieldType; var NewSize: Integer): Boolean;
+    function MySQLDataSize(AType: enum_field_types; ASize: Integer): Integer;
+    function MySQLWriteFieldData(AType: enum_field_types; ASize: Integer; Source: PChar;
+       Dest: PChar): Integer;
+
+
+    function GetCanModify: Boolean; override;
+    { Mandatory overrides }
+    // Record buffer methods:
+    function AllocRecordBuffer: PChar; override;
+    procedure FreeRecordBuffer(var Buffer: PChar); override;
+    procedure InternalInitRecord(Buffer: PChar); override;
+    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
+    function GetRecordSize: Word; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+    // Bookmark methods:
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+    procedure InternalGotoBookmark(ABookmark: Pointer); override;
+    procedure InternalSetToRecord(Buffer: PChar); override;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    // Navigational methods:
+    procedure InternalFirst; override;
+    procedure InternalLast; override;
+    // Editing methods:
+    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
+    procedure InternalDelete; override;
+    procedure InternalPost; override;
+    // Misc methods:
+    procedure InternalClose; override;
+    procedure InternalHandleException; override;
+    procedure InternalInitFieldDefs; override;
+    procedure InternalOpen; override;
+    function IsCursorOpen: Boolean; override;
+    { Optional overrides }
+    function GetRecordCount: Integer; override;
+    function GetRecNo: Integer; override;
+    procedure SetRecNo(Value: Integer); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    procedure ExecSQL;
+
+    // TDataset method
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+
+    property ServerInfo: string read FServerInfo;
+    property ClientInfo: string read GetClientInfo;
+    property HostInfo: string read FHostInfo;
+    property AffectedRows: Integer read FAffectedRows;
+    property LastInsertID: Integer read FLastInsertID;
+    property ServerStatus: string read GetServerStatus;
+  published
+    property Active;
+    property SQL: TStrings read FSQL write SetSQL;
+    property Database: string read FDatabase write SetDatabase;
+    property Host: string read FHost write FHost;
+    property Port: Integer read FPort write FPort;
+    property User: string read FUser write FUser;
+    property Password: string read FPassword write FPassword;
+
+    property BeforeOpen;
+    property AfterOpen;
+    property BeforeClose;
+    property AfterClose;
+    property BeforeInsert;
+    property AfterInsert;
+    property BeforeEdit;
+    property AfterEdit;
+    property BeforePost;
+    property AfterPost;
+    property BeforeCancel;
+    property AfterCancel;
+    property BeforeDelete;
+    property AfterDelete;
+    property BeforeScroll;
+    property AfterScroll;
+    property OnDeleteError;
+    property OnEditError;
+  end;
+
+implementation
+
+{ TMySQLDataset }
+
+constructor TMySQLDataset.Create(AOwner: TComponent);
+begin
+     inherited Create(AOwner);
+     FSQL := TStringList.Create;
+     FHost := '';
+     FPort := 0;
+     FUser := '';
+     FPassword := '';
+
+     FBufferSize := 0;
+     FRecordSize := 0;
+     FCurrentRecord := -1;
+     FLoadingFieldDefs := False;
+
+     FAffectedRows := 0;
+     FLastInsertID := -1;
+
+     FMYSQL := nil;
+     FMYSQLRES := nil;
+end;
+
+destructor TMySQLDataset.Destroy;
+begin
+     FSQL.Free;
+     inherited destroy;
+end;
+
+function TMySQLDataset.AllocRecordBuffer: PChar;
+begin
+     Result := AllocMem(FBufferSize);
+end;
+
+procedure TMySQLDataset.FreeRecordBuffer(var Buffer: PChar);
+begin
+     FreeMem(Buffer);
+end;
+
+procedure TMySQLDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+     PInteger(Data)^ := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
+end;
+
+function TMySQLDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
+begin
+     Result := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag;
+end;
+
+function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
+var
+  I, FC: Integer;
+  fld: TMYSQL_FIELD;
+  CurBuf: PChar;
+begin
+     Result := False;
+
+     CurBuf := ActiveBuffer;
+     
+     FC := mysql_num_fields(FMYSQLRES);
+     for I := 0 to FC-1 do
+     begin
+          fld := mysql_fetch_field_direct(FMYSQLRES, I);
+
+          //if Field.FieldNo = I+1 then
+          if Field.FieldName = fld.name then
+          begin
+               Move(CurBuf^, PChar(Buffer)^, MySQLDataSize(fld.ftype, fld.length));
+
+               if Field.DataType in [ftString{, ftWideString}] then
+                  Result := PChar(buffer)^ <> #0
+               else
+                   Result := True;
+               break; 
+          end
+          else
+              Inc(CurBuf, MySQLDataSize(fld.ftype, fld.length));
+     end;
+end;
+
+function TMySQLDataset.GetRecNo: Integer;
+begin
+     UpdateCursorPos;
+     if (FCurrentRecord = -1) and (RecordCount > 0) then
+        Result := 1
+     else
+         Result := FCurrentRecord + 1;
+end;
+
+function TMySQLDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
+  DoCheck: Boolean): TGetResult;
+begin
+     if RecordCount < 1 then
+        Result := grEOF
+     else
+     begin
+          Result := grOk;
+          case GetMode of
+            gmPrior:
+              if FCurrentRecord <= 0 then
+              begin
+                   Result := grBOF;
+                   FCurrentRecord := -1;
+              end
+              else
+                  Dec(FCurrentRecord);
+            gmCurrent:
+              if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
+                 Result := grError;
+            gmNext:
+              if FCurrentRecord >= RecordCount-1 then
+                 Result := grEOF
+              else
+                  Inc(FCurrentRecord);
+          end;
+
+          if Result = grOK then
+          begin
+               LoadBufferFromData(Buffer);
+               with PMySQLDatasetBookmark(Buffer + FRecordSize)^ do
+               begin
+                    BookmarkData := FCurrentRecord;
+                    BookmarkFlag := bfCurrent;
+               end;               
+          end
+          else
+              if (Result = grError) and (DoCheck) then
+                 DatabaseError('No record');
+     end;
+end;
+
+function TMySQLDataset.GetRecordCount: Integer;
+begin
+     Result := mysql_num_rows(FMYSQLRES);
+end;
+
+function TMySQLDataset.GetRecordSize: Word;
+begin
+     Result := FRecordSize;
+end;
+
+procedure TMySQLDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
+begin
+
+end;
+
+procedure TMySQLDataset.InternalClose;
+begin
+     FCurrentRecord := -1;
+
+     DoClose;
+    
+     if DefaultFields then
+        DestroyFields;
+end;
+
+procedure TMySQLDataset.InternalDelete;
+begin
+
+end;
+
+procedure TMySQLDataset.InternalFirst;
+begin
+     FCurrentRecord := -1;
+end;
+
+procedure TMySQLDataset.InternalGotoBookmark(ABookmark: Pointer);
+begin
+     FCurrentRecord := PInteger(ABookmark)^;
+end;
+
+procedure TMySQLDataset.InternalHandleException;
+begin
+//     Application.HandleException(self);
+end;
+
+procedure TMySQLDataset.InternalInitFieldDefs;
+var
+  I, FC: Integer;
+  field: TMYSQL_FIELD;
+  DFT: TFieldType;
+  DFS: Integer;
+  WasClosed: Boolean;
+begin
+     if FLoadingFieldDefs then Exit;
+
+     FLoadingFieldDefs := True;
+     try
+        WasClosed := not IsCursorOpen;
+        if WasClosed then
+        begin
+             DoOpen;
+             DoQuery;
+             DoGetResult;
+        end;
+        try
+           FieldDefs.Clear;
+           FC := mysql_num_fields(FMYSQLRES);
+           for I := 0 to FC-1 do
+           begin
+                field := mysql_fetch_field_direct(FMYSQLRES, I);
+                if MySQLFieldToFieldType(field.ftype, field.length, DFT, DFS) then
+                   TFieldDef.Create(FieldDefs, field.name, DFT, DFS, False, I+1);
+           end;
+        finally
+           if WasClosed then
+           begin
+                DoClose;
+           end;
+        end;
+     finally
+        FLoadingFieldDefs := False;
+     end;
+end;
+
+procedure TMySQLDataset.InternalInitRecord(Buffer: PChar);
+begin
+     FillChar(Buffer^, FBufferSize, 0);
+end;
+
+procedure TMySQLDataset.InternalLast;
+begin
+     FCurrentRecord := RecordCount;
+end;
+
+procedure TMySQLDataset.InternalOpen;
+begin
+     FMYSQL := nil;
+     FMYSQLRES := nil;
+     try
+        DoOpen;
+        DoQuery;
+        DoGetResult;
+
+        FCurrentRecord := -1;
+
+        InternalInitFieldDefs;
+
+        if DefaultFields then
+           CreateFields;
+        CalculateSizes;
+
+        BindFields(True);
+     except
+        DoClose;
+        FMYSQL := nil;
+        FMYSQLRES := nil;
+        raise;
+     end;
+     FServerInfo := mysql_get_server_info(FMYSQL);
+     FHostInfo := mysql_get_host_info(FMYSQL);
+     BookMarkSize:=SizeOf(Longint);
+end;
+
+procedure TMySQLDataset.InternalSetToRecord(Buffer: PChar);
+begin
+     FCurrentRecord := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
+end;
+
+function TMySQLDataset.IsCursorOpen: Boolean;
+begin
+     Result := FMYSQL <> nil;
+end;
+
+procedure TMySQLDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+     PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
+end;
+
+procedure TMySQLDataset.SetBookmarkFlag(Buffer: PChar;
+  Value: TBookmarkFlag);
+begin
+     PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
+end;
+
+procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer);
+begin
+
+end;
+
+procedure TMySQLDataset.SetRecNo(Value: Integer);
+begin
+     if (Value >= 0) and (Value <= RecordCount-1) then
+     begin
+          FCurrentRecord := Value-1;
+          Resync([]);
+     end;
+end;
+
+procedure TMySQLDataset.SetSQL(const Value: TStrings);
+begin
+     FSQL.Assign(Value);
+     FieldDefs.Clear;
+end;
+
+procedure TMySQLDataset.ExecSQL;
+begin
+     try
+        DoOpen;
+        try
+           DoQuery;
+        finally
+           DoClose;
+        end;
+     finally
+        FMYSQLRES := nil;
+        FMYSQL := nil;
+     end;
+end;
+
+procedure TMySQLDataset.SetDatabase(const Value: string);
+begin
+     FDatabase := Value;
+end;
+
+procedure TMySQLDataset.InternalPost;
+begin
+
+end;
+
+function TMySQLDataset.GetClientInfo: string;
+begin
+     Result := mysql_get_client_info;
+end;
+
+function TMySQLDataset.MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
+   var NewType: TFieldType; var NewSize: Integer): Boolean;
+begin
+     Result := True;
+     case AType of
+       FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
+       FIELD_TYPE_INT24:
+         begin
+              NewType := ftInteger;
+              NewSize := 0;
+         end;
+       FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
+         begin
+              NewType := ftFloat;
+              NewSize := 0;
+         end;
+       FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
+         begin
+              NewType := ftDateTime;
+              NewSize := 0;
+         end;
+       FIELD_TYPE_DATE:
+         begin
+              NewType := ftDate;
+              NewSize := 0;
+         end;
+       FIELD_TYPE_TIME:
+         begin
+              NewType := ftTime;
+              NewSize := 0;
+         end;
+       FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
+         begin
+              NewType := ftString;
+              NewSize := ASize;
+         end;
+     else
+       Result := False;
+     end;
+end;
+
+procedure TMySQLDataset.CalculateSizes;
+var
+  I, FC: Integer;
+  field: TMYSQL_FIELD;
+begin
+     FRecordSize := 0;
+     FC := mysql_num_fields(FMYSQLRES);
+     for I := 0 to FC-1 do
+     begin
+          field := mysql_fetch_field_direct(FMYSQLRES, I);
+          FRecordSize := FRecordSize + MySQLDataSize(field.ftype, field.length);
+     end;
+     FBufferSize := FRecordSize + SizeOf(TMySQLDatasetBookmark);
+end;
+
+procedure TMySQLDataset.LoadBufferFromData(Buffer: PChar);
+var
+  I, FC, CT: Integer;
+  field: TMYSQL_FIELD;
+  row: TMYSQL_ROW;
+begin
+     mysql_data_seek(FMYSQLRES, FCurrentRecord);
+
+     row := mysql_fetch_row(FMYSQLRES);
+     if row = nil then
+        DatabaseError(mysql_error(FMYSQL));
+
+     FC := mysql_num_fields(FMYSQLRES);
+     for I := 0 to FC-1 do
+     begin
+          field := mysql_fetch_field_direct(FMYSQLRES, I);
+          CT := MySQLWriteFieldData(field.ftype, field.length, row^, Buffer);
+          Inc(Buffer, CT);
+          Inc(row); 
+     end;
+end;
+
+
+function TMySQLDataset.MySQLDataSize(AType: enum_field_types;
+  ASize: Integer): Integer;
+begin
+     Result := 0;
+     case AType of
+       FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
+       FIELD_TYPE_INT24:
+         begin
+              Result := SizeOf(Integer);
+         end;
+       FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
+         begin
+              Result := SizeOf(Double);
+         end;
+       FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATE, FIELD_TYPE_TIME, FIELD_TYPE_DATETIME:
+         begin
+              Result := SizeOf(TDateTime);
+         end;
+       FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
+         begin
+              Result := ASize;
+         end;
+     end;
+end;
+
+function TMySQLDataset.MySQLWriteFieldData(AType: enum_field_types;
+  ASize: Integer; Source, Dest: PChar): Integer;
+var
+  VI: Integer;
+  VF: Double;
+  VD: TDateTime;  
+begin
+     Result := 0;
+     case AType of
+       FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
+       FIELD_TYPE_INT24:
+         begin
+              Result := SizeOf(Integer);
+              if Source <> '' then
+                 VI := StrToInt(Source)
+              else
+                  VI := 0;
+              Move(VI, Dest^, Result);              
+         end;
+       FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
+         begin
+              Result := SizeOf(Double);
+              if Source <> '' then
+                 VF := InternalStrToFloat(Source)
+              else
+                  VF := 0;
+              Move(VF, Dest^, Result);
+         end;
+       FIELD_TYPE_TIMESTAMP:
+         begin
+              Result := SizeOf(TDateTime);
+              if Source <> '' then
+                 VD := InternalStrToTimeStamp(Source)
+              else
+                  VD := 0;
+              Move(VD, Dest^, Result);
+         end;
+       FIELD_TYPE_DATETIME:
+         begin
+              Result := SizeOf(TDateTime);
+              if Source <> '' then
+                 VD := InternalStrToDateTime(Source)
+              else
+                  VD := 0;
+              Move(VD, Dest^, Result);
+         end;
+       FIELD_TYPE_DATE:
+         begin
+              Result := SizeOf(TDateTime);
+              if Source <> '' then
+                 VD := InternalStrToDate(Source)
+              else
+                  VD := 0;
+              Move(VD, Dest^, Result);
+         end;
+       FIELD_TYPE_TIME:
+         begin
+              Result := SizeOf(TDateTime);
+              if Source <> '' then
+                 VD := InternalStrToTime(Source)
+              else
+                  VD := 0;
+              Move(VD, Dest^, Result);
+         end;
+       FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
+         begin
+              Result := ASize;
+              if Source <> '' then
+                 Move(Source^, Dest^, Result)
+              else
+                  Dest^ := #0;
+         end;
+     end;
+end;
+
+function TMySQLDataset.InternalStrToFloat(S: string): Extended;
+var
+  I: Integer;
+  Tmp: string;
+begin
+     Tmp := '';
+
+     for I := 1 to Length(S) do
+     begin
+          if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
+             Tmp := Tmp + DecimalSeparator
+          else
+              Tmp := Tmp + S[I];
+     end;
+     Result := StrToFloat(Tmp);
+end;
+
+function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
+var
+  EY, EM, ED: Word;
+begin
+     EY := StrToInt(Copy(S, 1, 4));
+     EM := StrToInt(Copy(S, 6, 2));
+     ED := StrToInt(Copy(S, 9, 2));
+     if (EY = 0) or (EM = 0) or (ED = 0) then
+        Result := 0
+     else
+         Result := EncodeDate(EY, EM, ED);
+end;
+
+function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
+var
+  EY, EM, ED: Word;
+  EH, EN, ES: Word;
+begin
+     EY := StrToInt(Copy(S, 1, 4));
+     EM := StrToInt(Copy(S, 6, 2));
+     ED := StrToInt(Copy(S, 9, 2));
+
+     EH := StrToInt(Copy(S, 11, 2));
+     EN := StrToInt(Copy(S, 14, 2));
+     ES := StrToInt(Copy(S, 17, 2));
+
+     if (EY = 0) or (EM = 0) or (ED = 0) then
+        Result := 0
+     else
+         Result := EncodeDate(EY, EM, ED);
+
+     Result := Result + EncodeTime(EH, EN, ES, 0);
+end;
+
+function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
+var
+  EH, EM, ES: Word;
+begin
+     EH := StrToInt(Copy(S, 1, 2));
+     EM := StrToInt(Copy(S, 4, 2));
+     ES := StrToInt(Copy(S, 7, 2));
+     Result := EncodeTime(EH, EM, ES, 0);
+end;
+
+function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
+var
+  EY, EM, ED: Word;
+  EH, EN, ES: Word;
+begin
+     EY := StrToInt(Copy(S, 1, 4));
+     EM := StrToInt(Copy(S, 5, 2));
+     ED := StrToInt(Copy(S, 7, 2));
+
+     EH := StrToInt(Copy(S, 9, 2));
+     EN := StrToInt(Copy(S, 11, 2));
+     ES := StrToInt(Copy(S, 13, 2));
+
+     if (EY = 0) or (EM = 0) or (ED = 0) then
+        Result := 0
+     else
+         Result := EncodeDate(EY, EM, ED);
+
+     Result := Result + EncodeTime(EH, EN, ES, 0);;
+end;
+
+procedure TMySQLDataset.DoClose;
+begin
+     try
+        if FMYSQLRES <> nil then
+           mysql_free_result(FMYSQLRES);
+        if FMYSQL <> nil then
+           mysql_close(FMYSQL);
+     finally
+        FMYSQLRES := nil;
+        FMYSQL := nil;
+     end;
+end;
+
+procedure TMySQLDataset.DoOpen;
+begin
+     FMYSQL := mysql_connect(nil, PChar(FHost), PChar(FUser), PChar(FPassword));
+     if FMYSQL = nil then
+        DatabaseError('Error connecting to MySQL server');
+
+     if FDatabase <> '' then
+        if mysql_select_db(FMYSQL, PChar(FDatabase)) <> 0 then
+           DatabaseError(mysql_error(FMYSQL));
+end;
+
+procedure TMySQLDataset.DoQuery;
+var
+  Query: string;
+begin
+     Query := FSQL.GetText;
+     if mysql_query(FMYSQL, PChar(Query)) <> 0 then
+        DatabaseError(mysql_error(FMYSQL));
+
+     FAffectedRows := mysql_affected_rows(FMYSQL);
+     FLastInsertID := mysql_insert_id(FMYSQL);
+end;
+
+function TMySQLDataset.GetCanModify: Boolean;
+begin
+     Result := False;
+end;
+
+procedure TMySQLDataset.DoGetResult;
+begin
+     FMYSQLRES := mysql_store_result(FMYSQL);
+     if FMYSQLRES = nil then
+        DatabaseError(mysql_error(FMYSQL));
+
+     FAffectedRows := mysql_affected_rows(FMYSQL);
+end;
+
+function TMySQLDataset.GetServerStatus: string;
+begin
+     CheckActive;
+     Result := mysql_stat(FMYSQL);
+end;
+
+end.

+ 160 - 0
fcl/db/testds.pp

@@ -0,0 +1,160 @@
+program testds;
+
+uses db,ddg_ds,sysutils;
+
+Procedure Log(Const Msg : String);
+begin
+  Writeln(Msg);
+end;
+
+Procedure DumpFieldDef(F : TfieldDef);
+
+begin
+  With F do
+    begin
+    Writeln ('Name              : ',Name); 
+    Writeln ('FieldNo           : ',FieldNo);
+    Writeln ('Size              : ',Size);
+    Writeln ('FieldClass        : ',FieldClass.ClassName); 
+    Writeln ('Required          : ',required);
+    Writeln ('Precision         : ',Precision); 
+    Writeln ('DataType          : ',FieldTypeNames[DataType]);
+    Writeln ('InternalCalcField : ',Internalcalcfield);
+    end;
+end;
+
+Procedure DumpField(F : Tfield);
+
+begin
+  With F do
+    begin
+    Writeln ('FieldName : ',FieldName); 
+    Writeln ('FieldNo   : ',FieldNo);
+    Writeln ('Index     : ',Index);
+    Writeln ('DataSize  : ',DataSize);
+    Writeln ('Size      : ',Size);
+    Writeln ('DataType  : ',FieldTypeNames[DataType]);
+    Writeln ('Class     : ',ClassName); 
+    Writeln ('Required  : ',required);
+    Writeln ('ReadOnly  : ',ReadOnly);
+    Writeln ('Visible   : ',Visible);
+    end;
+end;
+
+Procedure DumpFieldData (F : TField);
+
+begin
+  With F Do 
+    begin
+    Writeln ('Field     : ',FieldName);
+    Writeln ('Data type : ',FieldTypeNames[DataType]);
+    Writeln ('As String : ',Asstring);
+    Case Datatype of
+      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
+      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
+      ftFloat : Writeln ('As Float : ',AsFloat); 
+      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
+    end;
+    end;
+end;
+
+Var 
+  Data : TDDGdataset;
+  I,Count : longint;
+  Bookie : TBookMarkStr;
+  
+Procedure ScrollForward;
+
+begin
+  Writeln ('Browsing Forward:');
+  Writeln ('------------------');
+  With Data do
+    While NOT EOF do
+      begin
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Next;  
+      end;  
+end;
+
+Procedure ScrollBackWard;
+
+begin
+  Writeln ('Browsing Backward:');
+  Writeln ('-------------------');
+  With Data do
+    While NOT BOF do
+      begin
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Prior;
+      end;
+end;
+
+begin
+  if paramcount<>1 then
+    begin
+    Writeln ('Usage : testds tablename');
+    Halt(1);
+    end;
+  Log ('Creating Dataset');
+  Data:=TDDGDataset.Create(Nil);  
+  With Data do
+    begin
+    Log('Setting Tablename');
+    TableName:=Paramstr(1);
+    Log('Opening Dataset');
+    Open;
+    Log('Dumping fielddefs : ');
+    Writeln ('Fielddefs count : ',FieldDefs.Count);
+    For I:=0 to FieldDefs.Count-1 do
+      DumpFieldDef(FieldDefs.Items[i]);
+    Writeln ('Fields count : ',FieldCount);
+    For I:=0 to FieldCount-1 do
+      DumpField(Fields[i]);
+    ScrollForward;
+    ScrollBackWard;
+    Writeln ('Going to last :');
+    writeln ('---------------');
+    Last;
+    ScrollBackWard;
+    ScrollForward;
+    Writeln ('Going to first:');
+    First;
+    Count:=0;
+    Writeln ('Browsing Forward:');
+    Writeln ('------------------');
+    With Data do
+      While NOT EOF do
+        begin
+        Inc(Count);
+        If Count=50 then 
+          begin
+          Writeln ('Setting bookmark on record');
+          Bookie:=Bookmark;
+          Writeln ('Got data : "',Bookie,'"');
+          end;
+        For I:=0 to FieldCount-1 do
+          DumpFieldData(Fields[I]);
+        Next;  
+        end;
+    Writeln ('Jumping to bookmark',Bookie);
+    BookMark:=Bookie;
+    Writeln ('Dumping Record : ');
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+    Next;
+    Writeln ('Dumping Next Record : ');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[I]);
+    Prior;
+    Prior;
+    Writeln ('Dumping Previous Record : ');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[I]);
+    Log('Closing Dataset');
+    Close;
+    Log('End.');
+    Free;
+    end;    
+end.