Browse Source

--- Merging r30795 into '.':
U packages/fcl-db/tests/testsqldb.pas
--- Recording mergeinfo for merge of r30795 into '.':
U .
--- Merging r30796 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30796 into '.':
G .
--- Merging r30797 into '.':
G packages/fcl-db/tests/testsqldb.pas
--- Recording mergeinfo for merge of r30797 into '.':
G .
--- Merging r30798 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30798 into '.':
G .
--- Merging r30804 into '.':
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Recording mergeinfo for merge of r30804 into '.':
G .
--- Merging r30807 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30807 into '.':
G .
--- Merging r30814 into '.':
U packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
--- Recording mergeinfo for merge of r30814 into '.':
G .
--- Merging r30815 into '.':
G packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
--- Recording mergeinfo for merge of r30815 into '.':
G .
--- Merging r30839 into '.':
U packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30839 into '.':
G .
--- Merging r30845 into '.':
U packages/fcl-db/tests/tcsdfdata.pp
--- Recording mergeinfo for merge of r30845 into '.':
G .
--- Merging r30869 into '.':
U packages/fcl-db/src/base/dbconst.pas
--- Recording mergeinfo for merge of r30869 into '.':
G .
--- Merging r30880 into '.':
U packages/fcl-db/src/base/db.pas
U packages/fcl-db/src/base/fields.inc
--- Recording mergeinfo for merge of r30880 into '.':
G .
--- Merging r30881 into '.':
G packages/fcl-db/src/base/fields.inc
--- Recording mergeinfo for merge of r30881 into '.':
G .
--- Merging r30882 into '.':
G packages/fcl-db/tests/tcsdfdata.pp
U packages/fcl-db/tests/sdfdstoolsunit.pas
U packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30882 into '.':
G .
--- Merging r30883 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30883 into '.':
G .
--- Merging r30884 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Recording mergeinfo for merge of r30884 into '.':
G .
--- Merging r30885 into '.':
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Recording mergeinfo for merge of r30885 into '.':
G .
--- Merging r30887 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30887 into '.':
G .
--- Merging r30888 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30888 into '.':
G .
--- Merging r30920 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30920 into '.':
G .
--- Merging r30926 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30926 into '.':
G .
--- Merging r30927 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30927 into '.':
G .
--- Merging r30928 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30928 into '.':
G .
--- Merging r30929 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30929 into '.':
G .
--- Merging r30935 into '.':
G packages/fcl-db/tests/sdfdstoolsunit.pas
U packages/fcl-db/tests/dbtestframework_gui.lpi
U packages/fcl-db/tests/database.ini.txt
U packages/fcl-db/tests/dbtestframework_gui.lpr
A packages/fcl-db/tests/sqlite3dstoolsunit.pas
--- Recording mergeinfo for merge of r30935 into '.':
G .
--- Merging r31021 into '.':
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Recording mergeinfo for merge of r31021 into '.':
G .
--- Merging r31024 into '.':
G packages/fcl-db/src/base/db.pas
--- Recording mergeinfo for merge of r31024 into '.':
G .
--- Merging r31027 into '.':
U packages/fcl-db/tests/testspecifictmemdataset.pas
U packages/fcl-db/tests/memdstoolsunit.pas
U packages/fcl-db/src/memds/memds.pp
--- Recording mergeinfo for merge of r31027 into '.':
G .

# revisions: 30795,30796,30797,30798,30804,30807,30814,30815,30839,30845,30869,30880,30881,30882,30883,30884,30885,30887,30888,30920,30926,30927,30928,30929,30935,31021,31024,31027

git-svn-id: branches/fixes_3_0@31102 -

marco 10 years ago
parent
commit
a34587e7b6

+ 1 - 0
.gitattributes

@@ -2267,6 +2267,7 @@ packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/reruntest.sh svneol=native#text/plain
 packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
+packages/fcl-db/tests/sqlite3dstoolsunit.pas svneol=LF#text/plain eol=lf
 packages/fcl-db/tests/tccsvdataset.pp svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain

+ 7 - 8
packages/fcl-db/src/base/db.pas

@@ -866,8 +866,7 @@ type
   // This type is needed for compatibility. While it should contain only blob
   // types, it actually does not.
   // Instead of this, please use ftBlobTypes
-  TBlobType = ftBlob..ftWideMemo deprecated
-    'Warning: Does not contain BLOB types. Please use ftBlobTypes.';
+  TBlobType = ftBlob..ftWideMemo deprecated 'Warning: Does not contain BLOB types. Please use ftBlobTypes.';
 
   TBlobField = class(TField)
   private
@@ -876,7 +875,7 @@ type
     Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
     // Wrapper that retrieves FDataType as a TBlobType
     function GetBlobType: TBlobType;
-    // Wrapper that calls SetFieldtype
+    // Wrapper that calls SetFieldType
     procedure SetBlobType(AValue: TBlobType);
   protected
     procedure FreeBuffers; override;
@@ -906,7 +905,7 @@ type
     property Value: string read GetAsString write SetAsString;
     property Transliterate: Boolean read FTransliterate write FTransliterate;
   published
-    property BlobType: TBlobType read GetBlobType write SetBlobType;
+    property BlobType: TBlobType read GetBlobType write SetBlobType default ftBlob;
     property Size default 0;
   end;
 
@@ -2194,8 +2193,8 @@ var
 
 Procedure DatabaseError (Const Msg : String); overload;
 Procedure DatabaseError (Const Msg : String; Comp : TComponent); overload;
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const); overload;
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const; Comp : TComponent); overload;
+Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const); overload;
+Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const; Comp : TComponent); overload;
 Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
 Function DateTimeRecToDateTime(DT: TFieldType; Data: TDateTimeRec): TDateTime;
 Function DateTimeToDateTimeRec(DT: TFieldType; Data: TDateTime): TDateTimeRec;
@@ -2230,13 +2229,13 @@ begin
     DatabaseError(Msg);
 end;
 
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
+Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const);
 
 begin
   Raise EDatabaseError.CreateFmt(Fmt,Args);
 end;
 
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
+Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const;
                             Comp : TComponent);
 begin
   if assigned(comp) then

+ 1 - 1
packages/fcl-db/src/base/dbconst.pas

@@ -22,7 +22,7 @@ Resourcestring
   SActiveDataset           = 'Operation cannot be performed on an active dataset';
   SBadParamFieldType       = 'Bad fieldtype for parameter "%s".';
   SCantSetAutoIncFields    = 'AutoInc Fields are read-only';
-  SConnected               = 'Operation cannot be performed on an connected database';
+  SConnected               = 'Operation cannot be performed on a connected database';
   SDatasetReadOnly         = 'Dataset is read-only.';
   SDatasetRegistered       = 'Dataset already registered : "%s"';
   SDuplicateFieldName      = 'Duplicate fieldname : "%s"';

+ 22 - 20
packages/fcl-db/src/base/fields.inc

@@ -1047,7 +1047,7 @@ end;
 
 procedure TStringField.SetFieldType(AValue: TFieldType);
 begin
-  if avalue in [ftString, ftFixedChar] then
+  if AValue in [ftString, ftFixedChar] then
     SetDataType(AValue);
 end;
 
@@ -1264,7 +1264,7 @@ end;
 
 procedure TWideStringField.SetFieldType(AValue: TFieldType);
 begin
-  if avalue in [ftWideString, ftFixedWideChar] then
+  if AValue in [ftWideString, ftFixedWideChar] then
     SetDataType(AValue);
 end;
 
@@ -1405,7 +1405,7 @@ constructor TLongintField.Create(AOwner: TComponent);
 
 begin
   Inherited Create(AOwner);
-  SetDatatype(ftinteger);
+  SetDataType(ftInteger);
   FMinRange:=Low(LongInt);
   FMaxRange:=High(LongInt);
   FValidchars:=['+','-','0'..'9'];
@@ -1574,7 +1574,7 @@ constructor TLargeintField.Create(AOwner: TComponent);
 
 begin
   Inherited Create(AOwner);
-  SetDatatype(ftLargeint);
+  SetDataType(ftLargeint);
   FMinRange:=Low(Largeint);
   FMaxRange:=High(Largeint);
   FValidchars:=['+','-','0'..'9'];
@@ -1937,7 +1937,7 @@ constructor TFloatField.Create(AOwner: TComponent);
 
 begin
   Inherited Create(AOwner);
-  SetDatatype(ftFloat);
+  SetDataType(ftFloat);
   FPrecision:=15;
   FValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
 end;
@@ -2782,7 +2782,7 @@ end;
 
 procedure TBlobField.SetBlobType(AValue: TBlobType);
 begin
-  SetFieldType(TFieldType(BlobType));
+  SetFieldType(TFieldType(AValue));
 end;
 
 procedure TBlobField.FreeBuffers;
@@ -2813,7 +2813,7 @@ function TBlobField.GetAsString: string;
 var
   Stream : TStream;
   Len    : Integer;
-  R : String;
+  S : String;
   
 begin
   Stream := GetBlobStream(bmRead);
@@ -2821,18 +2821,20 @@ begin
     with Stream do
       try
         Len := Size;
-        SetLength(R, Len);
+        SetLength(S, Len);
         if Len > 0 then
           begin
-          ReadBuffer(R[1], Len);
+          ReadBuffer(S[1], Len);
           if not Transliterate then
-            Result:=R
-          else  
+            Result := S
+          else
             begin
-            SetLength(Result,Len);
-            DataSet.Translate(@R[1],@Result[1],False);
+            SetLength(Result, Len);
+            DataSet.Translate(@S[1],@Result[1],False);
             end;
-          end;  
+          end
+        else
+          Result := '';
       finally
         Free;    
       end
@@ -2929,7 +2931,7 @@ end;
 procedure TBlobField.SetAsString(const AValue: string);
 var
   Len : Integer;
-  R : String;
+  S : String;
   
 begin
   with GetBlobStream(bmWrite) do
@@ -2938,13 +2940,13 @@ begin
       if (Len>0) then
         begin
         if Not Transliterate then
-          R:=AValue
+          S:=AValue
         else
           begin
-          SetLength(R,Len);
-          Len:=Dataset.Translate(@AValue[1],@R[1],True);
+          SetLength(S,Len);
+          Len:=DataSet.Translate(@AValue[1],@S[1],True);
           end;  
-        WriteBuffer(R[1], Len);
+        WriteBuffer(S[1], Len);
         end;
     finally
       Free;
@@ -3051,7 +3053,7 @@ end;
 procedure TBlobField.SetFieldType(AValue: TFieldType);
 begin
   if AValue in ftBlobTypes then
-    SetDatatype(AValue);
+    SetDataType(AValue);
 end;
 
 { TMemoField }

+ 176 - 39
packages/fcl-db/src/memds/memds.pp

@@ -46,29 +46,31 @@ type
 
   MDSError=class(Exception);
 
-  PRecInfo=^TMTRecInfo;
-  TMTRecInfo=record
-    Bookmark: Longint;
-    BookmarkFlag: TBookmarkFlag;
-  end;
-
   { TMemDataset }
 
   TMemDataset=class(TDataSet)
   private
-    FOpenStream : TStream;
-    FFileName : String;
-    FFileModified : Boolean;
-    FStream: TMemoryStream;
-    FRecInfoOffset: integer;
-    FRecCount: integer;
-    FRecSize: integer;
-    FCurrRecNo: integer;
-    FIsOpen: boolean;
-    FTableIsCreated: boolean;
-    FFilterBuffer: TRecordBuffer;
-    ffieldoffsets: PInteger;
-    ffieldsizes: PInteger;
+    type
+      TMDSBlobList = class(TFPList)
+        public
+          procedure Clear; reintroduce;
+      end;
+    var
+      FOpenStream : TStream;
+      FFileName : String;
+      FFileModified : Boolean;
+      FStream: TMemoryStream;
+      FRecInfoOffset: integer;
+      FRecCount: integer;
+      FRecSize: integer;
+      FCurrRecNo: integer;
+      FIsOpen: boolean;
+      FTableIsCreated: boolean;
+      FFilterBuffer: TRecordBuffer;
+      ffieldoffsets: PInteger;
+      ffieldsizes: PInteger;
+      FBlobs: TMDSBlobList;
+
     function GetRecordBufferPointer(p:TRecordBuffer; Pos:Integer):TRecordBuffer;
     function GetIntegerPointer(p:PInteger; Pos:Integer):PInteger;
 
