+ Initial TBufDataset by Joost van der Sluis

fcl/db/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/07/18]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2004/08/31]
 #
 default: all
 MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom morphos
@@ -214,7 +214,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=fcl
-override TARGET_DIRS+=sdf memds
+override TARGET_DIRS+=sdf memds sqldb
 ifeq ($(OS_TARGET),linux)
 override TARGET_DIRS+=mysql interbase sqlite dbase
 endif
@@ -970,212 +970,227 @@ override REQUIRE_PACKAGES=rtl
 ifeq ($(OS_TARGET),linux)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),linux)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),linux)
 ifeq ($(CPU_TARGET),powerpc)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),linux)
 ifeq ($(CPU_TARGET),sparc)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),linux)
 ifeq ($(CPU_TARGET),x86_64)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),linux)
 ifeq ($(CPU_TARGET),arm)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),go32v2)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),win32)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),os2)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),freebsd)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),freebsd)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),freebsd)
 ifeq ($(CPU_TARGET),x86_64)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),beos)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),netbsd)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),netbsd)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),netbsd)
 ifeq ($(CPU_TARGET),powerpc)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),netbsd)
 ifeq ($(CPU_TARGET),sparc)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),amiga)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),atari)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),sunos)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),sunos)
 ifeq ($(CPU_TARGET),sparc)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),qnx)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),netware)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),openbsd)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),openbsd)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),wdosx)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),palmos)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),macos)
 ifeq ($(CPU_TARGET),powerpc)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),darwin)
 ifeq ($(CPU_TARGET),powerpc)
 REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_IBASE=1
+REQUIRE_PACKAGES_MYSQL=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
 endif
 ifeq ($(OS_TARGET),emx)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),watcom)
 ifeq ($(CPU_TARGET),i386)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifeq ($(OS_TARGET),morphos)
 ifeq ($(CPU_TARGET),powerpc)
 REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_IBASE=1
 endif
 endif
 ifdef REQUIRE_PACKAGES_RTL
@@ -1204,32 +1219,6 @@ ifdef UNITDIR_RTL
 override COMPILER_UNITDIR+=$(UNITDIR_RTL)
 endif
 endif
-ifdef REQUIRE_PACKAGES_MYSQL
-PACKAGEDIR_MYSQL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /mysql/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_MYSQL),)
-ifneq ($(wildcard $(PACKAGEDIR_MYSQL)/$(OS_TARGET)),)
-UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)/$(OS_TARGET)
-else
-UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)
-endif
-ifdef CHECKDEPEND
-$(PACKAGEDIR_MYSQL)/$(FPCMADE):
-	$(MAKE) -C $(PACKAGEDIR_MYSQL) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_MYSQL)/$(FPCMADE)
-endif
-else
-PACKAGEDIR_MYSQL=
-UNITDIR_MYSQL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /mysql/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_MYSQL),)
-UNITDIR_MYSQL:=$(firstword $(UNITDIR_MYSQL))
-else
-UNITDIR_MYSQL=
-endif
-endif
-ifdef UNITDIR_MYSQL
-override COMPILER_UNITDIR+=$(UNITDIR_MYSQL)
-endif
-endif
 ifdef REQUIRE_PACKAGES_IBASE
 PACKAGEDIR_IBASE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /ibase/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_IBASE),)
@@ -1256,6 +1245,32 @@ ifdef UNITDIR_IBASE
 override COMPILER_UNITDIR+=$(UNITDIR_IBASE)
 endif
 endif
+ifdef REQUIRE_PACKAGES_MYSQL
+PACKAGEDIR_MYSQL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /mysql/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_MYSQL),)
+ifneq ($(wildcard $(PACKAGEDIR_MYSQL)/$(OS_TARGET)),)
+UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)/$(OS_TARGET)
+else
+UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_MYSQL)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_MYSQL) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_MYSQL)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_MYSQL=
+UNITDIR_MYSQL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /mysql/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_MYSQL),)
+UNITDIR_MYSQL:=$(firstword $(UNITDIR_MYSQL))
+else
+UNITDIR_MYSQL=
+endif
+endif
+ifdef UNITDIR_MYSQL
+override COMPILER_UNITDIR+=$(UNITDIR_MYSQL)
+endif
+endif
 ifdef REQUIRE_PACKAGES_SQLITE
 PACKAGEDIR_SQLITE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /sqlite/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_SQLITE),)
