--- Merging r24225 into '.':

U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r24283 into '.':
U    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_lang.pas
--- Merging r24286 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/tests/testspecifictdbf.pas
--- Merging r24320 into '.':
G    packages/fcl-db/src/dbase/dbf_lang.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24337 into '.':
U    packages/fcl-db/tests/testdbexport.pas
--- Merging r24338 into '.':
G    packages/fcl-db/tests/testspecifictdbf.pas
U    packages/fcl-db/src/dbase/dbf_memo.pas
--- Merging r24340 into '.':
U    packages/fcl-db/tests/dbftoolsunit.pas
G    packages/fcl-db/tests/testspecifictdbf.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_fields.pas
--- Merging r24341 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
U    packages/fcl-db/src/dbase/dbf_pgfile.pas
--- Merging r24342 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24343 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24344 into '.':
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24353 into '.':
G    packages/fcl-db/tests/testspecifictdbf.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
--- Merging r24356 into '.':
U    packages/fcl-db/src/export/fpdbfexport.pp
--- Merging r24363 into '.':
U    packages/fcl-db/src/dbase/dbf.pas
G    packages/fcl-db/src/dbase/dbf_memo.pas
--- Merging r24386 into '.':
G    packages/fcl-db/tests/testspecifictdbf.pas
--- Merging r24387 into '.':
U    packages/fcl-db/tests/testfieldtypes.pas
U    packages/fcl-db/src/base/db.pas
U    packages/fcl-db/src/base/fields.inc
--- Merging r24388 into '.':
G    packages/fcl-db/src/base/db.pas
G    packages/fcl-db/src/base/fields.inc
--- Merging r24389 into '.':
U    packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r24390 into '.':
U    packages/fcl-db/src/Dataset.txt
--- Merging r24391 into '.':
G    packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r24392 into '.':
U    packages/fcl-db/src/README.txt
--- Merging r24395 into '.':
G    packages/fcl-db/tests/testspecifictdbf.pas
G    packages/fcl-db/src/dbase/dbf.pas
G    packages/fcl-db/src/dbase/dbf_dbffile.pas
G    packages/fcl-db/src/Dataset.txt
--- Merging r24399 into '.':
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