@@ -126,17 +128,16 @@ type
     // If SaveData=False, a size 0 block should be written.
     Procedure SaveDataToStream(F : TStream; SaveData : Boolean); virtual;
 
-
   public
-    constructor Create(AOwner:tComponent); override;
+    constructor Create(AOwner:TComponent); override;
     destructor Destroy; override;
     function BookmarkValid(ABookmark: TBookmark): Boolean; override;
+    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean; override;
     function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
-    procedure CreateTable;
 
+    procedure CreateTable;
     Function  DataSize : Integer;
-
     Procedure Clear(ClearDefs : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
     Procedure Clear;{$IFNDEF FPC} overload; {$ENDIF}
     Procedure SaveToFile(AFileName : String);{$IFNDEF FPC} overload; {$ENDIF}
@@ -183,7 +184,7 @@ type
 implementation
 
 uses
-  Variants, FmtBCD;
+  DBConst, Variants, FmtBCD;
 
 ResourceString
   SErrFieldTypeNotSupported = 'Fieldtype of Field "%s" not supported.';
@@ -192,8 +193,40 @@ ResourceString
   SErrInvalidMarkerAtPos    = 'Wrong data stream marker at position %d. Got %d, expected %d';
   SErrNoFileName            = 'Filename must not be empty.';
 
+type
+  TMDSRecInfo=record
+    Bookmark: Longint;
+    BookmarkFlag: TBookmarkFlag;
+  end;
+  PRecInfo=^TMDSRecInfo;
+
+  TMDSBlobField = record
+    Buffer: Pointer;  // pointer to memory allocated for Blob data
+    Size: PtrInt;     // size of Blob data
+  end;
+
+  { TMDSBlobStream }
+
+  TMDSBlobStream = class(TStream)
+    private
+      FField      : TBlobField;
+      FDataSet    : TMemDataset;
+      FBlobField  : TMDSBlobField;
+      FPosition   : PtrInt;
+      FModified   : boolean;
+      procedure AllocBlobField(NewSize: PtrInt);
+      procedure FreeBlobField;
+    public
+      constructor Create(Field: TField; Mode: TBlobStreamMode);
+      destructor Destroy; override;
+      function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
+      function Read(var Buffer; Count: Longint): Longint; override;
+      function Write(const Buffer; Count: Longint): Longint; override;
+  end;
+
 Const
-  SizeRecInfo = SizeOf(TMTRecInfo);
+  SizeRecInfo = SizeOf(TMDSRecInfo);
+
 
 procedure unsetfieldisnull(nullmask: pbyte; const x: integer);
 
@@ -259,22 +292,110 @@ begin
     S.WriteBuffer(Value[1],L);
 end;
 
+
+{ TMDSBlobStream }
+
+constructor TMDSBlobStream.Create(Field: TField; Mode: TBlobStreamMode);
+begin
+  FField := Field as TBlobField;
+  FDataSet := Field.DataSet as TMemDataset;
+  if not Field.GetData(@FBlobField) then // IsNull
+  begin
+    FBlobField.Buffer := nil;
+    FBlobField.Size := 0;
+  end;
+
+  if Mode = bmWrite then
+    // release existing Blob
+    FreeBlobField;
+end;
+
+destructor TMDSBlobStream.Destroy;
+begin
+  if FModified then
+  begin
+    if FBlobField.Size = 0 then // Empty blob = IsNull
+      FField.SetData(nil)
+    else
+      FField.SetData(@FBlobField);
+  end;
+  inherited;
+end;
+
+procedure TMDSBlobStream.FreeBlobField;
+begin
+  FDataSet.FBlobs.Remove(FBlobField.Buffer);
+  FreeMem(FBlobField.Buffer, FBlobField.Size);
+  FBlobField.Buffer := nil;
+  FBlobField.Size := 0;
+  FModified := True;
+end;
+
+procedure TMDSBlobStream.AllocBlobField(NewSize: PtrInt);
+begin
+  FDataSet.FBlobs.Remove(FBlobField.Buffer);
+  ReAllocMem(FBlobField.Buffer, NewSize);
+  FDataSet.FBlobs.Add(FBlobField.Buffer);
+  FModified := True;
+end;
+
+function TMDSBlobStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
+begin
+  Case Origin of
+    soBeginning : FPosition := Offset;
+    soEnd       : FPosition := FBlobField.Size + Offset;
+    soCurrent   : FPosition := FPosition + Offset;
+  end;
+  Result := FPosition;
+end;
+
+function TMDSBlobStream.Read(var Buffer; Count: Longint): Longint;
+var p: Pointer;
+begin
+  if FPosition + Count > FBlobField.Size then
+    Count := FBlobField.Size - FPosition;
+  p := FBlobField.Buffer + FPosition;
+  Move(p^, Buffer, Count);
+  Inc(FPosition, Count);
+  Result := Count;
+end;
+
+function TMDSBlobStream.Write(const Buffer; Count: Longint): Longint;
+var p: Pointer;
+begin
+  AllocBlobField(FPosition+Count);
+  p := FBlobField.Buffer + FPosition;
+  Move(Buffer, p^, Count);
+  Inc(FBlobField.Size, Count);
+  Inc(FPosition, Count);
+  Result := Count;
+end;
+
+
+{ TMemDataset.TMDSBlobList }
+
+procedure TMemDataset.TMDSBlobList.Clear;
+var i: integer;
+begin
+  for i:=0 to Count-1 do FreeMem(Items[i]);
+  inherited Clear;
+end;
+
 { ---------------------------------------------------------------------
     TMemDataset
   ---------------------------------------------------------------------}
 
-
-constructor TMemDataset.Create(AOwner:tComponent);
+constructor TMemDataset.Create(AOwner:TComponent);
 
 begin
-  inherited create(aOwner);
+  inherited Create(AOwner);
   FStream:=TMemoryStream.Create;
   FRecCount:=0;
   FRecSize:=0;
   FRecInfoOffset:=0;
   FCurrRecNo:=-1;
   BookmarkSize := sizeof(Longint);
-  FIsOpen:=False;
+  FBlobs := TMDSBlobList.Create;
 end;
 
 destructor TMemDataset.Destroy;
@@ -282,6 +403,8 @@ begin
   FStream.Free;
   FreeMem(FFieldOffsets);
   FreeMem(FFieldSizes);
+  FBlobs.Clear;
+  FBlobs.Free;
   inherited Destroy;
 end;
 
@@ -295,6 +418,20 @@ begin
   Result := (ReqBookmark>=0) and (ReqBookmark<FRecCount);
 end;
 
+function TMemDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode
+  ): TStream;
+begin
+  // Blobs are not saved to stream/file !
+  if Mode = bmWrite then
+    begin
+    if not (State in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
+      DatabaseErrorFmt(SNotEditing, [Name], Self);
+    if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
+      DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
+    end;
+  Result := TMDSBlobStream.Create(Field, Mode);
+end;
+
 function TMemDataset.MDSGetRecordOffset(ARecNo: integer): longint;
 begin
   Result:=FRecSize*ARecNo
@@ -302,7 +439,7 @@ end;
 
 function TMemDataset.MDSGetFieldOffset(FieldNo: integer): integer;
 begin
- result:= getIntegerpointer(ffieldoffsets, fieldno-1)^;
+  Result:= getIntegerPointer(ffieldoffsets, fieldno-1)^;
 end;
 
 procedure TMemDataset.RaiseError(Fmt: String; Args: array of const);
@@ -333,10 +470,12 @@ begin
     ftTime,
     ftDate:   result:=SizeOf(TDateTime);
   ftFmtBCD:   result:=SizeOf(TBCD);
-  ftWideString,
-  ftFixedWideChar: result:=(FD.Size+1)*SizeOf(WideChar);
+  ftWideString, ftFixedWideChar:
+              result:=(FD.Size+1)*SizeOf(WideChar);
   ftBytes:    result := FD.Size;
   ftVarBytes: result := FD.Size + SizeOf(Word);
+  ftBlob, ftMemo, ftWideMemo:
+              result := SizeOf(TMDSBlobField);
  else
   RaiseError(SErrFieldTypeNotSupported,[FD.Name]);
  end;
@@ -533,6 +672,7 @@ Var
 begin
   CheckMarker(F,smData);
   Size:=ReadInteger(F);
+  FBlobs.Clear;
   FStream.Clear;
   FStream.CopyFrom(F,Size);
   FRecCount:=Size div FRecSize;
@@ -654,9 +794,8 @@ begin
  FIsOpen:=False;
  FFileModified:=False;
  // BindFields(False);
- if DefaultFields then begin
+ if DefaultFields then
   DestroyFields;
- end;
 end;
 
 procedure TMemDataset.InternalPost;
@@ -872,6 +1011,7 @@ end;
 procedure TMemDataset.Clear(ClearDefs : Boolean);
 
 begin
+  FBlobs.Clear;
   FStream.Clear;
   FRecCount:=0;
   FCurrRecNo:=-1;
@@ -907,7 +1047,7 @@ begin
  for i:= 0 to Count-1 do
    begin
    GetIntegerPointer(FFieldOffsets, i)^ := FRecSize;
-   GetIntegerPointer(FFieldSizes,   i)^ := MDSGetbufferSize(i+1);
+   GetIntegerPointer(FFieldSizes,   i)^ := MDSGetBufferSize(i+1);
    FRecSize:= FRecSize+GetIntegerPointer(FFieldSizes, i)^;
    end;
  FRecInfoOffset:=FRecSize;
@@ -918,10 +1058,7 @@ procedure TMemDataset.CreateTable;
 
 begin
   CheckInactive;
-  FStream.Clear;
-  FRecCount:=0;
-  FCurrRecNo:=-1;
-  FIsOpen:=False;
+  Clear(False);
   calcrecordlayout;
   FTableIsCreated:=True;
 end;

+ 216 - 211
packages/fcl-db/src/sdf/sdfdata.pp

@@ -142,6 +142,9 @@ type
   end;
 //-----------------------------------------------------------------------------
 // TBaseTextDataSet
+
+  { TFixedFormatDataSet }
+
   TFixedFormatDataSet = class(TDataSet)
   private
     FSchema             :TStringList;
@@ -158,8 +161,8 @@ type
     procedure SetReadOnly(Value : Boolean);
     procedure RemoveWhiteLines(List : TStrings; IsFileRecord : Boolean);
     procedure LoadFieldScheme(List : TStrings; MaxSize : Integer);
-    function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
-    procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
+    function GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
+    procedure SetFieldOfs(var Buffer : TRecordBuffer; FieldNo : Integer);
   protected
     FData               :TStringlist;
     FDataOffset         :Integer;
@@ -267,6 +270,7 @@ type
     procedure InternalInitFieldDefs; override;
     function BufToStore(Buffer: TRecordBuffer): String; override;
     function StoreToBuf(Source: String): String; override;
+    function ExtractDelimited(const S: String; var Pos: integer): string;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -277,6 +281,7 @@ type
     // Set this to True if you want to strip all last delimiters
     Property StripTrailingDelimiters : Boolean Read FStripTrailingDelimiters Write FStripTrailingDelimiters;
   end;
+
 procedure Register;
 
 implementation
@@ -293,7 +298,7 @@ begin
   FRecordSize   := 0;
   FTrimSpace    := TRUE;
   FSchema       := TStringList.Create;
-  FData         := TStringList.Create;  // Load the textfile into a stringlist
+  FData         := TStringList.Create;  // Load the textfile into a StringList
   inherited Create(AOwner);
 end;
 
@@ -336,31 +341,37 @@ end;
 
 procedure TFixedFormatDataSet.InternalInitFieldDefs;
 var
-  i, len, Maxlen :Integer;
+  i, Len, MaxLen :Integer;
   LstFields      :TStrings;
 begin
   if not Assigned(FData) then
     exit;
-  FRecordSize := 0;
-  Maxlen := 0;
+
+  MaxLen := 0;
   FieldDefs.Clear;
   for i := FData.Count - 1 downto 0 do  // Find out the longest record
   begin
-    len := Length(FData[i]);
-    if len > Maxlen then
-      Maxlen := len;
+    Len := Length(FData[i]);
+    if Len > MaxLen then
+      MaxLen := Len;
     FData.Objects[i] := TObject(Pointer(i+1));   // Fabricate Bookmarks
   end;
-  if (Maxlen = 0) then
-    Maxlen := FDefaultRecordLength;
+  if (MaxLen = 0) then
+    MaxLen := FDefaultRecordLength;
+
+  FRecordSize := 0;
   LstFields := TStringList.Create;
   try
-    LoadFieldScheme(LstFields, Maxlen);
+    LoadFieldScheme(LstFields, MaxLen);
     for i := 0 to LstFields.Count -1 do  // Add fields
     begin
-      len := StrToIntDef(LstFields.Values[LstFields.Names[i]], Maxlen);
-      FieldDefs.Add(Trim(LstFields.Names[i]), ftString, len, False);
-      Inc(FRecordSize, len);
+      Len := StrToIntDef(LstFields.Values[LstFields.Names[i]], MaxLen);
+      FieldDefs.Add(Trim(LstFields.Names[i]), ftString, Len, False);
+      Inc(Len);
+{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
+      Len := Align(Len, SizeOf(PtrInt));
+{$ENDIF}
+      Inc(FRecordSize, Len);
     end;
   finally
     LstFields.Free;
@@ -390,6 +401,9 @@ begin
   BindFields(TRUE);
   BookmarkSize := SizeOf(PtrInt);
   FRecInfoOfs := FRecordSize + CalcFieldsSize; // Initialize the offset for TRecInfo in the buffer
+{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
+  FRecInfoOfs := Align(FRecInfoOfs, SizeOf(PtrInt));
+{$ENDIF}
   FRecBufSize := FRecInfoOfs + SizeOf(TRecInfo);
   FLastBookmark := FData.Count;
   FCurRec := FDataOffset - 1;
@@ -504,7 +518,7 @@ begin
 
       if Result = grOk then
       begin
-        Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
+        Move(StoreToBuf(FData[FCurRec])[1], Buffer[0], FRecordSize);
         with PRecInfo(Buffer + FRecInfoOfs)^ do
         begin
           Bookmark := PtrInt(FData.Objects[FCurRec]);
@@ -560,7 +574,7 @@ begin
   Result := FRecordSize;
 end;
 
-function TFixedFormatDataSet.GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
+function TFixedFormatDataSet.GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
 begin
   case State of
     dsCalcFields: RecBuf := CalcBuffer;
@@ -619,29 +633,29 @@ end;
 
 function TFixedFormatDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 var
-  TempPos, RecBuf : PChar;
+  RecBuf,
+  BufEnd: PChar;
 begin
   Result := GetActiveRecBuf(TRecordBuffer(RecBuf));
   if Result then
   begin
     if Field.FieldNo > 0 then
     begin
-      TempPos := RecBuf;
-      SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
-      Result := (RecBuf < StrEnd(TempPos));
+      SetFieldOfs(TRecordBuffer(RecBuf), Field.FieldNo);
+      Result := RecBuf < StrEnd(RecBuf); // just ''=Null
       if Result and Assigned(Buffer) then
       begin
         StrLCopy(Buffer, RecBuf, Field.Size);
         if FTrimSpace then // trim trailing spaces
         begin
-          TempPos := StrEnd(Buffer);
+          BufEnd := StrEnd(Buffer);
           repeat
-            Dec(TempPos);
-            if (TempPos[0] = ' ') then
-              TempPos[0]:= #0
+            Dec(BufEnd);
+            if (BufEnd^ = ' ') then
+              BufEnd^ := #0
             else
               break;
-          until (TempPos = Buffer);
+          until (BufEnd = Buffer);
         end;
       end;
     end
@@ -658,8 +672,6 @@ end;
 procedure TFixedFormatDataSet.SetFieldData(Field: TField; Buffer: Pointer);
 var
   RecBuf: PChar;
-  BufEnd: PChar;
-  p : Integer;
 begin
   if not (State in dsWriteModes) then
     DatabaseErrorFmt(SNotEditing, [Name], Self);
@@ -674,15 +686,8 @@ begin
       Field.Validate(Buffer);
     if Assigned(Buffer) and (Field.FieldKind <> fkInternalCalc) then
     begin
-      SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
-      BufEnd := StrEnd(pansichar(ActiveBuffer));  // Fill with blanks when necessary
-      if BufEnd > RecBuf then
-        BufEnd := RecBuf;
-      FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), Ord(' '));
-      p := StrLen(Buffer);
-      if p > Field.Size then
-        p := Field.Size;
-      Move(Buffer^, RecBuf[0], p);
+      SetFieldOfs(TRecordBuffer(RecBuf), Field.FieldNo);
+      Move(Buffer^, RecBuf[0], Field.DataSize);
     end;
   end
   else // fkCalculated, fkLookup
@@ -693,17 +698,21 @@ begin
       Move(Buffer^, RecBuf[1], Field.DataSize);
   end;
   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
-    DataEvent(deFieldChange, Ptrint(Field));
+    DataEvent(deFieldChange, PtrInt(Field));
 end;
 
-procedure TFixedFormatDataSet.SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
+procedure TFixedFormatDataSet.SetFieldOfs(var Buffer : TRecordBuffer; FieldNo : Integer);
 var
-  i : Integer;
+  i, Len : Integer;
 begin
   i := 1;
   while (i < FieldNo) and (i < FieldDefs.Count) do
   begin
-    Inc(Buffer, FieldDefs.Items[i-1].Size);
+    Len := FieldDefs.Items[i-1].Size + 1;
+{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
+    Len := Align(Len, SizeOf(PtrInt));
+{$ENDIF}
+    Inc(Buffer, Len);
     Inc(i);
   end;
 end;
@@ -823,7 +832,7 @@ var
   i : Integer;
 begin
   for i := FData.Count -1 downto 0 do
-    FData[i] := BufToStore(trecordbuffer(StoreToBuf(FData[i])));
+    FData[i] := BufToStore(TRecordBuffer(StoreToBuf(FData[i])));
   FData.SaveToFile(FileName);
 end;
 
@@ -835,13 +844,46 @@ begin
 end;
 
 function TFixedFormatDataSet.StoreToBuf(Source: String): String;
+var i, Len: integer;
+    Src, Dest: PChar;
 begin
-  Result := Source;
+  // moves fixed length fields from Source to record buffer and null-terminates each field
+  SetLength(Result, FRecordSize);
+  Src  := PChar(Source);
+  Dest := PChar(Result);
+  for i := 0 to FieldDefs.Count - 1 do
+  begin
+    Len := FieldDefs[i].Size;
+    Move(Src^, Dest^, Len);
+    Inc(Src, Len);
+    Inc(Dest, Len);
+    Dest^ := #0;
+    Inc(Dest);
+  end;
 end;
 
 function TFixedFormatDataSet.BufToStore(Buffer: TRecordBuffer): String;
+var i, Len, SrcLen: integer;
+    Src, Dest: PChar;
 begin
-  Result := Copy(pansichar(Buffer), 1, FRecordSize);
+  // calculate fixed length record size
+  Len := 0;
+  for i := 0 to FieldDefs.Count - 1 do
+    Inc(Len, FieldDefs[i].Size);
+  SetLength(Result, Len);
+
+  Src  := PChar(Buffer);
+  Dest := PChar(Result);
+  for i := 0 to FieldDefs.Count - 1 do
+  begin
+    Len := FieldDefs[i].Size;
+    Move(Src^, Dest^, Len);
+    // fields in record buffer are null-terminated, but pad them with spaces to fixed length
+    SrcLen := StrLen(Src);
+    FillChar(Dest[SrcLen], Len-SrcLen, ' ');
+    Inc(Src, Len+1);
+    Inc(Dest, Len);
+  end;
 end;
 
 //-----------------------------------------------------------------------------
@@ -855,10 +897,78 @@ begin
   FMultiLine := False;
 end;
 
+function TSdfDataSet.ExtractDelimited(const S: String; var Pos: integer): string;
+const
+  CR: char = #13;
+  LF: char = #10;
+  DQ: char = '"';
+var
+  Len, P1: integer;
+  pSrc, pDest: PChar;
+begin
+  Len := Length(S);
+  P1 := Pos;
+
+  // RFC 4180:
+  //   Spaces are considered part of a field and should not be ignored
+  //
+  //   If double-quotes are used to enclose fields, then a double-quote
+  //   appearing inside a field must be escaped by preceding it with
+  //   another double quote
+
+  if (S[Pos] = DQ) then
+    // quoted field
+    begin
+    // skip leading quote
+    Inc(Pos);
+    // allocate output buffer
+    SetLength(Result, Len-P1+1);
+    pSrc := @S[Pos];
+    pDest := @Result[1];
+    while (Pos <= Len) do
+      begin
+      if (pSrc[0] = DQ) then
+        begin
+        if (pSrc[1] = DQ) then // doubled DQ
+          begin
+          Inc(pSrc);
+          Inc(Pos);
+          end
+        else if (pSrc[1] in [Delimiter,' ',CR,LF,#0]) then // DQ followed by delimiter or end of record
+          break;
+        end
+      else if not FMultiLine and (pSrc[0] in [CR,LF,#0]) then // end of record while multiline disabled
+        break;
+      pDest^ := pSrc^;
+      Inc(pSrc);
+      Inc(pDest);
+      Inc(Pos);
+      end;
+    SetLength(Result, pDest-@Result[1]);
+    // skip trailing DQ and white spaces after DQ
+    while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
+      Inc(Pos);
+    end
+  else
+    // unquoted field name
+    begin
+    while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
+      Inc(Pos);
+    Result := Copy(S, P1, Pos-P1);
+    end;
+
+  // skip final field delimiter
+  if (Pos <= Len) and (S[Pos] = Delimiter) then
+    Inc(Pos);
+  // skip end of record, line break CRLF
+  while (Pos <= Len) and (S[Pos] in [CR,LF]) do
+    Inc(Pos);
+end;
+
 procedure TSdfDataSet.InternalInitFieldDefs;
 var
-  pStart, pEnd, len : Integer;
-  SchemaLine, FN : String;
+  Len, Pos : Integer;
+  SchemaLine, S, FN : String;
 
 begin
   if not IsCursorOpen then
@@ -876,50 +986,24 @@ begin
   begin
     Schema.Clear;
     SchemaLine:=FData[0];
+
     if StripTrailingDelimiters then
       DoStripTrailingDelimiters(SchemaLine);
-    len := Length(SchemaLine);
-    pEnd := 1;
-    repeat
-      // skip leading white-spaces
-      while (pEnd<=len) and (SchemaLine[pEnd] in [#1..' ']) do
-        Inc(pEnd);
-
-      if (pEnd > len) then
-        break;
-
-      pStart := pEnd;
-      if (SchemaLine[pStart] = '"') then
-        // quoted field name
-        begin
-        repeat
-          Inc(pEnd);
-        until (pEnd > len)  or (SchemaLine[pEnd] = '"');
-        if (SchemaLine[pEnd] = '"') then
-          Inc(pStart);
-        end
-      else
-        // unquoted field name
-        while (pEnd<=len) and (SchemaLine[pEnd]<>Delimiter) do
-          Inc(pEnd);
 
+    Len := Length(SchemaLine);
+    Pos := 1;
+    while Pos <= Len do
+    begin
+      S := ExtractDelimited(SchemaLine, Pos);
       if FirstLineAsSchema then
-        FN:=Copy(SchemaLine, pStart, pEnd - pStart)
+        FN := S
       else
-        FN:='';
-      if FN='' then // pEnd-pStart=0 is possible: a,b,,c
-        FN:=Format('Field%d', [Schema.Count + 1]);
+        FN := '';
+      if FN = '' then // Special case: "a,b,,c"
+        FN := Format('Field%d', [Schema.Count + 1]);
       Schema.Add(FN);
-
-      // skip all after trailing quote until next Delimiter
-      if (pEnd<=Len) and (SchemaLine[pEnd] = '"') then
-        while (pEnd <= len) and (SchemaLine[pEnd] <> Delimiter) do
-          Inc(pEnd);
-
-      Inc(pEnd);
-    until (pEnd > len);
-
-    // Special case: f1,f2, is 3 fields, last unnamed.
+    end;
+    // Special case: "f1,f2," are 3 fields, last unnamed.
     if (Len>0) and (SchemaLine[Len]=Delimiter) then
       Schema.Add(Format('Field%d', [Schema.Count + 1]));
   end;
@@ -927,174 +1011,95 @@ begin
 end;
 
 function TSdfDataSet.StoreToBuf(Source: String): String;
-const
- CR    :char = #13;
- LF    :char = #10;
- Quote :char = #34; // Character that encloses field if quoted. Hard-coded to "
 var
-  IsQuoted   // Whether or not field starts with a quote
-                :Boolean;
-  FieldMaxSize, // Maximum fields size as defined in FieldDefs
-  i,         // Field counter (0..)
-  p          // Length of string in field
-                :Integer;
-  pDeQuoted, // Temporary buffer for dedoubling quotes
-  pRet,      // Pointer to insertion point in return value
-  pStr,      // Beginning of field
-  pStrEnd    // End of field
-                :PChar;
-  Ret           :String;
+  MaxLen, // Maximum field length as defined in FieldDefs + null terminator
+  i,
+  Pos,
+  Len     : Integer; // Actual length of field
+  S       : String;
+  Dest    : PChar;
 begin
-  SetLength(Ret, FRecordSize);
-  FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
+  SetLength(Result, FRecordSize);
+  FillChar(Result[1], FRecordSize, Ord(' '));
 
-  PStrEnd := PChar(Source);
-  pRet := PChar(Ret);
+  Pos := 1;
+  Dest := PChar(Result);
 
   for i := 0 to FieldDefs.Count - 1 do
-   begin
-    FieldMaxSize := FieldDefs[i].Size;
-    IsQuoted := false;
-    while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
-    begin
-     if FMultiLine then
-      begin
-       if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
-        begin
-         //view this as text, not control characters, so do nothing
-         //todo: check if this is really necessary, probably revert
-         //to original code as quoted case is handled below
-        end;
-      end
-     else
-      begin
-       Inc(pStrEnd);
-      end;
-    end;
+  begin
+    MaxLen := FieldDefs[i].Size;
+    S := ExtractDelimited(Source, Pos);
+    Len := Length(S);
 
-    if not Boolean(Byte(pStrEnd[0])) then
-     break;
-
-    pStr := pStrEnd;
-
-    if (pStr[0] = Quote) then
-     begin
-      IsQuoted := true; // See below: accept end of string without explicit quote
-      if FMultiLine then
-       begin
-        repeat
-         Inc(pStrEnd);
-        until not Boolean(Byte(pStrEnd[0])) or
-         ((pStrEnd[0] = Quote) and ((pStrEnd + 1)[0] in [Delimiter,#0]));
-       end
-      else
-       begin
-        // No multiline, so treat cr/lf as end of record
-         repeat
-          Inc(pStrEnd);
-         until not Boolean(Byte(pStrEnd[0])) or
-          ((pStrEnd[0] = Quote) and ((pStrEnd + 1)[0] in [Delimiter,CR,LF,#0]));
-       end;
-
-      if (pStrEnd[0] = Quote) then
-       Inc(pStr); //Skip final quote
-     end
-    else
-      while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
-        Inc(pStrEnd);
+    if Len > MaxLen then
+      Len := MaxLen;
 
-    // Copy over entire field (or at least up to field length):
-    p := pStrEnd - pStr;
-    if IsQuoted then
-    begin
-     pDeQuoted := pRet; //Needed to avoid changing insertion point
-     // Copy entire field but not more than maximum field length:
-     // (We can mess with pStr now; the next loop will reset it after
-     // pStrEnd):
-     while (pstr < pStrEnd) and (pDeQuoted-pRet <= FieldMaxSize) do
-     begin
-      if pStr^ = Quote then inc(pStr);// skip first quote
-      pDeQuoted^ := pStr^;
-      inc(pStr);
-      inc(pDeQuoted);
-     end;
-    end
+    if Len = 0 then // bug in StrPLCopy
+      Dest^ := #0
     else
-    begin
-     if (p > FieldMaxSize) then
-       p := FieldMaxSize;
-     Move(pStr[0], pRet[0], p);
-    end;
-
-    Inc(pRet, FieldMaxSize);
+      StrPLCopy(Dest, S, Len); // null-terminate
 
-    // Move the end of field position past quotes and delimiters
-    // ready for processing the next field
-    if (pStrEnd[0] = Quote) then
-      while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
-        Inc(pStrEnd);
-
-    if (pStrEnd[0] = Delimiter) then
-     Inc(pStrEnd);
+    Inc(Dest, MaxLen+1);
    end;
-
-  Result := ret;
 end;
 
 function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
 const
- QuoteDelimiter='"';
+  CR: char = #13;
+  LF: char = #10;
+  DQ: char = '"';
 var
-  Str : String;
-  p, i : Integer;
+  Src: PChar;
+  S : String;
+  i, MaxLen, Len : Integer;
   QuoteMe: boolean;
 begin
   Result := '';
-  p := 1;
+  Src := PChar(Buffer);
   for i := 0 to FieldDefs.Count - 1 do
   begin
+    MaxLen := FieldDefs[i].Size;
+    Len := StrLen(Src); // field values are null-terminated in record buffer
+    if Len > MaxLen then
+      Len := MaxLen;
+    SetString(S, Src, Len);
+    Inc(Src, MaxLen+1);
+
     QuoteMe:=false;
-    Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
-    Inc(p, FieldDefs[i].Size);
     if FMultiLine then
       begin
-       // If multiline enabled, quote whenever we find carriage return or linefeed
-       if (not QuoteMe) and (StrScan(PChar(Str), #10) <> nil) then QuoteMe:=true;
-       if (not QuoteMe) and (StrScan(PChar(Str), #13) <> nil) then QuoteMe:=true;
+      // If multiline enabled, quote whenever we find carriage return or linefeed
+      if (not QuoteMe) and ((Pos(CR, S) > 0) or (Pos(LF, S) > 0)) then QuoteMe:=true;
       end
     else
       begin
-       // If we don't allow multiline, remove all CR and LF because they mess with the record ends:
-       Str := StringReplace(Str, #10, '', [rfReplaceAll]);
-       Str := StringReplace(Str, #13, '', [rfReplaceAll]);
-      end;
-    // Check for any delimiters or quotes occurring in field text  
-    if (not QuoteMe) then
-	  if (StrScan(PChar(Str), FDelimiter) <> nil) or
-	    (StrScan(PChar(Str), QuoteDelimiter) <> nil) then QuoteMe:=true;
-    if (QuoteMe) then
-      begin
-      Str := Stringreplace(Str, QuoteDelimiter, QuoteDelimiter+QuoteDelimiter, [rfReplaceAll]);
-      Str := QuoteDelimiter + Str + QuoteDelimiter;
+      // If we don't allow multiline, remove all CR and LF because they mess with the record ends:
+      S := StringReplace(S, CR, '', [rfReplaceAll]);
+      S := StringReplace(S, LF, '', [rfReplaceAll]);
       end;
-    Result := Result + Str + FDelimiter;
+
+    // Check for any delimiters or quotes occurring in field text
+    if not QuoteMe then
+      QuoteMe := (Pos(FDelimiter, S) > 0) or (Pos(DQ, S) > 0);
+
+    if QuoteMe then
+      S := AnsiQuotedStr(S, DQ);
+
+    Result := Result + S + FDelimiter;
   end;
   DoStripTrailingDelimiters(Result)
 end;
 
 procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String);
-
 var
   L,P : integer;
 begin
-//  Write('S "',S,'" -> "');
   L:=Length(S);
   P:=L;
   while (P>0) and (S[P]=FDelimiter) and ((P=L) or StripTrailingDelimiters) do
     Dec(P);
   if P<L then
     S:=Copy(S,1,P);
-//  Writeln(s,'"');
 end;
 
 procedure TSdfDataSet.SetDelimiter(Value : Char);

+ 2 - 1
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -731,7 +731,7 @@ begin
     BlockSize:=isc_vax_integer(@resbuf[1],2);
     IBStatementType:=isc_vax_integer(@resbuf[3],blockSize);
     assert(resbuf[3+blockSize]=isc_info_end);
-    // If the statementtype is isc_info_sql_stmt_exec_procedure then
+    // If the StatementType is isc_info_sql_stmt_exec_procedure then
     // override the statement type derived by parsing the query.
     // This to recognize statements like 'insert into .. returning' correctly
     case IBStatementType of
@@ -753,6 +753,7 @@ begin
         if isc_dsql_describe(@Status[0], @Statement, 1, SQLDA) <> 0 then
           CheckError('PrepareSelect', Status);
         end;
+      FSelectable := SQLDA^.SQLD > 0;
       {$push}
       {$R-}
       for x := 0 to SQLDA^.SQLD - 1 do with SQLDA^.SQLVar[x] do

+ 8 - 11
packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

@@ -767,30 +767,27 @@ end;
 
 function TOracleConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
 var
-  x_flags : ub4;
+  flags : ub4;
   i : Integer;
   s : string;
   locTrans : TOracleTrans;
 begin
-  locTrans := TOracleTrans(trans);
-  if ( Length(AParams) = 0 ) then begin
-    x_flags := OCI_TRANS_NEW or OCI_TRANS_READWRITE;
-  end else begin
-    x_flags := OCI_DEFAULT;
+  flags := OCI_TRANS_READWRITE;
+  if AParams <> '' then begin
     i := 1;
     s := ExtractSubStr(AParams,i,StdWordDelims);
     while ( s <> '' ) do begin
       if ( s = 'readonly' ) then
-        x_flags := x_flags and OCI_TRANS_READONLY
+        flags := OCI_TRANS_READONLY
       else if ( s = 'serializable' ) then
-        x_flags := x_flags and OCI_TRANS_SERIALIZABLE
+        flags := OCI_TRANS_SERIALIZABLE
       else if ( s = 'readwrite' ) then
-        x_flags := x_flags and OCI_TRANS_READWRITE;
+        flags := OCI_TRANS_READWRITE;
       s := ExtractSubStr(AParams,i,StdWordDelims);
     end;
-    x_flags := x_flags and OCI_TRANS_NEW;
   end;
-  locTrans.FOciFlags := x_flags;
+  locTrans := TOracleTrans(trans);
+  locTrans.FOciFlags := flags or OCI_TRANS_NEW;
   InternalStartDBTransaction(locTrans);
   Result := True;
 end;

+ 3 - 1
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -89,12 +89,14 @@ type
     FConnectString       : string;
     FIntegerDateTimes    : boolean;
     FVerboseErrors       : Boolean;
+  protected
+    // Protected so they can be used by descendents.
     procedure CheckConnectionStatus(var conn: PPGconn);
     procedure CheckResultError(var res: PPGresult; conn:PPGconn; ErrMsg: string);
     function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer; Out ATypeOID : oid) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
     Procedure GetExtendedFieldInfo(cursor: TPQCursor; Bindings : TFieldBindings);
-  protected
+
     procedure ApplyFieldUpdate(C : TSQLCursor; P: TSQLDBParam; F: TField; UseOldValue: Boolean); override;
     Function ErrorOnUnknownType : Boolean;
     // Add connection to pool.

+ 31 - 23
packages/fcl-db/src/sqldb/sqldb.pp

@@ -1224,7 +1224,7 @@ begin
     DatabaseError(SErrTransactionnSet);
 
   if not Connected then Open;
-  if not (ATransaction.Active or (stoUseImplicit in ATransaction.Options)) then
+  if not ATransaction.Active then
     ATransaction.MaybeStartTransaction;
 
   try
@@ -1663,7 +1663,7 @@ var x          : integer;
 begin
   sql_fields := '';
   sql_values := '';
-  returning_fields :='';
+  returning_fields := '';
   for x := 0 to Query.Fields.Count -1 do
     begin
     F:=Query.Fields[x];
@@ -1673,7 +1673,7 @@ begin
       sql_values := sql_values + ':"' + F.FieldName + '",';
       end;
     if ReturningClause and (pfRefreshOnInsert in F.ProviderFlags) then
-      returning_fields :=returning_fields+FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
+      returning_fields := returning_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
     end;
   if length(sql_fields) = 0 then
     DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
@@ -1686,7 +1686,7 @@ begin
     if ReturningClause then
       begin
       setlength(returning_fields,length(returning_fields)-1);
-      result:=Result+' returning '+returning_fields;
+      Result := Result + ' returning ' + returning_fields;
       end;
     end;
 end;
@@ -1704,7 +1704,7 @@ var x : integer;
 begin
   sql_set := '';
   sql_where := '';
-  returning_fields :='';
+  returning_fields := '';
   for x := 0 to Query.Fields.Count -1 do
     begin
     F:=Query.Fields[x];
@@ -1712,7 +1712,7 @@ begin
     if (pfInUpdate in F.ProviderFlags) and (not F.ReadOnly) then
       sql_set := sql_set +FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] +'=:"' + F.FieldName + '",';
     if ReturningClause and (pfRefreshOnUpdate in F.ProviderFlags) then
-      returning_fields :=returning_fields+FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
+      returning_fields := returning_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
     end;
   if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
   setlength(sql_set,length(sql_set)-1);
@@ -1724,7 +1724,7 @@ begin
     if ReturningClause then
       begin
       setlength(returning_fields,length(returning_fields)-1);
-      result:=Result+' returning '+returning_fields;
+      Result := Result + ' returning ' + returning_fields;
       end;
     end;
 end;
@@ -1753,10 +1753,10 @@ Var
   Where : String;
 
 begin
-  Where:='';
   Result:=Query.RefreshSQL.Text;
   if (Result='') then
     begin
+    Where:='';
     PF:=RefreshFlags[UpdateKind];
     For F in Query.Fields do
       begin
@@ -1773,7 +1773,7 @@ begin
         begin
         if (Where<>'') then
           Where:=Where+' AND ';
-        Where:=Where+'('+FieldNameQuoteChars[0]+F.FieldName+FieldNameQuoteChars[0]+' = :'+F.FieldName+')';
+        Where:=Where+'('+FieldNameQuoteChars[0]+F.FieldName+FieldNameQuoteChars[1]+' = :'+F.FieldName+')';
         end;
       end;
     if (Where='') then
@@ -1804,31 +1804,37 @@ var
 
 begin
   qry:=Nil;
-  ReturningClause:=(sqSupportReturning in Connoptions) and not (sqoRefreshUsingSelect in Query.Options);
+  ReturningClause:=(sqSupportReturning in ConnOptions) and not (sqoRefreshUsingSelect in Query.Options) and (Query.RefreshSQL.Count=0);
   case UpdateKind of
     ukInsert : begin
-               s := trim(Query.FInsertSQL.Text);
+               s := Trim(Query.FInsertSQL.Text);
                if s = '' then
-                 s := ConstructInsertSQL(Query,ReturningClause);
-               qry := InitialiseUpdateStatement(Query,Query.FInsertQry);
+                 s := ConstructInsertSQL(Query, ReturningClause)
+               else
+                 ReturningClause := False;
+               qry := InitialiseUpdateStatement(Query, Query.FInsertQry);
                end;
     ukModify : begin
-               s := trim(Query.FUpdateSQL.Text);
-               if (s='') and (not assigned(Query.FUpdateQry) or (Query.UpdateMode<>upWhereKeyOnly)) then //first time or dynamic where part
-                 s := ConstructUpdateSQL(Query,ReturningClause);
-               qry := InitialiseUpdateStatement(Query,Query.FUpdateQry);
+               s := Trim(Query.FUpdateSQL.Text);
+               if s = '' then begin
+                 //if not assigned(Query.FUpdateQry) or (Query.UpdateMode<>upWhereKeyOnly) then // first time or dynamic where part
+                   s := ConstructUpdateSQL(Query, ReturningClause);
+               end
+               else
+                 ReturningClause := False;
+               qry := InitialiseUpdateStatement(Query, Query.FUpdateQry);
                end;
     ukDelete : begin
-               s := trim(Query.FDeleteSQL.Text);
+               s := Trim(Query.FDeleteSQL.Text);
                if (s='') and (not assigned(Query.FDeleteQry) or (Query.UpdateMode<>upWhereKeyOnly)) then
                  s := ConstructDeleteSQL(Query);
-               qry := InitialiseUpdateStatement(Query,Query.FDeleteQry);
-               ReturningClause:=False;
+               ReturningClause := False;
+               qry := InitialiseUpdateStatement(Query, Query.FDeleteQry);
                end;
   end;
   if (s<>'') and (qry.SQL.Text<>s) then
     qry.SQL.Text:=s; //assign only when changed, to avoid UnPrepare/Prepare
-  Assert(qry.sql.Text<>'');
+  Assert(qry.SQL.Text<>'');
   for x:=0 to Qry.Params.Count-1 do
     begin
     P:=Qry.Params[x];
@@ -1840,13 +1846,15 @@ begin
     ApplyFieldUpdate(Query.Cursor,P as TSQLDBParam,Fld,B);
     end;
   if ReturningClause then
+    begin
+    Qry.Close;
     Qry.Open
+    end
   else
     Qry.Execute;
   if (scoApplyUpdatesChecksRowsAffected in Options) and (Qry.RowsAffected<>1) then
     begin
-    if ReturningClause then
-      Qry.Close;
+    Qry.Close;
     DatabaseErrorFmt(SErrFailedToUpdateRecord, [Qry.RowsAffected], Query);
     end;
   if ReturningClause then

+ 35 - 9
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -88,6 +88,8 @@ type
     constructor Create(AOwner : TComponent); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
+    procedure CreateDB; override;
+    procedure DropDB; override;
     function GetInsertID: int64;
     // See http://www.sqlite.org/c3ref/create_collation.html for detailed information
     // If eTextRep=0 a default UTF-8 compare function is used (UTF8CompareCallback)
@@ -334,12 +336,12 @@ begin
   ABlobBuf^.BlobBuffer^.Size := int1;
 end;
 
-Function TSQLite3Connection.AllocateTransactionHandle: TSQLHandle;
+function TSQLite3Connection.AllocateTransactionHandle: TSQLHandle;
 begin
  result:= tsqlhandle.create;
 end;
 
-Function TSQLite3Connection.AllocateCursorHandle: TSQLCursor;
+function TSQLite3Connection.AllocateCursorHandle: TSQLCursor;
 
 Var
   Res : TSQLite3Cursor;
@@ -350,7 +352,7 @@ begin
   Result:=Res;
 end;
 
-Procedure TSQLite3Connection.DeAllocateCursorHandle(var cursor: TSQLCursor);
+procedure TSQLite3Connection.DeAllocateCursorHandle(var cursor: TSQLCursor);
 begin
   freeandnil(cursor);
 end;
@@ -778,15 +780,15 @@ end;
 
 procedure TSQLite3Connection.DoInternalConnect;
 var
-  str1: string;
+  filename: ansistring;
 begin
   Inherited;
-  if Length(databasename)=0 then
+  if DatabaseName = '' then
     DatabaseError(SErrNoDatabaseName,self);
-  if (SQLiteLoadedLibrary='') then
+  if SQLiteLoadedLibrary = '' then
     InitializeSqlite(SQLiteDefaultLibrary);
-  str1:= databasename;
-  checkerror(sqlite3_open(pchar(str1),@fhandle));
+  filename := DatabaseName;
+  checkerror(sqlite3_open(PAnsiChar(filename),@fhandle));
   if (Length(Password)>0) and assigned(sqlite3_key) then
     checkerror(sqlite3_key(fhandle,PChar(Password),StrLen(PChar(Password))));
   if Params.IndexOfName('foreign_keys') <> -1 then
@@ -978,7 +980,7 @@ function TSQLite3Connection.GetConnectionInfo(InfoType: TConnInfoType): string;
 begin
   Result:='';
   try
-    InitializeSqlite(SQLiteDefaultLibrary);
+    InitializeSqlite;
     case InfoType of
       citServerType:
         Result:=TSQLite3ConnectionDef.TypeName;
@@ -997,6 +999,30 @@ begin
   end;
 end;
 
+procedure TSQLite3Connection.CreateDB;
+var filename: ansistring;
+begin
+  CheckDisConnected;
+  try
+    InitializeSqlite;
+    try
+      filename := DatabaseName;
+      checkerror(sqlite3_open(PAnsiChar(filename),@fhandle));
+    finally
+      sqlite3_close(fhandle);
+      fhandle := nil;
+    end;
+  finally
+    ReleaseSqlite;
+  end;
+end;
+
+procedure TSQLite3Connection.DropDB;
+begin
+  CheckDisConnected;
+  DeleteFile(DatabaseName);
+end;
+
 function UTF8CompareCallback(user: pointer; len1: longint; data1: pointer; len2: longint; data2: pointer): longint; cdecl;
 var S1, S2: AnsiString;
 begin

+ 29 - 27
packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -561,6 +561,8 @@ var
   TempItem: PDataRecord;
 begin
   Result := False;
+  if ABookmark = nil then
+    Exit;
   TempItem := FBeginItem^.Next;
   while TempItem <> FEndItem do
   begin
@@ -788,15 +790,13 @@ function TCustomSqliteDataset.GetRecNo: Integer;
 var
   TempItem, TempActive: PDataRecord;
 begin
-  Result := -1;
+  Result := 0;
   if (FRecordCount = 0) or (State = dsInsert) then
     Exit;  
   TempItem := FBeginItem;
   TempActive := PPDataRecord(ActiveBuffer)^;
   if TempActive = FCacheItem then // Record is being edited
     TempActive := FInternalActiveBuffer;
-  //RecNo is 1 based
-  Inc(Result);
   while TempActive <> TempItem do
   begin
     if TempItem^.Next <> nil then
@@ -806,9 +806,8 @@ begin
     end  
     else
     begin
-      Result := -1;
+      Result := 0;
       DatabaseError('GetRecNo - ActiveItem Not Found', Self);
-      break;
     end;      
   end;  
 end;
@@ -883,14 +882,16 @@ var
 begin
   Dec(FRecordCount);
   TempItem := PPDataRecord(ActiveBuffer)^;
+  if TempItem = FCacheItem then // Record is being edited
+    TempItem := FInternalActiveBuffer;
   TempItem^.Next^.Previous := TempItem^.Previous;
   TempItem^.Previous^.Next := TempItem^.Next;
   if FCurrentItem = TempItem then
   begin
-    if FCurrentItem^.Previous <> FBeginItem then
-      FCurrentItem := FCurrentItem^.Previous
+    if FCurrentItem^.Next <> FEndItem then
+      FCurrentItem := FCurrentItem^.Next
     else
-      FCurrentItem := FCurrentItem^.Next;  
+      FCurrentItem := FCurrentItem^.Previous;  
   end; 
   // Dec FNextAutoInc (only if deleted item is the last record)  
   if FAutoIncFieldNo <> -1 then
@@ -1422,39 +1423,40 @@ begin
   end;
 end;
 
-// Specific functions 
+// Specific functions
 
-procedure TCustomSqliteDataset.SetDetailFilter;
-  function FieldToSqlStr(AField: TField): String;
+function GetFieldEqualExpression(AField: TField): String;
+begin
+  if not AField.IsNull then
   begin
-    if not AField.IsNull then
-    begin
-      case AField.DataType of
-        //todo: handle " caracter properly
-        ftString, ftMemo:
-          Result := '"' + AField.AsString + '"';
-        ftDateTime, ftDate, ftTime:
-          Str(AField.AsDateTime, Result);
-      else
-        Result := AField.AsString;
-      end; //case
-    end
+    case AField.DataType of
+      //todo: handle " caracter properly
+      ftString, ftMemo:
+        Result := '"' + AField.AsString + '"';
+      ftDateTime, ftDate, ftTime:
+        Str(AField.AsDateTime, Result);
     else
-      Result:=NullString;
-  end; //function
+      Result := AField.AsString;
+    end; //case
+    Result := ' = ' + Result;
+  end
+  else
+    Result := ' IS NULL';
+end;
 
+procedure TCustomSqliteDataset.SetDetailFilter;
 var
   AFilter: String;
   i: Integer;
 begin
-  if not FMasterLink.Active or (FMasterLink.Dataset.RecordCount = 0) then //Retrieve all data
+  if not FMasterLink.Active then //Retrieve all data
     FEffectiveSQL := FSqlFilterTemplate
   else
   begin
     AFilter := ' where ';
     for i := 0 to FMasterLink.Fields.Count - 1 do
     begin
-      AFilter := AFilter + IndexFields[i].FieldName + ' = ' + FieldToSqlStr(TField(FMasterLink.Fields[i]));
+      AFilter := AFilter + IndexFields[i].FieldName + GetFieldEqualExpression(TField(FMasterLink.Fields[i]));
       if i <> FMasterLink.Fields.Count - 1 then
         AFilter := AFilter + ' and ';
     end;

+ 7 - 1
packages/fcl-db/tests/database.ini.txt

@@ -228,4 +228,10 @@ connector=bufdataset
 ; sdfdataset file-based dataset:
 connector=sdfds
 ; subdirectory for the sdf files:
-name=sdftest
+name=sdftest
+
+[sqlite3dataset]
+; TSqlite3Dataset dataset:
+connector=sqlite3ds
+; datafile
+name=testsqlite3ds.db

+ 20 - 3
packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -18,7 +18,7 @@
     <VersionInfo>
       <StringTable ProductVersion=""/>
     </VersionInfo>
-    <BuildModes Count="4">
+    <BuildModes Count="5">
       <Item1 Name="Default" Default="True"/>
       <Item2 Name="debug">
         <CompilerOptions>
@@ -55,6 +55,18 @@
           </CodeGeneration>
         </CompilerOptions>
       </Item4>
+      <Item5 Name="TestSqlite3DS">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf;../src/export"/>
+          </SearchPaths>
+          <Other>
+            <CustomOptions Value="-dTEST_SQLITE3DS"/>
+          </Other>
+        </CompilerOptions>
+      </Item5> 
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
@@ -80,10 +92,11 @@
         <PackageName Value="FCL"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="4">
       <Unit0>
         <Filename Value="dbtestframework_gui.lpr"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="DBGuiTestRunner"/> 
       </Unit0>
       <Unit1>
         <Filename Value="dbguitestrunner.pas"/>
@@ -92,8 +105,12 @@
       <Unit2>
         <Filename Value="tccsvdataset.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tccsvdataset"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="sqlite3dstoolsunit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Sqlite3DSToolsUnit"/>
+      </Unit3>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 6 - 2
packages/fcl-db/tests/dbtestframework_gui.lpr

@@ -24,7 +24,9 @@ uses
   bufdatasettoolsunit,
   memdstoolsunit,
   SdfDSToolsUnit,
-  tcsdfdata,
+{$IFDEF TEST_SQLITE3DS}
+  Sqlite3DSToolsUnit,
+{$ENDIF}
   // DB unittest
   TestBasics,
   TestDBBasics,
@@ -35,7 +37,9 @@ uses
   TestSpecificTBufDataset,
   TestSpecificTDBF,
   TestSpecificTMemDataset,
-  TestDBExport, tccsvdataset;
+  tcsdfdata,
+  tccsvdataset,
+  TestDBExport;
 
 {$R *.res}
 

+ 12 - 2
packages/fcl-db/tests/memdstoolsunit.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, toolsunit,
   db,
-  Memds;
+  MemDS;
 
 type
 { TMemDSConnector }
@@ -81,7 +81,7 @@ begin
   testTimeValues[2] := '23:59:59.000';
   testTimeValues[3] := '23:59:59.003';
 
-  MemDs := TMemDataset.Create(nil);
+  MemDS := TMemDataset.Create(nil);
   with MemDS do
     begin
     Name := 'FieldDataset';
@@ -100,6 +100,11 @@ begin
     FieldDefs.Add('FFIXEDCHAR',ftFixedChar,10);
     FieldDefs.Add('FLARGEINT',ftLargeint);
     FieldDefs.Add('FFMTBCD',ftFmtBCD);
+    FieldDefs.Add('FBLOB',ftBlob);
+    FieldDefs.Add('FMEMO',ftMemo);
+    FieldDefs.Add('FWIDESTRING',ftWideString);
+    FieldDefs.Add('FFIXEDWIDECHAR',ftFixedWideChar);
+    FieldDefs.Add('FWIDEMEMO',ftWideMemo);
     CreateTable;
     Open;
     for i := 0 to testValuesCount-1 do
@@ -120,6 +125,11 @@ begin
       FieldByName('FFIXEDCHAR').AsString := PadRight(testStringValues[i], 10);
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       FieldByName('FFMTBCD').AsBCD := StrToBCD(testFmtBCDValues[i], Self.FormatSettings);
+      FieldByName('FBLOB').AsString := testValues[ftBlob, i];
+      FieldByName('FMEMO').AsString := testValues[ftMemo, i];
+      FieldByName('FWIDESTRING').AsWideString := testValues[ftWideString, i];
+      FieldByName('FFIXEDWIDECHAR').AsWideString := testValues[ftFixedWideChar, i];
+      FieldByName('FWIDEMEMO').AsWideString := testValues[ftWideMemo, i];
       Post;
       end;
     Close;

+ 3 - 3
packages/fcl-db/tests/sdfdstoolsunit.pas

@@ -88,7 +88,7 @@ begin
     ForceDirectories(dbname);
     DeleteFile(FileName);
     FileMustExist:=False;
-    
+
     SetFieldDatasetSchema(Schema);
 
     Open;
@@ -133,10 +133,10 @@ begin
     begin
     FileName := dbname+PathDelim+'fpdev_field.dat';
     SetFieldDatasetSchema(Schema);
+    TrimSpace := False;
     end;
 end;
 
 initialization
   RegisterClass(TSdfDSDBConnector);
-end.
-
+end.

+ 203 - 0
packages/fcl-db/tests/sqlite3dstoolsunit.pas

@@ -0,0 +1,203 @@
+unit Sqlite3DSToolsUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, toolsunit
+  ,db, Sqlite3DS
+  ;
+
+
+const
+  STestNotApplicable = 'This test does not apply to this sqlite3ds connection type';
+
+
+type
+  { TSqlite3DSDBConnector }
+
+  TSqlite3DSDBConnector = class(TDBConnector)
+  private
+    FDataset: TSqlite3Dataset;
+    Function CreateDataset: TSqlite3Dataset;
+  protected
+    procedure CreateNDatasets; override;
+    procedure CreateFieldDataset; override;
+    procedure DropNDatasets; override;
+    procedure DropFieldDataset; override;
+    Function InternalGetNDataset(n : integer) : TDataset; override;
+    Function InternalGetFieldDataset : TDataSet; override;
+  public
+    procedure TryDropIfExist(const ATableName : String);
+    destructor Destroy; override;
+    constructor Create; override;
+    procedure ExecuteDirect(const SQL: string);
+  end;
+
+
+implementation
+
+{ TSqlite3DSDBConnector }
+
+function TSqlite3DSDBConnector.CreateDataset: TSqlite3Dataset;
+
+begin
+  Result := TSqlite3Dataset.create(nil);
+  Result.FileName := dbname;
+end;
+
+procedure TSqlite3DSDBConnector.CreateNDatasets;
+var CountID : Integer;
+begin
+  try
+    TryDropIfExist('FPDEV');
+    FDataset.ExecSQL('create table FPDEV (' +
+                              '  ID INT NOT NULL,  ' +
+                              '  NAME VARCHAR(50), ' +
+                              '  PRIMARY KEY (ID)  ' +
+                              ')');
+    FDataset.ExecSQL('BEGIN;');
+    for countID := 1 to MaxDataSet do
+      FDataset.ExecSQL('insert into FPDEV (ID,NAME) ' +
+                                'values ('+inttostr(countID)+',''TestName'+inttostr(countID)+''')');
+    FDataset.ExecSQL('COMMIT;');
+  except
+    on E: Exception do begin
+      if dblogfilename<>'' then
+        LogMessage('Custom','Exception running CreateNDatasets: '+E.Message);
+      FDataset.ExecSQL('ROLLBACK;');
+    end;
+  end;
+end;
+
+procedure TSqlite3DSDBConnector.CreateFieldDataset;
+var
+  FieldDataset: TSqlite3Dataset;
+  i: Integer;
+
+begin
+  FieldDataset := CreateDataset;
+  try
+    TryDropIfExist('FPDEV_FIELD');
+    with FieldDataset do
+    begin
+       TableName := 'FPDEV_FIELD';
+       PrimaryKey := 'ID';
+       FieldDefs.Add('ID', ftInteger);
+       FieldDefs.Add('FSTRING', ftString, 10);
+       //FieldDefs.Add('FSMALLINT', ftSmallint);
+       FieldDefs.Add('FINTEGER', ftInteger);
+       FieldDefs.Add('FWORD', ftWord);
+       FieldDefs.Add('FBOOLEAN', ftBoolean);
+       FieldDefs.Add('FFLOAT', ftFloat);
+       FieldDefs.Add('FCURRENCY', ftCurrency);
+       //FieldDefs.Add('FBCD', ftBCD);
+       FieldDefs.Add('FDATE', ftDate);
+       FieldDefs.Add('FDATETIME', ftDateTime);
+       FieldDefs.Add('FLARGEINT', ftLargeint);
+       FieldDefs.Add('FMEMO', ftMemo);
+       if not CreateTable then
+         raise Exception.Create('Error in CreateTable: ' + FieldDataset.ReturnString);
+       Open;
+       for i := 0 to testValuesCount - 1 do
+       begin
+         Append;
+         FieldByName('ID').AsInteger := i;
+         FieldByName('FSTRING').AsString := testStringValues[i];
+         //FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
+         FieldByName('FINTEGER').AsInteger := testIntValues[i];
+         FieldByName('FWORD').AsInteger := testWordValues[i];
+         FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
+         FieldByName('FFLOAT').AsFloat := testFloatValues[i];
+         FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
+         // work around missing TBCDField.AsBCD:
+         //  FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i],Self.FormatSettings);
+         FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
+         FieldByName('FDATETIME').AsDateTime := StrToDateTime(testValues[ftDateTime,i], Self.FormatSettings);
+         FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
+         FieldByName('FMEMO').AsString := testStringValues[i];
+         Post;
+       end;
+       if not ApplyUpdates then
+         raise Exception.Create('Error in ApplyUpdates: ' + FieldDataset.ReturnString);
+       Destroy;
+     end;
+  except
+    on E: Exception do begin
+      if dblogfilename<>'' then
+        LogMessage('Custom','Exception running CreateFieldDataset: '+E.Message);
+      FDataset.ExecSQL('ROLLBACK;');
+    end;
+  end;
+end;
+
+procedure TSqlite3DSDBConnector.DropNDatasets;
+begin
+  try
+    FDataset.ExecSQL('DROP TABLE FPDEV');
+  Except
+    on E: Exception do begin
+      if dblogfilename<>'' then
+        LogMessage('Custom','Exception running DropNDatasets: '+E.Message);
+      FDataset.ExecSQL('ROLLBACK;');
+    end;
+  end;
+end;
+
+procedure TSqlite3DSDBConnector.DropFieldDataset;
+begin
+  try
+    FDataset.ExecSQL('DROP TABLE FPDEV_FIELD');
+  Except
+    on E: Exception do begin
+      if dblogfilename<>'' then
+        LogMessage('Custom','Exception running DropFieldDataset: '+E.Message);
+      FDataset.ExecSQL('ROLLBACK;');
+    end;
+  end;
+end;
+
+function TSqlite3DSDBConnector.InternalGetNDataset(n: integer): TDataset;
+begin
+  Result := CreateDataset;
+  with (Result as TSqlite3Dataset) do
+    begin
+    sql := 'SELECT * FROM FPDEV WHERE ID < '+inttostr(n+1)+' ORDER BY ID';
+    end;
+end;
+
+function TSqlite3DSDBConnector.InternalGetFieldDataset: TDataSet;
+begin
+  Result := CreateDataset;
+  with (Result as TSqlite3Dataset) do
+    begin
+    sql := 'SELECT * FROM FPDEV_FIELD';
+    end;
+end;
+
+procedure TSqlite3DSDBConnector.TryDropIfExist(const ATableName: String);
+begin
+  FDataset.ExecSQL('drop table if exists ' + ATableName);
+end;
+
+procedure TSqlite3DSDBConnector.ExecuteDirect(const SQL: string);
+begin
+  FDataset.ExecSQL(SQL);
+end;
+
+destructor TSqlite3DSDBConnector.Destroy;
+begin
+  inherited Destroy;
+  FDataset.Destroy;
+end;
+
+constructor TSqlite3DSDBConnector.Create;
+begin
+  FDataset := CreateDataset;
+  Inherited;
+end;
+
+initialization
+  RegisterClass(TSqlite3DSDBConnector);
+end.

+ 177 - 102
packages/fcl-db/tests/tcsdfdata.pp

@@ -1,5 +1,6 @@
 unit tcsdfdata;
-// Tests specific functionality of sdfdataset (multiline etc)
+// Tests specific functionality of SdfDataSet (multiline etc)
+//                             and FixedFormatDataSet
 
 {$mode objfpc}{$H+}
 
@@ -11,13 +12,13 @@ uses
 
 type
 
-  { Ttestsdfspecific }
+  { TTestSdfSpecific }
 
-  Ttestsdfspecific = class(Ttestcase)
+  TTestSdfSpecific = class(TTestCase)
   private
+    TestDataset: TSdfDataset;
     function TestFileName(const FileName: string=''): string;
   protected
-    TestDataset: TSDFDataset;
     procedure Setup; override;
     procedure Teardown; override;
   published
@@ -26,12 +27,6 @@ type
     procedure TestSingleLineHeader;
     procedure TestSingleLineNoHeader;
     procedure TestOutput;
-    {
-    November 2012: this test tests again sdf;
-    however sdfdataset should comply with RFC4180 CSV, see issue #22980
-    todo: rewrite test to RFC4180
-    procedure TestInputOurFormat;
-    }
     procedure TestDelimitedTextOutput;
     procedure TestEmptyFieldHeader;
     Procedure TestEmptyFieldNoHeader;
@@ -40,6 +35,21 @@ type
     Procedure TestStripTrailingDelimiters;
   end;
 
+  { TTestFixedFormatSpecific }
+
+  TTestFixedFormatSpecific = class(TTestCase)
+  private
+    TestDataset: TFixedFormatDataset;
+    function TestFileName(const FileName: string=''): string;
+    procedure CreateTestFile;
+  protected
+    procedure Setup; override;
+    procedure Teardown; override;
+  published
+    procedure TestTrimSpace;
+    procedure TestNoTrimSpace;
+  end;
+
 implementation
 
 function Ttestsdfspecific.TestFileName(const FileName: string): string;
@@ -150,38 +160,43 @@ end;
 procedure Ttestsdfspecific.TestOutput;
 // Basic assignment test: assign some difficult data to records and
 // see if the RecordCount is correct.
+const
+  NAME: array[1..4] of string = (
+    'J"T"',                             // Data with quotes
+    'Hello, goodbye',                   // Data with delimiter
+    '  Just a line with spaces     ',   // Regular data
+    'Delimiter,"and";quote'             // Data with delimiter and quote
+  );
 var
   i: integer;
 begin
   // with Schema, with Header line
+  TestDataset.Schema[1] := 'NAME=30';
   TestDataset.FileName := TestFileName('output.csv');
   TestDataset.Open;
+
   // Fill test data
   TestDataset.Append;
   TestDataset.FieldByName('ID').AsInteger := 1;
-  // Data with quotes
-  TestDataset.FieldByName('NAME').AsString := 'J"T"';
+  TestDataset.FieldByName('NAME').AsString := NAME[1];
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.Post;
 
   TestDataset.Append;
   TestDataset.FieldByName('ID').AsInteger := 2;
-  // Data with delimiter
-  TestDataset.FieldByName('NAME').AsString := 'Hello'+TestDataset.Delimiter+' goodbye';
+  TestDataset.FieldByName('NAME').AsString := NAME[2];
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.Post;
 
   TestDataset.Append;
   TestDataset.FieldByName('ID').AsInteger := 4;
-  //Data with delimiter and quote (to test 19376)
-  TestDataset.FieldByName('NAME').AsString := 'Delimiter,"and";quote';
+  TestDataset.FieldByName('NAME').AsString := NAME[4];
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.Post;
 
   TestDataset.Insert;
   TestDataset.FieldByName('ID').AsInteger := 3;
-  // Regular data
-  TestDataset.FieldByName('NAME').AsString := 'Just a long line of text without anything special';
+  TestDataset.FieldByName('NAME').AsString := NAME[3];
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.Post;
 
@@ -201,73 +216,15 @@ begin
   AssertEquals('RecordCount', 4, TestDataset.RecordCount);
   TestDataset.Close;
   AssertEquals('RecordCount after Close', 0, TestDataset.RecordCount);
-end;
-
-{
-procedure Ttestsdfspecific.TestInputOurFormat;
-// Test if input works as expected: output is written according to specs and read in.
-// Mainly check if reading quotes is according to Delphi sdf specs and works.
-// See test results from bug 19610 for evidence that the strings below should work.
-// If this works, we can switch to this and be RFC 4180 compliant and Delphi compliant.
-const
-  OutputFileName='input.csv';
-  //Value1 is the on disk format; it should translate to Expected1
-  Value1='"Delimiter,""and"";quote"';
-  Expected1='Delimiter,"and";quote';
-  Value2='"J""T"""';
-  Expected2='J"T"';
-  Value3='Just a long line';
-  Expected3='Just a long line';
-  //Note: Delphi can read this, see evidence in bug 19610 (the "quoted and space" value)
-  Value4='"Just a quoted long line"';
-  Expected4='Just a quoted long line';
-  // Delphi can read multiline, see evidence in bug 19610 (the multiline entry)
-  Value5='"quoted_multi'+#13+#10+'line"';
-  Expected5='quoted_multi'+#13+#10+'line';
-  Value6='"Delimiter,and;quoted"';
-  Expected6='Delimiter,and;quoted';
-  Value7='"A random""quote"';
-  Expected7='A random"quote';
-var
-  FileStrings: TStringList;
-begin
-  TestDataset.Close;
-  TestDataset.AllowMultiLine:=true;
-  if FileExists(OutputFilename) then DeleteFile(OutputFileName);
-  FileStrings:=TStringList.Create;
-  try
-    FileStrings.Add('ID,NAME,BIRTHDAY');
-    FileStrings.Add('1,'+Value1+',31-12-1976');
-    FileStrings.Add('2,'+Value2+',31-12-1976');
-    FileStrings.Add('3,'+Value3+',31-12-1976');
-    FileStrings.Add('4,'+Value4+',31-12-1976');
-    FileStrings.Add('5,'+Value5+',31-12-1976');
-    FileStrings.Add('6,'+Value6+',31-12-1976');
-    FileStrings.Add('7,'+Value7+',31-12-1976');
-    FileStrings.SaveToFile(OutputFileName);
-  finally
-    FileStrings.Free;
-  end;
 
-  // Load our dataset
-  TestDataset.FileName:=OutputFileName;
+  // reopen, retest
   TestDataset.Open;
-  TestDataset.First;
-  AssertEquals(Expected1, TestDataSet.FieldByName('NAME').AsString);
-  TestDataSet.Next;
-  AssertEquals(Expected2, TestDataSet.FieldByName('NAME').AsString);
-  TestDataSet.Next;
-  AssertEquals(Expected3, TestDataSet.FieldByName('NAME').AsString);
-  TestDataSet.Next;
-  AssertEquals(Expected4, TestDataSet.FieldByName('NAME').AsString);
-  TestDataSet.Next;
-  AssertEquals(Expected5, TestDataSet.FieldByName('NAME').AsString);
-  TestDataSet.Next;
-  AssertEquals(Expected6, TestDataSet.FieldByName('NAME').AsString);
-  TestDataSet.Next;
-  AssertEquals(Expected7, TestDataSet.FieldByName('NAME').AsString);
+  for i:=1 to 4 do begin
+    AssertEquals(NAME[i], TestDataset.FieldByName('NAME').AsString);
+    TestDataset.Next;
+  end;
+  AssertTrue('Eof', TestDataset.Eof);
 end;
-}
 
 procedure Ttestsdfspecific.TestDelimitedTextOutput;
 // Test if saving and loading data keeps the original values.
@@ -298,16 +255,16 @@ begin
   Close(F);
   // Load our dataset
   TestDataset.Open;
-//  AssertEquals('Field count',7,TEstDataset.Fielddefs.Count);
-//  AssertEquals('Record count',1,TEstDataset.RecordCount);
+//  AssertEquals('Field count',7,TestDataset.FieldDefs.Count);
+//  AssertEquals('Record count',1,TestDataset.RecordCount);
   TestDataset.First;
-  AssertEquals('Field1',Value1, TestDataSet.Fields[0].AsString);
-  AssertEquals('Field2',Value2, TestDataSet.Fields[1].AsString);
-  AssertEquals('Field3',Value3, TestDataSet.Fields[2].AsString);
-  AssertEquals('Field4',Value4, TestDataSet.Fields[3].AsString);
-  AssertEquals('Field5',Value5, TestDataSet.Fields[4].AsString);
-  AssertEquals('Field6',Value6, TestDataSet.Fields[5].AsString);
-  AssertEquals('Field7',Value7, TestDataSet.Fields[6].AsString);
+  AssertEquals('Field1', Value1, TestDataSet.Fields[0].AsString);
+  AssertEquals('Field2', Value2, TestDataSet.Fields[1].AsString);
+  AssertEquals('Field3', Value3, TestDataSet.Fields[2].AsString);
+  AssertEquals('Field4', Value4, TestDataSet.Fields[3].AsString);
+  AssertEquals('Field5', Value5, TestDataSet.Fields[4].AsString);
+  AssertEquals('Field6', Value6, TestDataSet.Fields[5].AsString);
+  AssertEquals('Field7' ,Value7, TestDataSet.Fields[6].AsString);
 end;
 
 procedure Ttestsdfspecific.TestEmptyFieldContents;
@@ -353,7 +310,7 @@ procedure Ttestsdfspecific.TestEmptyFieldNoHeader;
 
 Var
   F : Text;
-  S : String;
+  S1,S2 : String;
 
 begin
   // without Schema, without Header line
@@ -367,19 +324,30 @@ begin
   Writeln(F,'value1;value2;;;');
   Close(F);
 
-  TestDataset.Open;
-  AssertEquals('FieldDefs.Count',5,TestDataset.FieldDefs.Count);
-  AssertEquals('RecordCount', 1, TestDataset.RecordCount);
-  TestDataset.Edit;
-  TestDataset.Fields[0].AsString:='Value1';
-  TestDataset.Post;
-  TestDataset.Close;
+  with TestDataset do begin
+    Open;
+    AssertEquals('FieldDefs.Count', 5, FieldDefs.Count);
+    AssertEquals('RecordCount', 1, RecordCount);
+    // #1 record
+    Edit;
+    Fields[0].AsString := 'Value1';
+    Post;
+    AssertEquals('Fields[4]', '', Fields[4].AsString);
+    // #2 record
+    Append;
+    Fields[1].AsString := 'Value2';
+    Fields[2].AsString := 'Value"'; // embedded double quote
+    Post;
+    Close;
+  end;
 
   Assign(F, TestDataset.FileName);
   Reset(F);
-  ReadLn(F,S);
+  ReadLn(F,S1);
+  ReadLn(F,S2);
   Close(F);
-  AssertEquals('No data lost','Value1;value2;;;',S);
+  AssertEquals('Value1;value2;;;',S1);
+  AssertEquals(';Value2;"Value""";;',S2);
 end;
 
 procedure Ttestsdfspecific.TestEmptyFieldHeaderStripTrailingDelimiters;
@@ -457,6 +425,7 @@ begin
   TestDataset.Delimiter := ',';
   TestDataset.FileMustExist := False;
   TestDataset.FirstLineAsSchema := True;
+  TestDataset.TrimSpace := False;
   TestDataset.AllowMultiLine := False;
   TestDataset.Schema.Add('ID');
   TestDataset.Schema.Add('NAME');
@@ -479,13 +448,119 @@ begin
   end;
 end;
 
+
+{ TTestFixedFormatSpecific }
+
+procedure TTestFixedFormatSpecific.Setup;
+begin
+  TestDataset := TFixedFormatDataset.Create(nil);
+  TestDataset.FileMustExist := False;
+  TestDataset.Schema.Add('ID=1');
+  TestDataset.Schema.Add('NAME=10');
+  TestDataset.Schema.Add('BIRTHDAY=10');
+end;
+
+procedure TTestFixedFormatSpecific.Teardown;
+begin
+  TestDataSet.Close;
+  TestDataSet.Free;
+end;
+
+function TTestFixedFormatSpecific.TestFileName(const FileName: string): string;
+const
+  DefaultTestFileName = 'test.sdf';
+begin
+  if FileName = '' then
+    Result := DefaultTestFileName
+  else
+    Result := FileName;
+
+  if dbname <> '' then
+    begin
+    ForceDirectories(dbname);
+    Result := IncludeTrailingPathDelimiter(dbname) + Result;
+    end;
+
+  if FileExists(Result) then DeleteFile(Result);
+end;
+
+procedure TTestFixedFormatSpecific.CreateTestFile;
+var
+  FileStrings: TStringList;
+begin
+  FileStrings:=TStringList.Create;
+  try
+    FileStrings.Add('1John      2000-01-01');
+    FileStrings.Add('2Christiana2001-02-02');
+    FileStrings.SaveToFile(TestDataset.FileName);
+  finally
+    FileStrings.Free;
+  end;
+end;
+
+procedure TTestFixedFormatSpecific.TestTrimSpace;
+begin
+  TestDataset.FileName := TestFileName();
+  CreateTestFile;
+
+  with TestDataset do begin
+    Open;
+    AssertEquals('FieldDefs.Count', 3, FieldDefs.Count);
+    AssertEquals('1', Fields[0].AsString); // just after Open
+
+    Last;
+    First;
+    AssertEquals('RecNo', 1, RecNo);
+    AssertEquals('RecordCount', 2, RecordCount);
+    AssertEquals('1', Fields[0].AsString);
+    AssertEquals('John', Fields[1].AsString);
+    Next;
+    AssertEquals('2', Fields[0].AsString);
+    AssertEquals('Christiana', Fields[1].AsString);
+    Edit;
+    Fields[1].AsString := 'Chris';
+    Post;
+    AssertEquals('Chris', Fields[1].AsString);
+    Close; // save changes
+    AssertEquals('RecordCount after Close', 0, RecordCount);
+    Open;
+    Next;
+    AssertEquals('Chris', Fields[1].AsString);
+  end;
+end;
+
+procedure TTestFixedFormatSpecific.TestNoTrimSpace;
+begin
+  TestDataset.FileName := TestFileName();
+  CreateTestFile;
+
+  with TestDataset do begin
+    TrimSpace := False;
+    Open;
+    AssertEquals('1', Fields[0].AsString);
+    AssertEquals('John      ', Fields[1].AsString);
+    Next;
+    AssertEquals('2', Fields[0].AsString);
+    AssertEquals('Christiana', Fields[1].AsString);
+    Edit;
+    Fields[1].AsString := 'Chris';
+    Post;
+    AssertEquals('Chris     ', Fields[1].AsString);
+    Close; // save changes
+    Open;
+    Next;
+    AssertEquals('Chris     ', Fields[1].AsString);
+  end;
+end;
+
 initialization
   // Only run these tests if we are running
   // sdf tests. After all, running these when testing
   // e.g. SQL RDBMS doesn't make sense.
   if uppercase(dbconnectorname)='SDFDS' then
     begin
-    Registertest(Ttestsdfspecific);
+    RegisterTest(TTestSdfSpecific);
+    RegisterTest(TTestFixedFormatSpecific);
     end;
 end.
 

+ 1 - 1
packages/fcl-db/tests/testspecifictmemdataset.pas

@@ -10,7 +10,7 @@ interface
 
 uses
   Classes, SysUtils,
-  fpcunit, testregistry,
+  testregistry,
   ToolsUnit;
 
 type

+ 60 - 56
packages/fcl-db/tests/testsqldb.pas

@@ -17,8 +17,8 @@ type
   { TSQLDBTestCase }
 
   TSQLDBTestCase = class(TTestCase)
-  private
-    function GetSQLDBConnector: TSQLDBConnector;
+    private
+      function GetSQLDBConnector: TSQLDBConnector;
     protected
       procedure SetUp; override;
       procedure TearDown; override;
@@ -46,10 +46,10 @@ type
     Procedure TestAutoApplyUpdatesDelete;
     Procedure TestCheckRowsAffected;
     Procedure TestAutoCommit;
-    Procedure TestRefreshSQL;
     Procedure TestGeneratedRefreshSQL;
     Procedure TestGeneratedRefreshSQL1Field;
     Procedure TestGeneratedRefreshSQLNoKey;
+    Procedure TestRefreshSQL;
     Procedure TestRefreshSQLMultipleRecords;
     Procedure TestRefreshSQLNoRecords;
     Procedure TestFetchAutoInc;
@@ -200,7 +200,7 @@ begin
 
     Q := SQLDBConnector.Query;
     Q.SQL.Text:='select * from FPDEV2';
-    Q.Options:=[sqoKeepOpenOnCommit,sqoPreferRefresh];
+    Q.Options:=[sqoKeepOpenOnCommit,sqoRefreshUsingSelect];
     AssertEquals('PacketRecords forced to -1',-1,Q.PacketRecords);
     Q.Open;
     AssertEquals('Got all records',20,Q.RecordCount);
@@ -392,42 +392,6 @@ begin
     end;
 end;
 
-procedure TTestTSQLQuery.TestRefreshSQL;
-var
-  Q: TSQLQuery;
-
-begin
-  with SQLDBConnector do
-    begin
-    ExecuteDirect('create table FPDEV2 (id integer not null primary key, a varchar(5) default ''abcde'', b integer default 1)');
-    if Transaction.Active then
-      Transaction.Commit;
-    end;
-  Q:=SQLDBConnector.Query;
-  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
-  Q.SQL.Text:='select * from FPDEV2';
-  Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
-  Q.RefreshSQL.Text:='SELECT a,b FROM FPDEV2 WHERE (id=:id)';
-  Q.Open;
-  Q.Insert;  // #1 record
-  Q.FieldByName('id').AsInteger:=1;
-  Q.Post;
-  Q.Append;  // #2 record
-  Q.FieldByName('id').AsInteger:=2;
-  Q.Post;
-  AssertTrue('Field value has not been fetched after Post', Q.FieldByName('a').IsNull);
-  Q.ApplyUpdates(0);
-  // #2 record:
-  AssertEquals('Still on correct field', 2, Q.FieldByName('id').AsInteger);
-  AssertEquals('Field value has been fetched from the database', 'abcde', Q.FieldByName('a').AsString);
-  AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
-  Q.Prior;
-  // #1 record:
-  AssertEquals('Still on correct field', 1, Q.FieldByName('id').AsInteger);
-  AssertEquals('Field value has been fetched from the database', 'abcde', Q.FieldByName('a').AsString);
-  AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
-end;
-
 procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
 
 var
@@ -443,7 +407,7 @@ begin
   Q:=SQLDBConnector.Query;
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
-  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
+  Q.Options:=Q.Options+[sqoRefreshUsingSelect];
   Q.Open;
   With Q.FieldByName('id') do
     ProviderFlags:=ProviderFlags+[pfInKey];
@@ -475,7 +439,7 @@ begin
   Q:=SQLDBConnector.Query;
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
-  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
+  Q.Options:=Q.Options+[sqoRefreshUsingSelect];
   Q.Open;
   With Q.FieldByName('id') do
     ProviderFlags:=ProviderFlags+[pfInKey];
@@ -502,7 +466,7 @@ begin
   FMyQ:=SQLDBConnector.Query;
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
-  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
+  FMyQ.Options:=FMyQ.Options+[sqoRefreshUsingSelect];
   FMyQ.Open;
   With FMyQ.FieldByName('id') do
     ProviderFlags:=ProviderFlags-[pfInKey];
@@ -514,6 +478,41 @@ begin
   AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates);
 end;
 
+procedure TTestTSQLQuery.TestRefreshSQL;
+var
+  Q: TSQLQuery;
+
+begin
+  with SQLDBConnector do
+    begin
+    ExecuteDirect('create table FPDEV2 (id integer not null primary key, a varchar(5) default ''abcde'', b integer default 1)');
+    if Transaction.Active then
+      Transaction.Commit;
+    end;
+  Q:=SQLDBConnector.Query;
+  Q.SQL.Text:='select * from FPDEV2';
+  Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  Q.RefreshSQL.Text:='SELECT a,b FROM FPDEV2 WHERE (id=:id)';
+  Q.Open;
+  Q.Insert;  // #1 record
+  Q.FieldByName('id').AsInteger:=1;
+  Q.Post;
+  Q.Append;  // #2 record
+  Q.FieldByName('id').AsInteger:=2;
+  Q.Post;
+  AssertTrue('Field value has not been fetched after Post', Q.FieldByName('a').IsNull);
+  Q.ApplyUpdates(0);
+  // #2 record:
+  AssertEquals('Still on correct field', 2, Q.FieldByName('id').AsInteger);
+  AssertEquals('Field value has been fetched from the database', 'abcde', Q.FieldByName('a').AsString);
+  AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
+  Q.Prior;
+  // #1 record:
+  AssertEquals('Still on correct field', 1, Q.FieldByName('id').AsInteger);
+  AssertEquals('Field value has been fetched from the database', 'abcde', Q.FieldByName('a').AsString);
+  AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
+end;
+
 procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
 
 begin
@@ -527,7 +526,6 @@ begin
       Transaction.Commit;
     end;
   FMyQ:=SQLDBConnector.Query;
-  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2';
@@ -554,7 +552,6 @@ begin
       Transaction.Commit;
     end;
   FMyQ:=SQLDBConnector.Query;
-  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2 where 1=2';
@@ -695,11 +692,9 @@ begin
     if not (sqSupportReturning in Connection.ConnOptions) then
       Ignore(STestNotApplicable);
     ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
-    if Transaction.Active then
-      Transaction.Commit;
-    ExecuteDirect('insert into FPDEV2 (id) values (123)');
-    if Transaction.Active then
-      Transaction.Commit;
+    CommitDDL;
+    ExecuteDirect('insert into FPDEV2 (id) values (1)');
+    ExecuteDirect('insert into FPDEV2 (id) values (2)');
     end;
   FMyQ:=SQLDBConnector.Query;
   FMyQ.SQL.Text:='select * from FPDEV2';
@@ -708,13 +703,22 @@ begin
     ProviderFlags:=ProviderFlags+[pfInKey];
   With FMyQ.FieldByName('b') do
     ProviderFlags:=[pfRefreshOnUpdate];  // Do not update, just fetch new value
+  SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''b1'' where id=1');
+  SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''b2'' where id=2');
   FMyQ.Edit;
-  FMyQ.FieldByName('a').AsString:='ccc';
-  FMyQ.Post;
-  SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''123'' where id=123');
+  FMyQ.FieldByName('a').AsString:='a1';
+  FMyQ.Post;  // #1 record
+  FMyQ.Next;
+  FMyQ.Edit;
+  FMyQ.FieldByName('a').AsString:='a2';
+  FMyQ.Post;  // #2 record
   FMyQ.ApplyUpdates;
-  AssertEquals('a updated','ccc',FMyQ.FieldByName('a').AsString);
-  AssertEquals('b updated','123',FMyQ.FieldByName('b').AsString);
+  FMyQ.First;
+  AssertEquals('#1.a updated', 'a1', FMyQ.FieldByName('a').AsString);
+  AssertEquals('#1.b updated', 'b1', FMyQ.FieldByName('b').AsString);
+  FMyQ.Next;
+  AssertEquals('#2.a updated', 'a2', FMyQ.FieldByName('a').AsString);
+  AssertEquals('#2.b updated', 'b2', FMyQ.FieldByName('b').AsString);
 end;
 
 
@@ -950,7 +954,7 @@ end;
 
 function TSQLDBTestCase.GetSQLDBConnector: TSQLDBConnector;
 begin
-  Result:=DBConnector as TSQLDBConnector;
+  Result := DBConnector as TSQLDBConnector;
 end;
 
 procedure TSQLDBTestCase.SetUp;