@@ -1433,7 +1448,7 @@ endif
 .PHONY: fpc_examples
 ifneq ($(TARGET_EXAMPLES),)
 HASEXAMPLES=1
-override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .lpr,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))
 override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
 override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
 override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
@@ -1458,7 +1473,7 @@ fpc_debug:
 	$(MAKE) all DEBUG=1
 fpc_release:
 	$(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .dpr .pp .rc .res
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
 %$(PPUEXT): %.pp
 	$(COMPILER) $<
 	$(EXECPPAS)
@@ -1471,6 +1486,9 @@ fpc_release:
 %$(EXEEXT): %.pas
 	$(COMPILER) $<
 	$(EXECPPAS)
+%$(EXEEXT): %.lpr
+	$(COMPILER) $<
+	$(EXECPPAS)
 %$(EXEEXT): %.dpr
 	$(COMPILER) $<
 	$(EXECPPAS)
@@ -1478,6 +1496,7 @@ fpc_release:
 	windres -i $< -o $@
 vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
 .PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
@@ -1704,6 +1723,7 @@ fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
 fpc_makefiles: fpc_makefile fpc_makefile_dirs
 TARGET_DIRS_SDF=1
 TARGET_DIRS_MEMDS=1
+TARGET_DIRS_SQLDB=1
 ifeq ($(OS_TARGET),linux)
 TARGET_DIRS_MYSQL=1
 TARGET_DIRS_INTERBASE=1
@@ -1823,6 +1843,49 @@ memds:
 	$(MAKE) -C memds all
 .PHONY: memds_all memds_debug memds_smart memds_release memds_examples memds_shared memds_install memds_sourceinstall memds_exampleinstall memds_distinstall memds_zipinstall memds_zipsourceinstall memds_zipexampleinstall memds_zipdistinstall memds_clean memds_distclean memds_cleanall memds_info memds_makefiles memds
 endif
+ifdef TARGET_DIRS_SQLDB
+sqldb_all:
+	$(MAKE) -C sqldb all
+sqldb_debug:
+	$(MAKE) -C sqldb debug
+sqldb_smart:
+	$(MAKE) -C sqldb smart
+sqldb_release:
+	$(MAKE) -C sqldb release
+sqldb_examples:
+	$(MAKE) -C sqldb examples
+sqldb_shared:
+	$(MAKE) -C sqldb shared
+sqldb_install:
+	$(MAKE) -C sqldb install
+sqldb_sourceinstall:
+	$(MAKE) -C sqldb sourceinstall
+sqldb_exampleinstall:
+	$(MAKE) -C sqldb exampleinstall
+sqldb_distinstall:
+	$(MAKE) -C sqldb distinstall
+sqldb_zipinstall:
+	$(MAKE) -C sqldb zipinstall
+sqldb_zipsourceinstall:
+	$(MAKE) -C sqldb zipsourceinstall
+sqldb_zipexampleinstall:
+	$(MAKE) -C sqldb zipexampleinstall
+sqldb_zipdistinstall:
+	$(MAKE) -C sqldb zipdistinstall
+sqldb_clean:
+	$(MAKE) -C sqldb clean
+sqldb_distclean:
+	$(MAKE) -C sqldb distclean
+sqldb_cleanall:
+	$(MAKE) -C sqldb cleanall
+sqldb_info:
+	$(MAKE) -C sqldb info
+sqldb_makefiles:
+	$(MAKE) -C sqldb makefiles
+sqldb:
+	$(MAKE) -C sqldb all
+.PHONY: sqldb_all sqldb_debug sqldb_smart sqldb_release sqldb_examples sqldb_shared sqldb_install sqldb_sourceinstall sqldb_exampleinstall sqldb_distinstall sqldb_zipinstall sqldb_zipsourceinstall sqldb_zipexampleinstall sqldb_zipdistinstall sqldb_clean sqldb_distclean sqldb_cleanall sqldb_info sqldb_makefiles sqldb
+endif
 ifdef TARGET_DIRS_MYSQL
 mysql_all:
 	$(MAKE) -C mysql all

fcl/db/Makefile.fpc

@@ -6,7 +6,7 @@
 main=fcl
 
 [target]
-dirs=sdf memds
+dirs=sdf memds sqldb
 # dirs_i386=dbase
 dirs_linux=mysql interbase sqlite dbase
 dirs_freebsd=mysql interbase sqlite dbase

fcl/db/bufdataset.inc

@@ -0,0 +1,201 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    BufDataset implementation
+
+    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.
+
+ **********************************************************************}
+{ ---------------------------------------------------------------------
+    TBufDataSet
+  ---------------------------------------------------------------------}
+
+constructor TBufDataset.Create(AOwner : TComponent);
+
+begin
+  Inherited Create(AOwner);
+// temporary set it here
+  FPacketRecords := 10;
+end;
+
+destructor TBufDataset.Destroy;
+
+begin
+  inherited destroy;
+end;
+
+function TBufDataset.AllocRecordBuffer: PChar;
+
+begin
+  result := AllocRecord;
+  ReAllocMem(result,RecordSize+sizeof(TBufBookmark));
+end;
+
+procedure TBufDataset.FreeRecordBuffer(var Buffer: PChar);
+begin
+  FreeMem(Buffer);
+end;
+
+procedure TBufDataset.InternalOpen;
+
+begin
+  FBRecordcount := 0;
+  FBBuffercount := 0;
+  FBCurrentrecord := -1;
+  FIsEOF := false;
+  FIsbOF := true;
+end;
+
+procedure TBufDataset.InternalClose;
+
+var i : integer;
+
+begin
+  for i := 0 to FBRecordCount-1 do FreeRecord(FBBuffers[i]);
+  freemem(FBBuffers);
+  FBRecordcount := 0;
+  FBBuffercount := 0;
+  FBCurrentrecord := -1;
+  FIsEOF := true;
+  FIsbOF := true;
+end;
+
+procedure TBufDataset.InternalFirst;
+begin
+  FBCurrentRecord := -1;
+  FIsEOF := false;
+end;
+
+procedure TBufDataset.InternalLast;
+begin
+  repeat
+  until getnextpacket < FPacketRecords;
+  FIsBOF := false;
+  FBCurrentRecord := FBRecordcount;
+end;
+
+function TBufDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
+begin
+  if FIsEOF then
+    Result := grEOF
+  else begin
+    Result := grOK;
+    case GetMode of
+      gmPrior :
+        if FBCurrentRecord <= 0 then
+          begin
+          Result := grBOF;
+          FBCurrentRecord := -1;
+          end
+        else
+          begin
+          Dec(FBCurrentRecord);
+          FIsEof := false;
+          end;
+      gmCurrent :
+        if (FBCurrentRecord < 0) or (FBCurrentRecord >= RecordCount) then
+          Result := grError;
+      gmNext :
+        if FBCurrentRecord >= (FBRecordCount - 1) then
+          begin
+          if getnextpacket > 0 then
+            begin
+            Inc(FBCurrentRecord);
+            FIsBof := false;
+            end
+          else
+            begin
+            FIsEOF := true;
+            result:=grEOF;
+            end
+          end
+        else
+          begin
+          Inc(FBCurrentRecord);
+          FIsBof := false;
+          end;
+    end;
+  end;
+
+  if Result = grOK then
+    begin
+    with PBufBookmark(Buffer + RecordSize)^ do
+      begin
+      BookmarkData := FBCurrentRecord;
+      BookmarkFlag := bfCurrent;
+      end;
+      move(FBBuffers[FBCurrentRecord]^,buffer^,RecordSize);
+    end
+  else if (Result = grError) and doCheck then
+    DatabaseError('No record');
+end;
+
+procedure TBufDataset.InternalSetToRecord(Buffer: PChar);
+begin
+  FBCurrentRecord := PBufBookmark(Buffer + RecordSize)^.BookmarkData;
+  FIsEOF := False;
+  FIsBOF := False;
+end;
+
+procedure TBufDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  PBufBookmark(Buffer + RecordSize)^.BookmarkData := PInteger(Data)^;
+end;
+
+procedure TBufDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
+begin
+  PBufBookmark(Buffer + RecordSize)^.BookmarkFlag := Value;
+end;
+
+procedure TBufDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  PInteger(Data)^ := PBufBookmark(Buffer + RecordSize)^.BookmarkData;
+end;
+
+function TBufDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
+begin
+  Result := PBufBookmark(Buffer + RecordSize)^.BookmarkFlag;
+end;
+
+procedure TBufDataset.InternalGotoBookmark(ABookmark: Pointer);
+begin
+  FBCurrentRecord := PInteger(ABookmark)^;
+  FIsEOF := False;
+  FIsBOF := False;
+end;
+
+function TBufDataset.getnextpacket : integer;
+
+var i : integer;
+    b : boolean;
+
+begin
+  i := 0;
+  if FPacketRecords > 0 then
+    begin
+    FBBufferCount := FBBuffercount + FPacketRecords;
+    ReAllocMem(FBBuffers,FBBuffercount*SizeOf(PChar));
+
+    repeat
+    FBBuffers[FBRecordCount+i] := AllocRecord;
+    b := (getnextrecord(FBBuffers[FBRecordCount+i])<>grOk);
+    inc(i);
+    until (i = FPacketRecords) or b;
+    if b then
+      begin
+      dec(i);
+      FreeRecord(FBBuffers[FBRecordCount+i]);
+      end;
+    FBRecordCount := FBRecordCount + i;
+    end;
+  result := i;
+end;
+