# revisions: 24225,24283,24286,24320,24337,24338,24340,24341,24342,24343,24344,24353,24356,24363,24386,24387,24388,24389,24390,24391,24392,24395,24399
r24225 | ludob | 2013-04-11 19:44:30 +0200 (Thu, 11 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

ibconnection:fixed rounding problem in timestamp
r24283 | reiniero | 2013-04-21 15:29:54 +0200 (Sun, 21 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas

*fcl-db/dbase: fix for FoxPro proper codepage when creating dbfs
r24286 | reiniero | 2013-04-21 16:19:00 +0200 (Sun, 21 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

fcl-db/dbase: codepage refinement and preliminary testcase
r24320 | reiniero | 2013-04-25 16:55:39 +0200 (Thu, 25 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_lang.pas

fcl-db/dbase: tentative fix for Visual Foxpro 'B' double
r24337 | reiniero | 2013-04-27 07:57:52 +0200 (Sat, 27 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/testdbexport.pas

* fcl-db/tests/testdbexport: fix for TestXSDExport_ADONET_NoXSD. Thanks, Ludo
r24338 | reiniero | 2013-04-27 10:07:04 +0200 (Sat, 27 Apr 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_memo.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

fcl-db/dbase:
* fixed tests TTestSpecificTDBF.TestCodePage and TestTableLevel
* fixed division by zero for null length record size memos (e.g. if no memo file present)
r24340 | reiniero | 2013-04-27 14:26:44 +0200 (Sat, 27 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_fields.pas
   M /trunk/packages/fcl-db/tests/dbftoolsunit.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

fcl-db/dbase: fix for HasBlob only returning true if last field is blob
r24341 | reiniero | 2013-04-27 15:49:34 +0200 (Sat, 27 Apr 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_pgfile.pas

fcl-db/dbase
* Fix TTestSpecificTDBF.TestMemo by letting the memo file be created if it doesn't exist, unless readonly is set.
r24342 | reiniero | 2013-04-27 16:16:53 +0200 (Sat, 27 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas

* fcl-db/dbase: improved version of r24341: deal with read-only files
r24343 | reiniero | 2013-04-27 17:16:03 +0200 (Sat, 27 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas

* fcl-db/dbase: cosmetic
r24344 | reiniero | 2013-04-27 17:28:28 +0200 (Sat, 27 Apr 2013) | 4 lines
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas

* fcl-db/dbase
  Try to deal with case-insensitive filesystems:
  let index and memo file extensions follow case
  of existing filename.
r24353 | reiniero | 2013-04-28 10:42:22 +0200 (Sun, 28 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

* fcl-db/dbase: fix test for large strings for (visual) foxpro
r24356 | reiniero | 2013-04-28 17:59:31 +0200 (Sun, 28 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/export/fpdbfexport.pp

+ fcl-db/export: fpdbfexport: support Visual Foxpro format
r24363 | reiniero | 2013-04-29 13:31:21 +0200 (Mon, 29 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_memo.pas

* fcl-db/dbase: fix Dbase3,4,7 zero content memo fields
r24386 | reiniero | 2013-04-30 08:56:43 +0200 (Tue, 30 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

* fcl-db/dbase: test data remains in memo memory storage after closing and opening
r24387 | lacak | 2013-04-30 10:59:55 +0200 (Tue, 30 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/db.pas
   M /trunk/packages/fcl-db/src/base/fields.inc
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

fcl-db: base: TBinaryField.AsVariant should return variant Null when Field.IsNull
r24388 | lacak | 2013-04-30 11:59:31 +0200 (Tue, 30 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/db.pas
   M /trunk/packages/fcl-db/src/base/fields.inc

fcl-db: formatting (unification char-case)
r24389 | lacak | 2013-04-30 12:45:12 +0200 (Tue, 30 Apr 2013) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

fcl-db: odbc: increase max. allowed string field length. Fix for existing tests TTestFieldTypes.TestStringLargerThen8192 and TestInsertLargeStrFields. (similar like rev.23141, 23198)
r24390 | reiniero | 2013-04-30 14:47:10 +0200 (Tue, 30 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/Dataset.txt

* fcl/dbase: cosmetic: Dataset.txt language/layout fixes
r24391 | lacak | 2013-04-30 15:19:41 +0200 (Tue, 30 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

fcl-db: odbc: fix NULL numeric parameter handling for MS SQL Server
r24392 | reiniero | 2013-04-30 15:20:04 +0200 (Tue, 30 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/README.txt

fcl-db/dbase: cosmetic
r24395 | reiniero | 2013-04-30 18:26:25 +0200 (Tue, 30 Apr 2013) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/Dataset.txt
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/dbase/dbf_dbffile.pas
   M /trunk/packages/fcl-db/tests/testspecifictdbf.pas

fcl-db/dbase: 
+ support for stream-backed memo file which satisfies TTestSpecificTDBF.TestMemoClose test
* fix default record size 64 for (V)FP memo files
r24399 | lacak | 2013-05-01 10:58:35 +0200 (Wed, 01 May 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

fcl-db: sqlite: map MONEY to ftCurrency (extend compatibilty with f.e. PostgreSQL or MS SQL)

git-svn-id: branches/fixes_2_6@24939 -

packages/fcl-db/src/Dataset.txt

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

packages/fcl-db/src/README.txt

@@ -13,8 +13,8 @@ sqldb
 	PostgreSQL, SQLite3 and Sybase ASE
 
 dbase
-  contains the tDbf components, to work with DBASE and FoxPro
-  file-based databases
+  contains the tDbf components, to work with DBASE, FoxPro and Visual
+	FoxPro file-based databases
 
 sdf
   contains a dataset class to use text files directly as a

packages/fcl-db/src/base/db.pas

@@ -360,7 +360,7 @@ type
     procedure SetAsLargeint(AValue: Largeint); virtual;
     procedure SetAsVariant(const AValue: variant); virtual;
     procedure SetAsString(const AValue: string); virtual;
-    procedure SetAsWideString(const aValue: WideString); virtual;
+    procedure SetAsWideString(const AValue: WideString); virtual;
     procedure SetDataset(AValue : TDataset); virtual;
     procedure SetDataType(AValue: TFieldType);
     procedure SetNewValue(const AValue: Variant);
@@ -486,18 +486,18 @@ type
 
   TWideStringField = class(TStringField)
   protected
-    class procedure CheckTypeSize(aValue: Integer); override;
+    class procedure CheckTypeSize(AValue: Integer); override;
 
-    function GetValue(var aValue: WideString): Boolean;
+    function GetValue(var AValue: WideString): Boolean;
 
     function GetAsString: string; override;
-    procedure SetAsString(const aValue: string); override;
+    procedure SetAsString(const AValue: string); override;
 
     function GetAsVariant: Variant; override;
-    procedure SetVarValue(const aValue: Variant); override;
+    procedure SetVarValue(const AValue: Variant); override;
 
     function GetAsWideString: WideString; override;
-    procedure SetAsWideString(const aValue: WideString); override;
+    procedure SetAsWideString(const AValue: WideString); override;
 
     function GetDataSize: Integer; override;
   public
@@ -568,7 +568,7 @@ type
     FMinValue,
     FMaxValue,
     FMinRange,
-    FMAxRange  : Largeint;
+    FMaxRange  : Largeint;
     Procedure SetMinValue (AValue : Largeint);
     Procedure SetMaxValue (AValue : Largeint);
   protected
@@ -741,6 +741,7 @@ type
     function GetAsString: string; override;
     function GetAsVariant: Variant; override;
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    function GetValue(var AValue: TBytes): Boolean;
     procedure SetAsBytes(const AValue: TBytes); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetText(const AValue: string); override;
@@ -872,7 +873,7 @@ type
     procedure SetText(const AValue: string); override;
     procedure SetVarValue(const AValue: Variant); override;
     function GetAsWideString: WideString; override;
-    procedure SetAsWideString(const aValue: WideString); override;
+    procedure SetAsWideString(const AValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Clear; override;
@@ -896,7 +897,7 @@ type
   TMemoField = class(TBlobField)
   protected
     function GetAsWideString: WideString; override;
-    procedure SetAsWideString(const aValue: WideString); override;
+    procedure SetAsWideString(const AValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -911,7 +912,7 @@ type
     procedure SetVarValue(const AValue: Variant); override;
 
     function GetAsString: string; override;
-    procedure SetAsString(const aValue: string); override;
+    procedure SetAsString(const AValue: string); override;
   public
     constructor Create(aOwner: TComponent); override;
     property Value: WideString read GetAsWideString write SetAsWideString;
@@ -966,7 +967,7 @@ type
     function GetDefaultWidth: Longint; override;
 
     function GetAsGuid: TGUID;
-    procedure SetAsGuid(const aValue: TGUID);
+    procedure SetAsGuid(const AValue: TGUID);
   public
     constructor Create(AOwner: TComponent); override;
     property AsGuid: TGUID read GetAsGuid write SetAsGuid;
@@ -1165,7 +1166,7 @@ type
     Procedure SetDataType(AValue: TFieldType);
     Procedure SetText(const AValue: string);
     function GetAsWideString: WideString;
-    procedure SetAsWideString(const aValue: WideString);
+    procedure SetAsWideString(const AValue: WideString);
   public
     constructor Create(ACollection: TCollection); overload; override;
     constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload;

packages/fcl-db/src/base/fields.inc

@@ -648,7 +648,7 @@ procedure TField.SetAlignment(const AValue: TAlignMent);
 begin
   if FAlignment <> AValue then
     begin
-    FAlignment := Avalue;
+    FAlignment := AValue;
     PropertyChanged(false);
     end;
 end;
@@ -817,9 +817,9 @@ begin
   Raise AccessError(SString);
 end;
 
-procedure TField.SetAsWideString(const aValue: WideString);
+procedure TField.SetAsWideString(const AValue: WideString);
 begin
-  SetAsString(aValue);
+  SetAsString(AValue);
 end;
 
 
@@ -953,9 +953,9 @@ end;
 
 procedure TField.SetDisplayLabel(const AValue: string);
 begin
-  if FDisplayLabel<>Avalue then
+  if FDisplayLabel<>AValue then
     begin
-    FDisplayLabel:=Avalue;
+    FDisplayLabel:=AValue;
     PropertyChanged(true);
     end;
 end;
@@ -986,7 +986,7 @@ end;
 
 procedure TField.SetReadOnly(const AValue: Boolean);
 begin
-  if (FReadOnly<>Avalue) then
+  if (FReadOnly<>AValue) then
     begin
     FReadOnly:=AValue;
     PropertyChanged(True);
@@ -995,7 +995,7 @@ end;
 
 procedure TField.SetVisible(const AValue: Boolean);
 begin
-  if FVisible<>Avalue then
+  if FVisible<>AValue then
     begin
     FVisible:=AValue;
     PropertyChanged(True);
@@ -1208,7 +1208,7 @@ end;
     TWideStringField
   ---------------------------------------------------------------------}
 
-class procedure TWideStringField.CheckTypeSize(aValue: Integer);
+class procedure TWideStringField.CheckTypeSize(AValue: Integer);
 begin
 // A size of 0 is allowed, since for example Firebird allows
 // a query like: 'select '' as fieldname from table' which
@@ -1229,7 +1229,7 @@ begin
     SetDataType(AValue);
 end;
 
-function TWideStringField.GetValue(var aValue: WideString): Boolean;
+function TWideStringField.GetValue(var AValue: WideString): Boolean;
 var
   FixBuffer : array[0..dsMaxStringSize div 2] of WideChar;
   DynBuffer : array of WideChar;
@@ -1238,14 +1238,14 @@ begin
   if DataSize <= dsMaxStringSize then begin
     Result := GetData(@FixBuffer, False);
     FixBuffer[Size]:=#0;     //limit string to Size
-    aValue := FixBuffer;
+    AValue := FixBuffer;
   end else begin
     SetLength(DynBuffer, Succ(Size));
     Buffer := PWideChar(DynBuffer);
     Result := GetData(Buffer, False);
     Buffer[Size]:=#0;     //limit string to Size
     if Result then
-      aValue := Buffer;
+      AValue := Buffer;
   end;
 end;
 
@@ -1254,9 +1254,9 @@ begin
   Result := GetAsWideString;
 end;
 
-procedure TWideStringField.SetAsString(const aValue: string);
+procedure TWideStringField.SetAsString(const AValue: string);
 begin
-  SetAsWideString(aValue);
+  SetAsWideString(AValue);
 end;
 
 function TWideStringField.GetAsVariant: Variant;
@@ -1269,9 +1269,9 @@ begin
     Result := Null;
 end;
 
-procedure TWideStringField.SetVarValue(const aValue: Variant);
+procedure TWideStringField.SetVarValue(const AValue: Variant);
 begin
-  SetAsWideString(aValue);
+  SetAsWideString(AValue);
 end;
 
 function TWideStringField.GetAsWideString: WideString;
@@ -1280,14 +1280,14 @@ begin
     Result := '';
 end;
 
-procedure TWideStringField.SetAsWideString(const aValue: WideString);
+procedure TWideStringField.SetAsWideString(const AValue: WideString);
 const
   NullWideChar : WideChar = #0;
 var
   Buffer : PWideChar;
 begin
-  if Length(aValue)>0 then
-    Buffer := PWideChar(@aValue[1])
+  if Length(AValue)>0 then
+    Buffer := PWideChar(@AValue[1])
   else
     Buffer := @NullWideChar;
   SetData(Buffer, False);
@@ -1340,9 +1340,9 @@ end;
 procedure TNumericField.SetEditFormat(const AValue: string);
 
 begin
-  If FEDitFormat<>AValue then
+  If FEditFormat<>AValue then
     begin
-    FEDitFormat:=AVAlue;
+    FEditFormat:=AValue;
     PropertyChanged(True);
     end;
 end;
@@ -1446,9 +1446,9 @@ begin
   Result:=GetData(P);
   If Result then
     Case Datatype of
-      ftInteger,ftautoinc  : AValue:=Plongint(P)^;
-      ftword               : Avalue:=Pword(P)^;
-      ftsmallint           : AValue:=PSmallint(P)^;
+      ftInteger,ftAutoinc  : AValue:=Plongint(P)^;
+      ftWord               : AValue:=Pword(P)^;
+      ftSmallint           : AValue:=PSmallint(P)^;
     end;
 end;
 
@@ -1463,7 +1463,7 @@ end;
 procedure TLongintField.SetAsFloat(AValue: Double);
 
 begin
-  SetAsLongint(Round(Avalue));
+  SetAsLongint(Round(AValue));
 end;
 
 procedure TLongintField.SetAsLongint(AValue: Longint);
@@ -1472,7 +1472,7 @@ begin
   If CheckRange(AValue) then
     SetData(@AValue)
   else
-    RangeError(Avalue,FMinrange,FMaxRange);
+    RangeError(AValue,FMinRange,FMaxRange);
 end;
 
 procedure TLongintField.SetVarValue(const AValue: Variant);
@@ -1489,11 +1489,11 @@ begin
     Clear
   else
     begin
-    Val(AVAlue,L,Code);
+    Val(AValue,L,Code);
     If Code=0 then
       SetAsLongint(L)
     else
-      DatabaseErrorFMT(SNotAnInteger,[Avalue]);
+      DatabaseErrorFMT(SNotAnInteger,[AValue]);
     end;
 end;
 
@@ -1629,7 +1629,7 @@ end;
 procedure TLargeintField.SetAsFloat(AValue: Double);
 
 begin
-  SetAsLargeint(Round(Avalue));
+  SetAsLargeint(Round(AValue));
 end;
 
 procedure TLargeintField.SetAsLargeint(AValue: Largeint);
@@ -1638,13 +1638,13 @@ begin
   If CheckRange(AValue) then
     SetData(@AValue)
   else
-    RangeError(Avalue,FMinrange,FMaxRange);
+    RangeError(AValue,FMinRange,FMaxRange);
 end;
 
 procedure TLargeintField.SetAsLongint(AValue: Longint);
 
 begin
-  SetAsLargeint(Avalue);
+  SetAsLargeint(AValue);
 end;
 
 procedure TLargeintField.SetAsString(const AValue: string);
@@ -1657,11 +1657,11 @@ begin
     Clear
   else
     begin
-    Val(AVAlue,L,Code);
+    Val(AValue,L,Code);
     If Code=0 then
       SetAsLargeint(L)
     else
-      DatabaseErrorFMT(SNotAnInteger,[Avalue]);
+      DatabaseErrorFMT(SNotAnInteger,[AValue]);
     end;
 end;
 
@@ -1864,7 +1864,7 @@ procedure TFloatField.SetAsFloat(AValue: Double);
 
 begin
   If CheckRange(AValue) then
-    SetData(@Avalue)
+    SetData(@AValue)
   else
     RangeError(AValue,FMinValue,FMaxValue);
 end;
@@ -1877,7 +1877,7 @@ end;
 procedure TFloatField.SetAsLongint(AValue: Longint);
 
 begin
-  SetAsFloat(Avalue);
+  SetAsFloat(AValue);
 end;
 
 procedure TFloatField.SetAsString(const AValue: string);
@@ -1898,7 +1898,7 @@ end;
 
 procedure TFloatField.SetVarValue(const AValue: Variant);
 begin
-  SetAsFloat(Avalue);
+  SetAsFloat(AValue);
 end;
 
 constructor TFloatField.Create(AOwner: TComponent);
@@ -1913,8 +1913,8 @@ end;
 Function TFloatField.CheckRange(AValue : Double) : Boolean;
 
 begin
-  If (FMinValue<>0) or (FmaxValue<>0) then
-    Result:=(AValue>=FMinValue) and (AVAlue<=FMAxValue)
+  If (FMinValue<>0) or (FMaxValue<>0) then
+    Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
   else
     Result:=True;
 end;
@@ -1958,7 +1958,7 @@ function TBooleanField.GetAsString: string;
 Var B : wordbool;
 
 begin
-  If Getdata(@B) then
+  If GetData(@B) then
     Result:=FDisplays[False,B]
   else
     result:='';
@@ -2073,7 +2073,7 @@ function TDateTimeField.GetAsVariant: Variant;
 Var d : tDateTime;
 
 begin
-  If Getdata(@d,False) then
+  If GetData(@d,False) then
     Result := d
   else
     Result:=Null;
@@ -2106,7 +2106,7 @@ Var R : TDateTime;
     F : String;
 
 begin
-  If Not Getdata(@R,False) then
+  If Not GetData(@R,False) then
     TheText:=''
   else
     begin
@@ -2127,7 +2127,7 @@ end;
 procedure TDateTimeField.SetAsDateTime(AValue: TDateTime);
 
 begin
-  SetData(@Avalue,False);
+  SetData(@AValue,False);
 end;
 
 
@@ -2145,7 +2145,7 @@ Var R : TDateTime;
 begin
   if AValue<>'' then
     begin
-    R:=StrToDateTime(AVAlue);
+    R:=StrToDateTime(AValue);
     SetData(@R,False);
     end
   else
@@ -2187,7 +2187,7 @@ begin
     Clear    // set to NULL
   else
     begin
-    R:=StrToTime(AVAlue);
+    R:=StrToTime(AValue);
     SetData(@R,False);
     end;
 end;
@@ -2206,26 +2206,16 @@ begin
 end;
 
 function TBinaryField.GetAsBytes: TBytes;
-var B: TBytes;
 begin
-  SetLength(B, DataSize);
-  if not assigned(B) or not GetData(Pointer(B), True) then
-    SetLength(Result, 0)
-  else if DataType = ftVarBytes then
-  begin
-    SetLength(Result, PWord(B)^);
-    Move(B[sizeof(Word)], Result[0], Length(Result));
-  end
-  else // ftBytes
-    Result := B;
+  if not GetValue(Result) then
+    SetLength(Result, 0);
 end;
 
 
 function TBinaryField.GetAsString: string;
 var B: TBytes;
 begin
-  B := GetAsBytes;
-  if length(B) = 0 then
+  if not GetValue(B) then
     Result := ''
   else
     SetString(Result, @B[0], length(B) div SizeOf(Char));
@@ -2236,13 +2226,17 @@ function TBinaryField.GetAsVariant: Variant;
 var B: TBytes;
     P: Pointer;
 begin
-  B := GetAsBytes;
-  Result := VarArrayCreate([0, length(B)-1], varByte);
-  P := VarArrayLock(Result);
-  try
-    Move(B[0], P^, length(B));
-  finally
-    VarArrayUnlock(Result);
+  if not GetValue(B) then
+    Result := Null
+  else
+  begin
+    Result := VarArrayCreate([0, length(B)-1], varByte);
+    P := VarArrayLock(Result);
+    try
+      Move(B[0], P^, length(B));
+    finally
+      VarArrayUnlock(Result);
+    end;
   end;
 end;
 
@@ -2254,6 +2248,22 @@ begin
 end;
 
 
+function TBinaryField.GetValue(var AValue: TBytes): Boolean;
+var B: TBytes;
+begin
+  SetLength(B, DataSize);
+  Result := assigned(B) and GetData(Pointer(B), True);
+  if Result then
+    if DataType = ftVarBytes then
+      begin
+      SetLength(AValue, PWord(B)^);
+      Move(B[sizeof(Word)], AValue[0], Length(AValue));
+      end
+    else // ftBytes
+      AValue := B;
+end;
+
+
 procedure TBinaryField.SetAsBytes(const AValue: TBytes);
 var Buf: array[0..dsMaxStringSize] of byte;
     DynBuf: TBytes;
@@ -2301,7 +2311,7 @@ end;
 procedure TBinaryField.SetText(const AValue: string);
 
 begin
-  SetAsString(Avalue);
+  SetAsString(AValue);
 end;
 
 procedure TBinaryField.SetVarValue(const AValue: Variant);
@@ -2376,7 +2386,7 @@ class procedure TBCDField.CheckTypeSize(AValue: Longint);
 
 begin
   If not (AValue in [0..4]) then
-    DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
+    DatabaseErrorfmt(SInvalidFieldSize,[AValue]);
 end;
 
 function TBCDField.GetAsBCD: TBCD;
@@ -2479,7 +2489,7 @@ procedure TBCDField.SetAsBCD(const AValue: TBCD);
 var
   c:system.currency;
 begin
-  if BCDToCurr(AValue,c) then  //always returns true !!
+  if BCDToCurr(AValue,c) then
     SetAsCurrency(c);
 end;
 
@@ -2489,7 +2499,7 @@ begin
   If CheckRange(AValue) then
     setdata(@AValue)
   else
-    RangeError(AValue,FMinValue,FMaxvalue);
+    RangeError(AValue,FMinValue,FMaxValue);
 end;
 
 procedure TBCDField.SetVarValue(const AValue: Variant);
@@ -2500,8 +2510,8 @@ end;
 Function TBCDField.CheckRange(AValue : Currency) : Boolean;
 
 begin
-  If (FMinValue<>0) or (FmaxValue<>0) then
-    Result:=(AValue>=FMinValue) and (AVAlue<=FMaxValue)
+  If (FMinValue<>0) or (FMaxValue<>0) then
+    Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
   else
     Result:=True;
 end;
@@ -2533,8 +2543,8 @@ constructor TBCDField.Create(AOwner: TComponent);
 
 begin
   Inherited Create(AOwner);
-  FMaxvalue := 0;
-  FMinvalue := 0;
+  FMaxValue := 0;
+  FMinValue := 0;
   FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
   SetDataType(ftBCD);
   FPrecision := 15;
@@ -2838,9 +2848,9 @@ var
 begin
   With GetBlobStream(bmwrite) do
     try
-      Len := Length(Avalue);
+      Len := Length(AValue);
       if Len > 0 then
-        WriteBuffer(aValue[1], Len);
+        WriteBuffer(AValue[1], Len);
     finally
       Free;
     end;
@@ -2853,9 +2863,9 @@ var
 begin
   With GetBlobStream(bmwrite) do
     try
-      Len := Length(Avalue) * 2;
+      Len := Length(AValue) * 2;
       if Len > 0 then
-        WriteBuffer(aValue[1], Len);
+        WriteBuffer(AValue[1], Len);
     finally
       Free;
     end;
@@ -2954,7 +2964,7 @@ procedure TBlobField.SetFieldType(AValue: TFieldType);
 
 begin
   If AValue in [Low(TBlobType)..High(TBlobType)] then
-    SetDatatype(Avalue);
+    SetDatatype(AValue);
 end;
 
 { TMemoField }
@@ -2971,9 +2981,9 @@ begin
   Result := GetAsString;
 end;
 
-procedure TMemoField.SetAsWideString(const aValue: WideString);
+procedure TMemoField.SetAsWideString(const AValue: WideString);
 begin
-  SetAsString(aValue);
+  SetAsString(AValue);
 end;
 
 { TWideMemoField }
@@ -2989,9 +2999,9 @@ begin
   Result := GetAsWideString;
 end;
 
-procedure TWideMemoField.SetAsString(const aValue: string);
+procedure TWideMemoField.SetAsString(const AValue: string);
 begin
-  SetAsWideString(aValue);
+  SetAsWideString(AValue);
 end;
 
 function TWideMemoField.GetAsVariant: Variant;
@@ -3032,7 +3042,7 @@ end;
 
 class procedure TGuidField.CheckTypeSize(AValue: LongInt);
 begin
-  if aValue <> 38 then
+  if AValue <> 38 then
     DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
 end;
 
@@ -3054,9 +3064,9 @@ begin
   Result := 38;
 end;
 
-procedure TGuidField.SetAsGuid(const aValue: TGUID);
+procedure TGuidField.SetAsGuid(const AValue: TGUID);
 begin
-  SetAsString(GuidToString(aValue));
+  SetAsString(GuidToString(AValue));
 end;
 
 function TVariantField.GetDefaultWidth: Integer;

packages/fcl-db/src/dbase/dbf.pas

@@ -157,6 +157,7 @@ type
     FParser: TDbfParser;
     FBlobStreams: PDbfBlobList;
     FUserStream: TStream;  // user stream to open
+    FUserMemoStream: TStream; // user-provided/expected stream backing memo file storage
     FTableName: string;    // table path and file name
     FRelativePath: string;
     FAbsolutePath: string;
@@ -397,7 +398,10 @@ type
     property PhysicalRecordCount: Integer read GetPhysicalRecordCount;
     property KeySize: Integer read GetKeySize;
     property DbfFile: TDbfFile read FDbfFile;
+    // Storage for data file if using memory storage
     property UserStream: TStream read FUserStream write FUserStream;
+    // Storage for memo file - if any - when using memory storage
+    property UserMemoStream: TStream read FUserMemoStream write FUserMemoStream;
     property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost;
   published
     property DateTimeHandling: TDateTimeHandling
@@ -1145,6 +1149,7 @@ begin
   if FStorage = stoMemory then
   begin
     FDbfFile.Stream := FUserStream;
+    FDbfFile.MemoStream := FUserMemoStream;
     FDbfFile.Mode := FileModeToMemMode[FileOpenMode];
   end else begin
     FDbfFile.FileName := FAbsolutePath + FTableName;
@@ -1548,9 +1553,12 @@ begin
       else
         FDbfFile.FinishCreate(ADbfFieldDefs, 512);
 
-      // if creating memory table, copy stream pointer
+      // if creating memory table, use user-designated stream
       if FStorage = stoMemory then
+      begin
         FUserStream := FDbfFile.Stream;
+        FUserMemoStream := FDbfFile.MemoStream;
+      end;
 
       // create all indexes
       for I := 0 to FIndexDefs.Count-1 do
@@ -2084,9 +2092,9 @@ begin
   end;
   { this is a hack, we actually need to know per user who's modifying, and who is not }
   { Mode is more like: the mode of the last "creation" }
-  { if create/free is nested, then everything will be alright, i think ;-) }
+  { if create/free is nested, then everything will be alright, I think ;-) }
   lBlob.Mode := Mode;
-  { this is a hack: we actually need to know per user what it's position is }
+  { this is a hack: we actually need to know per user what its position is }
   lBlob.Position := 0;
   Result := lBlob;
 end;

packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -47,6 +47,7 @@ type
   protected
     FMdxFile: TIndexFile;
     FMemoFile: TMemoFile;
+    FMemoStream: TStream;
     FFieldDefs: TDbfFieldDefs;
     FIndexNames: TStringList;
     FIndexFiles: TList;
@@ -68,8 +69,10 @@ type
     FDateTimeHandling: TDateTimeHandling;
     FOnLocaleError: TDbfLocaleErrorEvent;
     FOnIndexMissing: TDbfIndexMissingEvent;
-
+    // Yes if table has blob/memo type field(s) (storage in external file)
     function  HasBlob: Boolean;
+    // File extension for memo field; uppercase if FFileName is uppercase
+    // (useful for *nix case-sensitive filesystems)
     function  GetMemoExt: string;
 
     function GetLanguageId: Integer;
@@ -105,6 +108,7 @@ type
     procedure CloseIndex(AIndexName: string);
     procedure RepageIndex(AIndexFile: string);
     procedure CompactIndex(AIndexFile: string);
+
     // Inserts new record
     function  Insert(Buffer: TRecordBuffer): integer;
     // Write dbf header as well as EOF marker at end of file if necessary
@@ -135,6 +139,8 @@ type
     procedure RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer);
 
     property MemoFile: TMemoFile read FMemoFile;
+    // Backing stream for stream/memory-based memo "files"
+    property MemoStream: TStream read FMemoStream write FMemoStream;
     property FieldDefs: TDbfFieldDefs read FFieldDefs;
     property IndexNames: TStringList read FIndexNames;
     property IndexFiles: TList read FIndexFiles;
@@ -186,8 +192,10 @@ type
     FDefaultCreateLangId: Byte;
     FUserName: string;
     FUserNameLen: DWORD;
-	
+
+    // Translates FDefaultCreateLangId back to codepage
     function  GetDefaultCreateCodePage: Integer;
+    // Takes codepage and sets FDefaultCreateLangId
     procedure SetDefaultCreateCodePage(NewCodePage: Integer);
     procedure InitUserName;
   public
@@ -489,17 +497,21 @@ begin
       lMemoFileName := ChangeFileExt(FileName, GetMemoExt);
       if HasBlob then
       begin
-        // open blob file
-        if not FileExists(lMemoFileName) then
+        // open blob file; if it doesn't exist yet create it
+        // using AutoCreate as long as we're not running read-only
+        // If needed, fake a memo file:
+        if (Mode=pfReadOnly) and (not FileExists(lMemoFileName)) then
           MemoFileClass := TNullMemoFile
         else if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
           MemoFileClass := TFoxProMemoFile
         else
-          MemoFileClass := TDbaseMemoFile;
+          MemoFileClass := TDbaseMemoFile; //fallback/default
         FMemoFile := MemoFileClass.Create(Self);
         FMemoFile.FileName := lMemoFileName;
+        if (Mode in [pfMemoryOpen,pfMemoryCreate]) then
+          FMemoFile.Stream:=FMemoStream;
         FMemoFile.Mode := Mode;
-        FMemoFile.AutoCreate := false;
+        FMemoFile.AutoCreate := true;
         FMemoFile.MemoRecordSize := 0;
         FMemoFile.DbfVersion := FDbfVersion;
         FMemoFile.Open;
@@ -520,6 +532,9 @@ begin
       begin
         // open mdx file if present
         lMdxFileName := ChangeFileExt(FileName, '.mdx');
+        // Deal with case-sensitive filesystems:
+        if (FileName<>'') and (UpperCase(FileName)=FileName) then
+          lMdxFileName := UpperCase(lMdxFileName);
         if FileExists(lMdxFileName) then
         begin
           // open file
@@ -630,7 +645,8 @@ begin
     if FDbfVersion in [xFoxPro, xVisualFoxPro] then
     begin
       // Don't use DbfGlobals default language ID as it is dbase-based
-      FFileLangId := ConstructLangId(LangId_To_CodePage[FFileLangId],GetUserDefaultLCID, true);
+      if FFileLangId = 0 then
+        FFileLangId := ConstructLangId(LangId_To_CodePage[FFileLangId],GetUserDefaultLCID, true);
     end
     else
     begin
@@ -683,7 +699,7 @@ begin
     end;
     // begin writing field definitions
     FFieldDefs.Clear;
-    // deleted mark 1 byte
+    // deleted mark takes 1 byte, so skip over that
     lFieldOffset := 1;
     for I := 1 to AFieldDefs.Count do
     begin
@@ -858,6 +874,8 @@ begin
     else
       FMemoFile := TDbaseMemoFile.Create(Self);
     FMemoFile.FileName := lMemoFileName;
+    if (Mode in [pfMemoryOpen,pfMemoryCreate]) then
+      FMemoFile.Stream:=FMemoStream;
     FMemoFile.Mode := Mode;
     FMemoFile.AutoCreate := AutoCreate;
     FMemoFile.MemoRecordSize := MemoSize;
@@ -872,8 +890,11 @@ var
 begin
   Result := false;
   for I := 0 to FFieldDefs.Count-1 do
-    if FFieldDefs.Items[I].IsBlob then 
+    if FFieldDefs.Items[I].IsBlob then
+    begin
       Result := true;
+      break;
+    end;
 end;
 
 function TDbfFile.GetMemoExt: string;
@@ -882,6 +903,8 @@ begin
     xFoxPro, xVisualFoxPro: Result := '.fpt'
     else Result := '.dbt';
   end;
+  if (FFileName<>'') and (FFileName=UpperCase(FFileName)) then
+    Result := UpperCase(Result);
 end;
 
 procedure TDbfFile.Zap;
@@ -1263,6 +1286,7 @@ var
   NewBaseName: string;
   I: integer;
 begin
+  // todo: verify if this works with memo files
   // get memory for index file list
   lIndexFileNames := TStringList.Create;
   try 
@@ -1369,7 +1393,10 @@ begin
   if FMemoFile <> nil then
     DestDbfFile.FinishCreate(DestFieldDefs, FMemoFile.RecordSize)
   else
-    DestDbfFile.FinishCreate(DestFieldDefs, 512);
+    if (DestDbfFile.DbfVersion in [xFoxPro,xVisualFoxPro]) then
+      DestDbfFile.FinishCreate(DestFieldDefs, 64) {VFP default}
+    else
+      DestDbfFile.FinishCreate(DestFieldDefs, 512);
 
   // adjust size and offsets of fields
   GetMem(RestructFieldInfo, sizeof(TRestructFieldInfo)*DestFieldDefs.Count);
@@ -1738,7 +1765,7 @@ begin
           SaveDateToDst;
         end;
       end;
-    'Y':
+    'Y': // currency
       begin
 {$ifdef SUPPORT_INT64}
         Result := true;
@@ -1754,10 +1781,14 @@ begin
       begin
         if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
-          Result := true;
-          if Dst <> nil then
-            PInt64(Dst)^ := SwapIntLE(Unaligned(PInt64(Src)^));
-        end else
+        {$ifdef SUPPORT_INT64}
+          Result := Unaligned(PInt64(Src)^) <> 0;
+          if Result and (Dst <> nil) then
+          begin
+            SwapInt64LE(Src, Dst);
+            PDouble(Dst)^ := PDouble(Dst)^;
+          end;
+        {$endif} end else
           asciiContents := true;
       end;
     'M':
@@ -2779,7 +2810,6 @@ begin
   // error occurred while writing?
   if WriteError then
   begin
-    // -- Tobias --
     // The record couldn't be written, so
     // the written index records and the
     // change to the header have to be
@@ -2789,7 +2819,7 @@ begin
     Dec(PDbfHdr(Header)^.RecordCount);
     WriteHeader;
     UnlockPage(0);
-    // roll back indexes too
+    // roll back indexes, too
     RollbackIndexesAndRaise(FIndexFiles.Count, ecWriteDbf);
   end else
     Result := newRecord;

packages/fcl-db/src/dbase/dbf_fields.pas

@@ -66,6 +66,7 @@ type
     procedure CheckSizePrecision;
     procedure SetDefaultSize;
     procedure AllocBuffers;
+    // Yes if field is a blob/memo type field (storage in external file)
     function  IsBlob: Boolean;
 
     property DefaultBuf: PChar read FDefaultBuf;

packages/fcl-db/src/dbase/dbf_lang.pas

@@ -181,7 +181,6 @@ const
 //*************************************************************************//
 
 // table
-
   LangId_To_Locale: array[Byte] of LCID =
       (
       DbfLocale_NotFound,
@@ -291,6 +290,41 @@ const
 {F0}  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
       );
 
+  //*************************************************************************//
+  // Visual FoxPro CodePage<>Language ID conversion table
+  //*************************************************************************//
+  // table: note layout is different:
+    VFPCodePage_LangID: array[0..51] of integer =
+//        Code page|Codepage identifier/LangID
+        (
+        437,$01,// U.S. MS-DOS
+        620,$69,// Mazovia (Polish) MS-DOS
+        737,$6A,// Greek MS-DOS (437G)
+        850,$02,// International MS-DOS
+        852,$64,// Eastern European MS-DOS
+        857,$6B,// Turkish MS-DOS
+        861,$67,// Icelandic MS-DOS
+        865,$66,// Nordic MS-DOS //todo: verify this. not 65?
+        866,$64,// Russian MS-DOS //todo: verify this. not 66?
+        874,$7C,// Thai Windows
+        895,$68,// Kamenicky (Czech) MS-DOS
+        932,$7B,// Japanese Windows
+        936,$7A,// Chinese Simplified (PRC, Singapore) Windows
+        949,$79,// Korean Windows
+        950,$78,// Traditional Chinese (Hong Kong SAR, Taiwan) Windows
+        1250,$C8,// Eastern European Windows
+        1251,$C9,// Russian Windows
+        1252,$03,// Windows ANSI
+        1253,$CB,// Greek Windows
+        1254,$CA,// Turkish Windows
+        1255,$7D,// Hebrew Windows
+        1256,$7E,// Arabic Windows
+        10000,$04,// Standard Macintosh
+        10006,$98,// Greek Macintosh
+        10007,$96,// Russian Macintosh
+        10029,$97// Macintosh EE (=Eastern European?)
+        );
+
 //*************************************************************************//
 // DB7 LangID Locale substrings
 //*************************************************************************//
@@ -475,6 +509,7 @@ function ConstructLangName(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean):
 
 function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
 
+// Visual DBaseVII specific
 function GetLangId_From_LangName(LocaleStr: string): Byte;
 
 implementation
@@ -534,46 +569,65 @@ const
 function FindLangId(CodePage, DesiredLocale: Cardinal; LanguageIDToLocaleTable: PCardinal; IsFoxPro: Boolean): Byte;
 // DesiredLocale: pointer to lookup array: language ID=>locale
 var
-  LangID, Region, FoxRes, DbfRes: Integer;
+  i, LangID, Region: Integer;
 begin
   Region := 0;
-  DbfRes := 0;
-  FoxRes := 0;
-  // scan for a language ID matching the given codepage
-  for LangID := 0 to $FF do
+  if IsFoxPro then
   begin
-    // check if need to advance to next region
-    if Region + 2 < dBase_RegionCount then
-      if LangID >= dBase_Regions[Region + 2] then
-        Inc(Region, 2);
-    // it seems delphi does not properly understand pointers?
-    // what a mess :-(
-    //todo: verify this for visual foxpro; we never seem to get a result
-    if ((LangId_To_CodePage[LangID] = CodePage) or (CodePage = 0)) and
-      (PCardinal(PChar(LanguageIDToLocaleTable)+(LangID*4))^ = DesiredLocale) then
-      if LangID <= dBase_Regions[Region+1] then
-        DbfRes := Byte(LangID)
-      else
-        FoxRes := Byte(LangID);
-  end;
-  // if we can find langid in other set, use it
-  if (DbfRes <> 0) and (not IsFoxPro or (FoxRes = 0)) then
-    Result := DbfRes //... not using foxpro
-  else  {(DbfRes = 0) or (IsFoxPro and (FoxRes <> 0)}
-  if (FoxRes <> 0) {and (IsFoxPro or (DbfRes = 0)} then
-    Result := FoxRes
+    // scan for a language ID matching the given codepage;
+    // default to Win1252 Western European codepage
+    result:=$03;
+    for i := 0 to high(VFPCodePage_LangID) div 2 do
+    begin
+      if CodePage=VFPCodePage_LangID[i*2] then
+      begin
+        result := Byte(VFPCodePage_LangID[1+i*2]);
+        break;
+      end;
+    end;
+  end
   else
-    Result := 0;
+  begin
+    // DBase
+    // scan for a language ID matching the given codepage
+    result:=0;
+    for LangID := 0 to $FF do
+    begin
+      // check if need to advance to next region
+      if Region + 2 < dBase_RegionCount then
+        if LangID >= dBase_Regions[Region + 2] then
+          Inc(Region, 2);
+      // it seems delphi does not properly understand pointers?
+      // what a mess :-(
+      if ((LangId_To_CodePage[LangID] = CodePage) or (CodePage = 0)) and
+        (PCardinal(PChar(LanguageIDToLocaleTable)+(LangID*4))^ = DesiredLocale) then
+        // Ignore (V)FP results
+        if LangID <= dBase_Regions[Region+1] then
+          result := Byte(LangID);
+    end;
+  end;
 end;
 
 function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
 begin
   // locale: lower 16bits only, with default sorting
   Locale := (Locale and $FFFF) or (SORT_DEFAULT shl 16);
-  Result := FindLangId(CodePage, Locale, @LangId_To_Locale[0], IsFoxPro);
+  if IsFoxPro then
+    Result := FindLangID(CodePage, Locale, @VFPCodePage_LangID[0], true)
+  else
+    Result := FindLangId(CodePage, Locale, @LangId_To_Locale[0], false);
   // not found? try any codepage
   if Result = 0 then
-    Result := FindLangId(0, Locale, @LangId_To_Locale[0], IsFoxPro);
+    if IsFoxPro then
+      Result := FindLangID(0, Locale, @VFPCodePage_LangID[0], true)
+    else
+    begin
+      Result := FindLangId(0, Locale, @LangId_To_Locale[0], false);
+      // Dbase: last resort; include foxpro codepages;
+      // compatible with older tdbf but unknow whether this actually works
+      if Result = 0 then
+        Result := FindLangID(0, Locale, @VFPCodePage_LangID[0], true)
+    end;
 end;
 
 function GetLangId_From_LangName(LocaleStr: string): Byte;
@@ -596,17 +650,11 @@ begin
   // convert codepage string to codepage id
   if CodePageStr = 'WIN' then
     CodePage := 1252
-  else if CodePageStr = 'REW' then    // hebrew
+  else if CodePageStr = 'REW' then    // Hebrew
     CodePage := 1255
   else
-    CodePage := StrToInt(CodePageStr);
+    CodePage := StrToIntDef(CodePageStr,0); //fail to codepage 0
   // find lang id
-  //todo: debug, remove
-  writeln('');
-  writeln('getlangid_fromLangName');
-  writeln('codepagestr ',codepagestr);
-  writeln('subtype: ',subtype);
-  writeln('codepage: ',codepage);
   Result := FindLangId(CodePage, SubType, @LangId_To_LocaleStr[0], IsFoxPro);
 end;
 

packages/fcl-db/src/dbase/dbf_memo.pas

@@ -66,7 +66,7 @@ type
     procedure SetBlockLen(BlockLen: Integer); override;
   end;
 
-  { TNullMemoFile, a kind /dev/null memofile ;-) }
+  { TNullMemoFile, a kind of /dev/null memofile ;-) }
   { - inv: FHeaderModified == false!! (otherwise will try to write FStream) }
   { - inv: FHeaderSize == 0 }
   { - inv: FNeedLocks == false }
@@ -218,6 +218,7 @@ begin
 
     RecordSize := GetBlockLen;
     // checking for right blocksize not needed for foxpro?
+    // todo: why exactly are we testing for 0x7F?
     // mod 128 <> 0 <-> and 0x7F <> 0
     if (RecordSize = 0) and
       ((FDbfVersion in [xFoxPro,xVisualFoxPro]) or ((RecordSize and $7F) <> 0)) then
@@ -226,6 +227,12 @@ begin
       //http://technet.microsoft.com/en-us/subscriptions/d6e1ah7y%28v=vs.90%29.aspx
       RecordSize := 64;
       WriteHeader;
+    end
+    else if (RecordSize = 0) then
+    begin
+      SetBlockLen(512); //dbase default
+      RecordSize := 512;
+      WriteHeader;
     end;
 
     // get memory for temporary buffer
@@ -387,8 +394,9 @@ begin
     end;
 //    if ((bytesBefore + Src.Size + bytesAfter + PDbtHdr(Header).BlockLen-1) div PDbtHdr(Header).BlockLen)
 //        <= ((ReadSize + PDbtHdr(Header).BlockLen-1) div PDbtHdr(Header).BlockLen) then
-    if ((bytesBefore + Src.Size + bytesAfter + RecordSize-1) div RecordSize)
-        <= ((ReadSize + RecordSize-1) div RecordSize) then
+    // If null memo is used, recordsize may be 0. Test for that.
+    if (RecordSize=0) or (((bytesBefore + Src.Size + bytesAfter + RecordSize-1) div RecordSize)
+        <= ((ReadSize + RecordSize-1) div RecordSize)) then
     begin
       append := false;
     end else begin
@@ -469,6 +477,7 @@ function  TDbaseMemoFile.GetMemoSize: Integer;
 begin
   // dBase4 memofiles contain a small 'header'
   if (FDbfVersion<>xBaseIII) and (PInteger(@FBuffer[0])^ = Integer(SwapIntLE($0008FFFF))) then
+    // Subtract size of the block header itself:
     Result := SwapIntLE(PBlockHdr(FBuffer)^.MemoSize)-8
   else
     Result := -1;

packages/fcl-db/src/dbase/dbf_pgfile.pas

@@ -125,8 +125,11 @@ type
     procedure Flush; virtual;
 
     property Active: Boolean read FActive;
-    property AutoCreate: Boolean read FAutoCreate write FAutoCreate;   // only write when closed!
-    property Mode: TPagedFileMode read FMode write FMode;              // only write when closed!
+    // If yes, create file if it doesn't exist.
+    // Only write this property when closed!
+    property AutoCreate: Boolean read FAutoCreate write FAutoCreate;
+    // only write this property when closed!
+    property Mode: TPagedFileMode read FMode write FMode;
     property TempMode: TPagedFileMode read FTempMode;
     property NeedLocks: Boolean read FNeedLocks;
     property HeaderOffset: Integer read FHeaderOffset write SetHeaderOffset;

packages/fcl-db/src/export/fpdbfexport.pp

@@ -20,7 +20,7 @@ Type
 
   { TDBFExportFormatSettings }
 
-  TTableFormat = (tfDBaseIII,tfDBaseIV,tfDBaseVII,tfFoxPro);
+  TTableFormat = (tfDBaseIII,tfDBaseIV,tfDBaseVII,tfFoxPro,tfVisualFoxPro);
   
   TDBFExportFormatSettings = class(TExportFormatSettings)
   private
@@ -128,7 +128,8 @@ end;
 function TFPCustomDBFExport.BindFields: Boolean;
 
 Const
-  Levels : Array[TTableFormat] of integer = (3,4,7,25);
+  // Translate tableformat to tablelevel
+  Levels : Array[TTableFormat] of integer = (3,4,7,25,30);
   
 Var
   EF : TDBFExportFieldItem;
@@ -136,7 +137,8 @@ Var
   
 begin
   // DBase III,IV, and FoxPro have a 10 character field length limit.
-  If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat in [tfDbaseIII,tfDbaseIV,tfFoxPro]) then
+  // Visual Foxpro free tables (without .dbc file) also
+  If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat in [tfDbaseIII,tfDbaseIV,tfFoxPro,tfVisualFoxPro]) then
     CheckExportFieldNames(10);
   // DBase VII has a 32 character field length limit.
   If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat=tfDbaseVII) then

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -1294,7 +1294,7 @@ begin
       isc_encode_timestamp(@CTime, PISC_TIMESTAMP(CurrBuff));
       {$ELSE}
       PISC_TIMESTAMP(CurrBuff)^.timestamp_date := Trunc(PTime) + IBDateOffset;
-      PISC_TIMESTAMP(CurrBuff)^.timestamp_time := Trunc(abs(Frac(PTime)) * IBTimeFractionsPerDay);
+      PISC_TIMESTAMP(CurrBuff)^.timestamp_time := Round(abs(Frac(PTime)) * IBTimeFractionsPerDay);
       {$ENDIF}
       end
   else

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -522,7 +522,7 @@ begin
         SQLGetStmtAttr(ODBCCursor.FSTMTHandle, SQL_ATTR_APP_PARAM_DESC, @APD, 0, nil),
         SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get parameter descriptor.'
       );
-      SQLSetDescRec(APD, i+1, SQL_C_NUMERIC, 0, ColumnSize+2, ColumnSize, DecimalDigits, Buf, nil, nil);
+      SQLSetDescRec(APD, i+1, SQL_C_NUMERIC, 0, ColumnSize+2, ColumnSize, DecimalDigits, Buf, PStrLenOrInd, PStrLenOrInd);
     end;
   end;
 end;
@@ -1185,9 +1185,9 @@ begin
     end;
 
     if (FieldType in [ftString,ftFixedChar]) and // field types mapped to TStringField
-       (FieldSize >= dsMaxStringSize) then
+       (FieldSize > MaxSmallint) then
     begin
-      FieldSize:=dsMaxStringSize-1;
+      FieldSize := MaxSmallint;
     end
     else
     // any exact numeric type with scale 0 can have identity attr.
@@ -1536,8 +1536,6 @@ begin
 end;
 
 destructor TODBCCursor.Destroy;
-var
-  Res:SQLRETURN;
 begin
 {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
   FBlobStreams.Free;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -374,7 +374,7 @@ Type
   end;
   
 Const
-  FieldMapCount = 26;
+  FieldMapCount = 27;
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
    (n:'INT'; t: ftInteger),
    (n:'LARGEINT'; t:ftlargeInt),
@@ -390,6 +390,7 @@ Const
    (n:'DATE'; t: ftDate),
    (n:'TIME'; t: ftTime),
    (n:'CURRENCY'; t: ftCurrency),
+   (n:'MONEY'; t: ftCurrency),
    (n:'VARCHAR'; t: ftString),
    (n:'CHAR'; t: ftFixedChar),
    (n:'NUMERIC'; t: ftBCD),

packages/fcl-db/tests/dbftoolsunit.pas

@@ -38,7 +38,7 @@ type
   end;
 
   { TDBFAutoClean }
-  // DBF descendant that saves to a temp file and removes file when closed
+  // DBF descendant that saves to a memory stream instead of file
   TDBFAutoClean = class(TDBF)
   private
     FBackingStream: TMemoryStream;

packages/fcl-db/tests/testdbexport.pas

@@ -356,7 +356,6 @@ var
   ExportFormat: TDetailedExportFormats;
   ExportSettings:TXMLXSDFormatSettings;
 begin
-  ExportSettings.ExportFormat:=AccessCompatible;
   Exporter := TXMLXSDExporter.Create(nil);
   ExportSettings:=TXMLXSDFormatSettings.Create(true);
   try

packages/fcl-db/tests/testfieldtypes.pas

@@ -933,6 +933,11 @@ begin
       end;
       ExecSQL;
       end;
+    // test NULL parameter value
+    Params.ParamByName('id').AsInteger := testValuesCount;
+    Params.ParamByName('field1').Clear;
+    ExecSQL;
+
     TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
 
     sql.clear;
@@ -962,6 +967,8 @@ begin
       end;
       Next;
       end;
+    AssertTrue('Expected IsNull', FieldByName('FIELD1').IsNull);
+    AssertTrue('Expected Null Variant', VarIsNull(FieldByName('FIELD1').AsVariant));
     close;
     end;
   TSQLDBConnector(DBConnector).Transaction.CommitRetaining;

packages/fcl-db/tests/testspecifictdbf.pas

@@ -53,8 +53,15 @@ type
     procedure TestFindPrior;
     // Tests writing and reading a memo field
     procedure TestMemo;
-    // Tests string field with 254 characters (max for DBase IV)
+    // Tests like TestMemo, but closes and reopens in memory file
+    // in between. Data should still be there.
+    procedure TestMemoClose;
+    // Tests string field with
+    // 254 characters (max for DBase IV)
+    // 32767 characters (FoxPro, Visual FoxPro)
     procedure TestLargeString;
+    // Tests codepage in created dbf
+    procedure TestCodePage;
   end;
 
 
@@ -69,11 +76,13 @@ uses
 
 procedure TTestSpecificTDBF.WriteReadbackTest(ADBFDataset: TDbf;
   AutoInc: boolean);
+const
+  MaxRecs = 10;
 var
   i  : integer;
 begin
   // Add sample data
-  for i := 1 to 10 do
+  for i := 1 to MaxRecs do
     begin
     ADBFDataset.Append;
     if not AutoInc then
@@ -82,13 +91,13 @@ begin
     ADBFDataset.Post;
     end;
   ADBFDataset.first;
-  for i := 1 to 10 do
+  for i := 1 to MaxRecs do
     begin
     CheckEquals(i,ADBFDataset.fieldbyname('ID').asinteger);
     CheckEquals('TestName' + inttostr(i),ADBFDataset.fieldbyname('NAME').AsString);
     ADBFDataset.next;
     end;
-  CheckTrue(ADBFDataset.EOF);
+  CheckTrue(ADBFDataset.EOF,'After reading all records the dataset should show EOF');
 end;
 
 
@@ -106,9 +115,9 @@ procedure TTestSpecificTDBF.TestTableLevel;
 var
   ds : TDBF;
 begin
+  ds := TDBFAutoClean.Create(nil);
   if ((DS as TDBFAutoClean).UserRequestedTableLevel=25) then
     ignore('Foxpro (tablelevel 25) may write data out in dBase IV (tablelevel 4) format.');
-  ds := TDBFAutoClean.Create(nil);
   DS.FieldDefs.Add('ID',ftInteger);
   DS.CreateTable;
   DS.Open;
@@ -363,6 +372,7 @@ begin
   ds := TDBFAutoClean.Create(nil);
   DS.FieldDefs.Add('ID',ftInteger);
   DS.FieldDefs.Add('NAME',ftMemo);
+  DS.OpenMode:=omAutoCreate; //let dbf code create memo etc files when needed
   DS.CreateTable;
   DS.Open;
   WriteReadbackTest(ds);
@@ -370,6 +380,52 @@ begin
   ds.free;
 end;
 
+procedure TTestSpecificTDBF.TestMemoClose;
+const
+  MaxRecs = 10;
+var
+  ds : TDBF;
+  i: integer;
+  DBFStream: TMemoryStream;
+  MemoStream: TMemoryStream;
+begin
+  ds := TDBF.Create(nil);
+  DBFStream:=TMemoryStream.Create;
+  MemoStream:=TMemoryStream.Create;
+  DS.Storage:=stoMemory;
+  DS.UserStream:=DBFStream;
+  DS.UserMemoStream:=MemoStream;
+  DS.FieldDefs.Add('ID',ftInteger);
+  DS.FieldDefs.Add('NAME',ftMemo);
+  DS.OpenMode:=omAutoCreate; //let dbf code create memo etc files when needed
+  DS.CreateTable;
+  
+  DS.Open;  
+  for i := 1 to MaxRecs do
+    begin
+    DS.Append;
+    DS.FieldByName('ID').AsInteger := i;
+    DS.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+    DS.Post;
+    end;  
+  DS.Close; //in old implementations, this erased memo memory
+  
+  DS.Open;
+  DS.First;
+  for i := 1 to MaxRecs do
+    begin
+    CheckEquals(i,DS.fieldbyname('ID').asinteger);
+    CheckEquals('TestName' + inttostr(i),DS.fieldbyname('NAME').AsString);
+    DS.next;
+    end;
+  CheckTrue(DS.EOF,'After reading all records the dataset should show EOF');  
+  DS.Close;
+  
+  ds.free;
+  DBFStream.Free;
+  MemoStream.Free;
+end;
+
 procedure TTestSpecificTDBF.TestLargeString;
 var
   ds : TDBF;
@@ -386,7 +442,7 @@ begin
   TestValue:=StringOfChar('a',MaxStringSize);
 
   DS.FieldDefs.Add('ID',ftInteger);
-  DS.FieldDefs.Add('NAME',ftString,254);
+  DS.FieldDefs.Add('NAME',ftString,MaxStringSize);
   DS.CreateTable;
   DS.Open;
 
@@ -408,6 +464,40 @@ begin
   ds.free;
 end;
 
+procedure TTestSpecificTDBF.TestCodePage;
+const
+  // Chose non-default (i.e. 437,850,1252) cps
+  DOSCodePage=865; //Nordic ms dos
+  DOSLanguageID=$66; //... corresponding language ID (according to VFP docs; other sources say $65)
+  WindowsCodePage=1251; //Russian windows
+  WindowsLanguageID=$C9; //.... corresponding language ID
+var
+  RequestLanguageID: integer; //dbf language ID marker (byte 29)
+  CorrespondingCodePage: integer;
+  ds : TDBF;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  if ((DS as TDBFAutoClean).UserRequestedTableLevel=25) then
+    ignore('Foxpro (tablelevel 25) may write data out in dBase IV (tablelevel 4) format.');
+  DS.FieldDefs.Add('ID',ftInteger);
+  if ((DS as TDBFAutoClean).UserRequestedTableLevel in [7,30]) then
+  begin
+    RequestLanguageID:=WindowsLanguageID;
+    CorrespondingCodePage:=WindowsCodePage //Visual FoxPro, DBase7
+  end
+  else
+  begin
+    RequestLanguageID:=DOSLanguageID;
+    CorrespondingCodePage:=DOSCodePage;
+  end;
+  (DS as TDBFAutoClean).LanguageID:=RequestLanguageID;
+  DS.CreateTable;
+  DS.Open;
+  CheckEquals(CorrespondingCodePage,DS.CodePage,'DBF codepage should match requested codeapage.');
+  DS.Close;
+  ds.free;
+end;
+
 
 
 initialization