fcl/db/datasource.inc

@@ -229,6 +229,9 @@ end;
 Procedure TDataLink.SetActiveRecord(Value: Integer);
 
 begin
+{$ifdef dsdebug}
+  Writeln('Datalink. Setting active record to ',Value,' with firstrecord ',ffirstrecord);
+{$endif}
   Dataset.FActiveRecord:=Value + FFirstRecord;
 end;
 

fcl/db/db.pp

@@ -824,7 +824,7 @@ type
     FOnPostError: TDataSetErrorEvent;
     FRecNo: Longint;
     FRecordCount: Longint;
-    FRecordSize: Word;
+//    FRecordSize: Word;
     FIsUniDirectional: Boolean;
     FState : TDataSetState;
     Procedure DoInsertAppend(DoAppend : Boolean);
@@ -1014,7 +1014,7 @@ type
     property IsUniDirectional: Boolean read FIsUniDirectional write FIsUniDirectional default False;
     property RecordCount: Longint read GetRecordCount;
     property RecNo: Longint read FRecNo write FRecNo;
-    property RecordSize: Word read FRecordSize;
+    property RecordSize: Word read GetRecordSize;
     property State: TDataSetState read FState;
     property Fields : TFields read FFieldList;
     property FieldValues[fieldname : string] : string read GetFieldValues write SetFieldValues; default;
@@ -1245,6 +1245,77 @@ type
     property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
   end;
 
+  { TBufDataset }
+  
+  PBufBookmark = ^TBufBookmark;
+  TBufBookmark = record
+    BookmarkData : integer;
+    BookmarkFlag : TBookmarkFlag;
+  end;
+
+  TBufDataset = class(TDataSet)
+  private
+    FBBuffers : TBufferArray;
+    FBRecordCount : integer;
+    FBBufferCount : integer;
+    FBCurrentRecord : integer;
+    FIsEOF : boolean;
+    FIsBOF : boolean;
+    FPacketRecords : integer;
+  protected
+    function  AllocRecordBuffer: PChar; override;
+    procedure FreeRecordBuffer(var Buffer: PChar); override;
+    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
+    procedure InternalOpen; override;
+    procedure InternalClose; override;
+    function getnextpacket : integer;
+    procedure InternalFirst; override;
+    procedure InternalLast; override;
+    procedure InternalSetToRecord(Buffer: PChar); override;
+    procedure InternalGotoBookmark(ABookmark: Pointer); override;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+  {abstracts, must be overidden by descendents}
+    function GetNextRecord(Buffer : pchar) : TGetResult; virtual; abstract;
+    function AllocRecord: PChar; virtual; abstract;
+    procedure FreeRecord(var Buffer: PChar); virtual; abstract;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    // redeclared data set properties
+    property Active;
+//    property FieldDefs stored FieldDefsStored;
+    property Filter;
+    property Filtered;
+    property FilterOptions;
+    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 OnCalcFields;
+    property OnDeleteError;
+    property OnEditError;
+    property OnFilterRecord;
+    property OnNewRecord;
+    property OnPostError;
+  end;
+
+
 Const
   Fieldtypenames : Array [TFieldType] of String[15] =
     (
@@ -1498,12 +1569,16 @@ end;
 {$i fields.inc}
 {$i datasource.inc}
 {$i database.inc}
+{$i BufDataset.inc}
 
 end.
 
 {
   $Log$
-  Revision 1.22  2004-08-23 07:30:19  michael
+  Revision 1.23  2004-08-31 09:51:27  michael
+  + Initial TBufDataset by Joost van der Sluis
+
+  Revision 1.22  2004/08/23 07:30:19  michael
   + Fixes from joost van der sluis: tfieldsdefs.tdatafield and size, cancel of only record and dataset.fieldvalyes
 
   Revision 1.21  2004/08/14 12:46:35  michael