import podataka iz nekog fajla u clientdataset...

[ cojaa @ 23.02.2007. 08:38 ] @

Sigurno je problem sa formatom datuma,zato sto kad probam da radim samo sa jcsvdataset-om i postavim polje tipa datum,nece uopste da primi datum u nasem formatu. Skontao sam da je problem u ovom jvcsvdata.dcu fajlu. Probao sam nesto i da menjam ali opet isto.

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is by Warren Postma.

Contributor(s): Warren Postma (warrenpstma att hotmail dott com)

2003-07-29 Warren Postma - New features (Sorting, Indexing, UserData)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
ii

Description:
TJvCsvDataSet in-memory-dataset component usable by any
VCL Data Aware Controls.
TJvCsvDataSet appears in the 'Jv Data Access' tab of the
Component Palette.

USAGE:
Drop this component onto a form, connect it to
a standard VCL DataSource, then connect any
data aware control to that datasource, using
the standard method you would use if you were
using any other data aware components.

KEY PROPERTIES:
You must set the filename to a valid CSV FileName
such as "MyCsvFile.csv", and you must define the
CSV Fields, using the CSVFieldDef property.
If you don't set those properties, the component
won't work. It is also *recommended* but not
required to right-click on the component and
let the Delphi IDE define the field objects
so that you can access them in your program.

MORE HELP, DOCUMENTATION:
This object works just like the VCL BDE TTable,
so consult
the Delphi help file about TTable if you want
more information.

Known Issues and Updates:
Feb 10, 2003 - Merged local JvCsvData-1.20a.pas changes.
New just-in-time-csv-header parsing fixes long standing
bug for tables which are generated from TStrings already
in memory instead of ones loaded from files on disk.

Nov 17, 2003 - Now implements TDataSet.Locate!!! (needs more testing)
Sept 26, 2003 - Obones made C++Builder fixes.
Sept 24, 2003 -
MERGE ALERT: This version is merged with Peter's version, minus
his case changes, since I think they make the code less readable,
and since the case changes are the only changes of his I could find,
this is essentially a one-side merge, where I dropped all his changes
None appear to cause any functional change in the program. If I missed
any real changes, I apologize.
CRITICAL FIX: Length 1 character field bug fixed.
NEW IMPORT AND APPEND NEW FIELDS:
New Handy Dandy Import-and-Upgrade feature: If you add fields to your
dataset definition, you can still load your old file (that is missing
those columns) and it will add them the next time you save the file.
New columns are always appended to the physical last position (end of
existing lines) in the data file.

NEW WORKING-DIRECTORY-CHANGE FIX:
If your program uses the File Open Dialog it can sometimes change your
app's current working directory. If your CsvDataSets have filenames
without a full path name (C:\MyFolder\MyFile.csv is absoluete,
MyFile.csv is relative), then you could have problems. This component
fixes these problems like this: It gets and stores the current working
directory at startup, and for all filenames where the absolute path
is not stored, the local startup directory is used. This prevents
the problem where complex apps could load a CSV from one directory
and save it to another, and then next time the app runs, the CSV
file is the old version, since the new version was stored in a
different directory.
-----
May 26, 2003 - Fixed errors handling null date values.
- Fixed improper memory access for ftBoolean.
Booleans are stored internaly as a 16bit WordBool, inside
DataSets and the component was reading/writing a 32 bit value,
which could caused all kinds of squirrelly things to happen
when the boolean (ftBoolean, csv type '!') was encountered.
Search for the WordBool to see the changes.
-----------------------------------------------------------------------------}
// $Id: JvCsvData.pas 10670 2006-06-08 14:01:34Z obones $

//------------------------------------------------------------------------
//
// TJvCSVDataSet
//
// An in-memory TDataSet component similar to TTable but with optional
// saving to CSV file, and which, unlike using TTable in CSV mode, does not
// utilize the BDE, or any external database access layers to do its work.
//
// Since this component inherits from TDataSource, you can use it with any
// standard VCL data aware components. Remember to link to a DataSource,
// before you can link this to any data aware controls!
//
//
// TJvCustomCsvDataSet
//
// Internally, we first define a TJvCustomCsvDataSet a base class.
// Nothing published. This exists so you can easily inherit from it
// and define your own version of the component, and publish whatever
// properties and methods you wish to publish, and you can hide or
// override any other elements you don't wish to publish.
//
// How To Use:
// You *must* first set up the important Property
// called CsvFieldDef which describes the expected fields and their types
// since the CSV file itself contains insufficient information to guess the
// field types.
//
//
// Example CsvFieldDef string:
// ABC:$80,DEFG:$140,HIJKLMN:%,OPQRST:@
//
// $ = string (ftString) - also used if no character is given.
// % = whole integer value (ftInteger)
// & = floating point value (ftFloat)
// @ = Ascii datetime value (ftDateTime) as YYYY/MM/DD HH:MM:SS (Component Specific)
// # = Hex-Ascii Timestamp (A93F38C9) seconds since Jan 1, 1970 GMT (Component Specific)
// ^ = Hex-Ascii Timestamp (A93F38CP) corrected to local timezone (Component Specific)
// ! = Boolean Field (0 in csv file=false, not 0 = true, blank = NULL)
//
// NOTE: YOU SHOULD PROBABLY JUST USE THE BUILT-IN PROPERTY EDITOR (CLICK ...)
// INSTEAD OF MEMORIZING ALL THIS FIELD TYPE STUFF.
//
// Originally written by Warren Postma
// Contact: warren.postma att sympatico dott ca or warrenpstma att hotmail dott com
//
// Donated to the Delphi Jedi Project.
// All Copyrights and Ownership donated to the Delphi Jedi Project.
//------------------------------------------------------------------------

unit JvCsvData;

{$I jvcl.inc}

interface

uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
Windows, Classes, DB;

const
MaxCalcDataOffset = 256; // 128 bytes per record for Calculated Field Data.
// JvCsvSep = ','; // converted to property Separator
MAXCOLUMNS = 120;
DEFAULT_CSV_STR_FIELD = 80;
MAXLINELENGTH = 2048;
COLUMN_ENDMARKER = $FFFF;
ON_BOF_CRACK = -1;
ON_EOF_CRACK = -2;

{ return values from CompareBookmarks: }
Bookmark_Less = -1; // b1 < b2
Bookmark_Gtr = 1; // b1 > b2
Bookmark_Eql = 0; // b1 = b2

type
EJvCsvDataSetError = class(EDatabaseError);
// Subclass DB.EDatabaseError so we can work nicely with existing Delphi apps.

EJvCsvKeyError = class(EDatabaseError); // Key Uniqueness or Key Problem

{ Special Event Types }
TJvCsvOnSpecialData = procedure(Sender: TObject; Index: Integer; NonCsvData: string) of object;

TJvCsvOnGetFieldData = procedure(Sender: TObject; UserTag: Integer; UserData: Pointer; FieldName: string; var Value:
string) of object;
TJvCsvOnSetFieldData = procedure(Sender: TObject; UserTag: Integer; UserData: Pointer; FieldName: string; Value:
string) of object;

{ SPECIAL TYPES OF DATABASE COLUMNS FOR THIS COMPONENT }
{ Columns are numeric, text, or one of two kinds of Specially Encoded date/time formats: }
TJvCsvColumnFlag = (jcsvNull, jcsvString, jcsvNumeric, jcsvAsciiDateTime, jcsvGMTDateTime, jcsvTZDateTime, jcsvAsciiDate, jcsvAsciiTime );

{ pointer to special CSV COLUMN }
PCsvColumn = ^TJvCsvColumn;
// PFieldDef = ^TFieldDef;

TJvCsvColumn = record
FFlag: TJvCsvColumnFlag; // Column CSV Format Flags
FKeyFlag: Boolean; // This column is part of the primary key! (new May 2003-WP)
FPhysical: Integer; // Physical Column Ordering
FFieldDef: TFieldDef; // Associated FieldDef
end;

{ CSV COLUMNS are stored in a TList-Collection }
TJvCsvColumns = class(TList)
public
procedure AddColumn(Item: PCsvColumn);
function FindByFieldNo(FieldNo: Integer): PCsvColumn;
procedure Clear; override;
function FindByName(const FieldName: string): PCsvColumn;
end;

TJvCsvBookmark = record
Flag: TBookmarkFlag;
Data: Integer;
end;

{ CSV Data File Row is not very dynamic in this version: }
PtrToPtrToCsvRow = ^PCsvRow; // bookmark Data = double pointer indirection! Fun fun fun!
PCsvRow = ^TJvCsvRow; // a pointer to a record
TJvCsvRow = record { this MUST be a record, not a class, and must be a flag Data record type }
IsDirty: Boolean; // record is dirty (needs to be written to disk)
Columns: Integer;
Index: Integer; // FData Index (-1 means not in FData)
WordField: array [0..MAXCOLUMNS + 1] of Word;
// lookup field beginning, Column Data (column dirty bit+column length) }
Text: array [0..MAXLINELENGTH] of Char; // lookup actual character Data.
// bookmark
Bookmark: TJvCsvBookmark;
// filter flag;
Filtered: Boolean; // row is hidden from view right now.
RecursionFlag: Boolean; // helps us fix endless recursion bug in GetFieldData callbacks.
end;

{ Row collection }
TJvCsvRows = class(TList)
protected
FEnquoteBackslash: Boolean;
// Optional user Data (only allocated if used, how efficient is that, eh.)
FUserData: array of Pointer;
FUserTag: array of Integer;
FUserLength: Integer;
function GetUserTag(Index: Integer): Integer;
procedure SetUserTag(Index, Value: Integer);
function GetUserData(Index: Integer): Pointer;
procedure SetUserData(Index: Integer; Value: Pointer);
// Get internal value, return as Variant.
public
procedure AddRow(Item: PCsvRow);
procedure InsertRow(const Position: Integer; Item: PCsvRow);
procedure AddRowStr(const Item: string; Separator: Char); // convert String->TJvCsvRow
function GetRowPtr(const RowIndex: Integer): PCsvRow;
function GetRowStr(const RowIndex: Integer): string;
procedure SetRowStr(const RowIndex: Integer; Value: string; Separator: Char);
procedure DeleteRow(const RowIndex: Integer);
procedure SetARowItem(const RowIndex, ColumnIndex: Integer; Value: string);
function GetARowItem(const RowIndex, ColumnIndex: Integer): string;
procedure Clear; override;
property EnquoteBackslash: Boolean read FEnquoteBackslash write FEnquoteBackslash;
property UserTag[Index: Integer]: Integer read GetUserTag write SetUserTag;
property UserData[Index: Integer]: Pointer read GetUserData write SetUserData;
end;

TArrayOfPCsvColumn = array of PCsvColumn;

{ TJvCustomCsvDataSetFilterFunction: Defines callback function to be passed to CustomFilter routine }
TJvCustomCsvDataSetFilterFunction = function(RecNo: Integer): Boolean of object;

// Easily Customizeable DataSet descendant our CSV handler and
// any other variants we create:
TJvCustomCsvDataSet = class(TDataSet)
private
FSeparator: Char;
FOpenFileName: string; // This is the Fully Qualified path and filename expanded from the FTableName property when InternalOpen was last called.
FValidateHeaderRow: Boolean;
FExtendedHeaderInfo: Boolean;
FCreatePaths: Boolean;
procedure SetHasHeaderRow(const Value: Boolean); // When saving, create subdirectories/paths if it doesn't exist?
procedure SetSeparator(const Value: Char);
procedure InternalQuickSort(SortList: PPointerList; L, R: Integer;
SortColumns: TArrayOfPCsvColumn; ACount: Integer; SortAscending: Array of Boolean);

procedure QuickSort(AList: TList; SortColumns: TArrayOfPCsvColumn; ACount: Integer; SortAscending: Array of Boolean);
procedure AutoCreateDir(const FileName: string);
protected
// (rom) inacceptable names. Probably most of this should be private.
FTempBuffer: PChar;
FInitialWorkingDirectory: string; // Current working dir may change in a delphi app, causing us trouble.
FStoreDefs: Boolean;
FEnquoteBackslash: Boolean; // causes _Enquote to use Backslashes. NOT the default behaviour.
FTimeZoneCorrection: Integer; // defaults to 0 (none)
FFileDirty: Boolean; // file needs to be written back to disk?

FCsvFieldDef: string; // Our own "Csv Field Definition String"
FCsvKeyDef: string; // CSV Key Definition String. Required if FCsvUniqueKeys is True
FCsvKeyCount: Integer; // Set by parsing FCsvKeyDef
FAscending: array of Boolean;

FCsvKeyFields: TArrayOfPCsvColumn;

FCsvUniqueKeys: Boolean;
// CSV Key Uniqueness option. Also requires that all fields that are part of the Unique Key be Non Null.
FCsvCaseInsensitiveComparison: Boolean;
// CSV Key Uniqueness and Key Comparisons - case insensitive mode if True, else case sensitive.

FIsFiltered: Boolean; // Filter conditions have been set.

FEmptyRowStr: string; // A string of just separators (used to add a new empty row)
FHeaderRow: string; // first row of CSV file.
FPendingCsvHeaderParse: Boolean; // NEW FEB 2004 WP.
FTableName: string; // CSV File Name
FAppendedFieldCount: Integer; // Number of fields not in the file on disk, appended to file as NULLs during import.
FRecordPos: Integer;
FRecordSize: Integer;
FBufferSize: Integer;
FCursorOpen: Boolean;
FFilterBuffer: PChar; // used when we implement filtering (later)
FReadOnly: Boolean;
FLoadsFromFile: Boolean;
FHasHeaderRow: Boolean;
FSavesChanges: Boolean;
FAutoBackupCount: Integer; // Keep Last N Copies the Old Csv File, updated before each save?
FInsertBlocked: Boolean; // internal way to block new records but allows editing of existing ones!
FPostBlocked: Boolean; // internal way to block posting of changes, but allows inserting of new ones!

{ Data record holder }
FCsvColumns: TJvCsvColumns; // Column information
FData: TJvCsvRows; // Rows are a Collection of Data pointers.

{ temporary holding space only, for a TStringList of the file contents }
FCsvFileAsStrings: TStringList;

{ event pointers }
FOnSpecialData: TJvCsvOnSpecialData;
FOnGetFieldData: TJvCsvOnGetFieldData;
// Helps to allow you to update the contents of your CSV Data from some other object in memory.
FOnSetFieldData: TJvCsvOnSetFieldData;
// Helps to keep some other thing in sync with the contents of a changing CSV file.

// Internal Use Only Protected Methods
// function GetDataFileSize: Integer; virtual;
function GetActiveRecordBuffer: PChar; virtual;
procedure CsvRowInit(RowPtr: PCsvRow);

//NEW and very handy dandy!
function GetFieldValueAsVariant(CsvColumnData: PCsvColumn; Field: TField; RecordIndex: Integer): Variant;

// New filtering on cursor (GetRecord advances the cursor past
// any hidden rows using InternalSkipForward).
function InternalSkipFiltered(DefaultResult: TGetResult; ForwardBackwardMode: Boolean): TGetResult;

procedure InternalClearFileStrings;
function InternalLoadFileStrings: Boolean;
// Internal methods used by sorting:
function InternalFieldCompare(Column: PCsvColumn; Left, Right: PCsvRow): Integer;
function InternalCompare(SortColumns: TArrayOfPCsvColumn; SortColumnCount: Integer;
Left, Right: PCsvRow; SortAscending: Array of Boolean): Integer;

// key uniqueness needs this:
function InternalFindByKey(Row: PCsvRow): Integer;

// Each ROW Record has an internal Data pointer (similar to the
// user-accessible 'Data: Pointer' stored in treeviews, etc)
function GetRowUserData: Pointer;
procedure SetRowUserData(UserData: Pointer);

function GetRowTag: Integer;
procedure SetRowTag(TagValue: Integer);

// protected TDataSet base METHODS:
procedure SetTableName(const Value: string); virtual;
function FieldDefsStored: Boolean; virtual;
function GetCanModify: Boolean; override; //already virtual!

// internal calls:
procedure AppendPlaceHolderCommasToAllRows(Strings: TStrings); // Add placeholders to end of a csv file.
procedure ProcessCsvHeaderRow;
procedure ProcessCsvDataRow(const DataRow: string; Index: Integer);
procedure SetCsvFieldDef(const Value: string);

{ Mandatory VCL TDataSet Overrides - Pure Virtual Methods of Base Class }
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure InternalInitRecord(Buffer: PChar); override;
function GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult; override;

function GetRecordSize: Word; override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure ClearCalcFields(Buffer: PChar); override;

// Bookmark methods:
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
procedure InternalGotoBookmark(Bookmark: Pointer); override;
procedure InternalSetToRecord(Buffer: PChar); override; // on Insertion???
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;

// Navigational methods:
procedure InternalFirst; override;
procedure InternalLast; override;
// Editing methods:
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
procedure InternalDelete; override;
procedure InternalPost; override;
{ procedure InternalInsert; override; }{not needed.}

// Misc methods:
procedure InternalClose; override;
// procedure DestroyFields; override;

procedure InternalHandleException; override;
procedure InternalInitFieldDefs; override;
procedure InternalOpen; override;

function GetFileName: string; // used by InternalOpen, and Flush.

function IsCursorOpen: Boolean; override;
{ Optional overrides }
function GetRecordCount: Integer; override;
function GetRecNo: Integer; override;
procedure SetRecNo(Value: Integer); override;

{ dataset designer calls these }
procedure DefChanged(Sender: TObject); override;

// handling functions for enquoting,dequoting string fields in csv files.
// handles using the default Excel method which is to double the quotes inside
// quotes.

// (rom) inacceptable names
function _Enquote(const StrVal: string): string; virtual;
// puts whole string in quotes, escapes embedded separators and quote characters!
function _Dequote(const StrVal: string): string; virtual; // removes quotes

property Separator: Char read FSeparator write SetSeparator default ',';
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function BookmarkValid(Bookmark: TBookmark): Boolean; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;

// Autoincrement feature: Get next available auto-incremented value for numbered/indexed autoincrementing fields.
function GetAutoincrement(const FieldName: string): Integer;

// NEW: COPY FROM ANOTHER TDATASET (TTable, TADOTable, TQuery, or whatever)
function CopyFromDataset(DataSet: TDataSet): Integer;

// SELECT * FROM TABLE WHERE <fieldname> LIKE <pattern>:
procedure SetFilter(const FieldName: string; Pattern: string); // Make Rows Visible Only if they match filterString

// SELECT * FROM TABLE WHERE <fieldname> IS <NULL|NOT NULL>:
procedure SetFilterOnNull(const FieldName: string; NullFlag: Boolean);

procedure ClearFilter; // Clear all previous SetFilters, shows All Rows. Refresh screen.
// (rom) inacceptable name
procedure _ClearFilter; // Clear Previous Filtering. DOES NOT REFRESH SCREEN.

procedure CustomFilter(FilterCallback: TJvCustomCsvDataSetFilterFunction); {NEW:APRIL 2004-WP}

// ----------- THIS IS A DUMMY FUNCTION, DON'T USE IT!:
function Locate(const KeyFields: string; const KeyValues: Variant;
Options: TLocateOptions): Boolean; override;

//------------

/// procedure FilteredDeletion(Inverted: Boolean); /// XXX TODO?
/// procedure DeleteRowsMatchingFilter; /// XXX TODO?
/// procedure DeleteRowsNotMatchingFilter; /// XXX TODO?

// this is necessary to make bookmarks work as well:
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;

// Additional procedures
procedure EmptyTable;

// Tells controls to redraw.
procedure Refresh;

// Clone current row/record from one CsvDataSet to another (primitive synchronization/copying ability).
procedure CloneRow(DataSet: TJvCustomCsvDataSet);

// TODO: Implement row/record copy from ANY dataset.

// A fast row lookup function specific to this CSV table object.
function FindByCsvKey(const Key: string): Boolean;

// Sort the table:
procedure Sort(const SortFields: string; Ascending: Boolean);

// All rows have a UserData and UserTag property, these
// next two functions quickly set all the userdata and usertag
// values for all rows, which is a good way to set defaults
// without having to iterate through the dataset.
procedure SetAllUserData(Data: Pointer);
procedure SetAllUserTags(TagValue: Integer);

// The UserData/UserTag properties apply to the row that the
// cursor is sitting on. Without visibly moving the cursor,
// its handy to get/set the usertag and Data values.
function GetUserTag(RecNo: Integer): Integer;
procedure SetUserTag(RecNo, NewValue: Integer);

function GetUserData(RecNo: Integer): Pointer;
procedure SetUserData(RecNo: Integer; NewValue: Pointer);

function GetCsvHeader: string; // NEW FEB 2004 WP

{ Additional Public methods }
procedure OpenWith(Strings: TStrings); virtual;

procedure AppendWith(Strings: TStrings); virtual;

{ Special declarations }
// as long as the field names and positions have not changed.
procedure AssignFromStrings(const Strings: TStrings); virtual; // update String Data directly.
procedure AssignToStrings(Strings: TStrings); virtual;

procedure DeleteRows(FromRow, ToRow: Integer); // NEW: Quickly zap a bunch of rows:
procedure ExportRows(const FileName: string; FromRow, ToRow: Integer); // NEW: Quickly save a bunch of rows:

procedure ExportCsvFile(const FileName: string); virtual;
// save out to a file. does NOT keep backups! If file exists, it will be
// overwritten, and NO backups are made!

procedure Flush; virtual; // Save CSV file to disk if file has changed and SavesChanges is True.
// Note: FLUSH will make backup copies if FAutoBackupCount>0!!!

function GetAsString(const Row, Column: Integer): string; virtual;

{ Row Access as String }
function GetRowAsString(const Index: Integer): string; virtual;

function CurrentRowAsString: string; virtual; // Return any row by index, special: -1 means last row NEW.

// Return any row by index, special: -1 means last row
function GetColumnsAsString: string; virtual;
{ Row Append one String }
procedure AppendRowString(const RowAsString: string);
// Along with GetRowAsString, easy way to copy a dataset to another dataset!

function IsKeyUnique: Boolean; // Checks current row's key uniqueness. Note that FCsvKeyDef MUST be set!
procedure SaveToFile(const FileName: string);
procedure LoadFromFile(const FileName: string);

{These are made protected so that you can write another derivce component
unfortunately if it is in another unit, you can't do much about it.}
protected
property InternalData: TJvCsvRows read FData write FData;
property AppendedFieldCount: Integer read FAppendedFieldCount;
// Number of fields not in the file on disk, appended to file as NULLs during import.
// Per-Record user-Data fields:
// Each record can have a pointer (for associating each row with an object)
property UserData: Pointer read GetRowUserData write SetRowUserData;
// Each record can have a tag (Integer) (for help in marking rows as Selected/Unselected or some other
// end user task)
property UserTag: Integer read GetRowTag write SetRowTag;

property FileName: string read FTableName write SetTableName;
property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
property Changed: Boolean read FFileDirty write FFileDirty;
// property DataFileSize: Integer read GetDataFileSize;

// if HasHeaderRow is True, validate that it conforms to CvsFieldDef
property ValidateHeaderRow: Boolean read FValidateHeaderRow write FValidateHeaderRow default True;
property ExtendedHeaderInfo: Boolean read FExtendedHeaderInfo write FExtendedHeaderInfo;

property CaseInsensitive: Boolean read FCsvCaseInsensitiveComparison write FCsvCaseInsensitiveComparison;

// Properties for Automatically Loading/Saving CSV file when Active property is set True/False:
property LoadsFromFile: Boolean read FLoadsFromFile write FLoadsFromFile default True;
property AutoBackupCount: Integer read FAutoBackupCount write FAutoBackupCount;
// >0 means Keep Last N Copies the Old Csv File, updated before each save?

// Do field definitions "persist"?
// Ie: do they get stored in DFM Form file along with the component
property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;

{ value in seconds : to do GMT to EST (ie GMT-5) use value of (-3600*5)
This is only useful if you use the Hex encoded date-time fields.
}
property TimeZoneCorrection: Integer read FTimeZoneCorrection write FTimeZoneCorrection default 0;
{ If False (default) we use the more normal CSV rendering of quotes, which is to double them in
the csv file, but if this property is True, we use backslash-quote to render quotes in the file,
which has the side-effect of also requiring all backslashes to themself be escaped by a backslash.
So filenames would have to be in the form "c:\\directory\\names\\like\\c\\programmers\\do\\it".
Not recommended behaviour, except when absolutely necessary! }
property EnquoteBackslash: Boolean read FEnquoteBackslash write FEnquoteBackslash default False;

{new}
property CreatePaths: Boolean read FCreatePaths write FCreatePaths default True; // When saving, create subdirectories/paths if it doesn't exist?

{ Additional Events }
property OnSpecialData: TJvCsvOnSpecialData read FOnSpecialData write FOnSpecialData;
property OnGetFieldData: TJvCsvOnGetFieldData read FOnGetFieldData write FOnGetFieldData;
property OnSetFieldData: TJvCsvOnSetFieldData read FOnSetFieldData write FOnSetFieldData;
public
{ these MUST be available at runtime even when the object is of the Custom base class type
This enables interoperability at design time between non-visual helper components
and user-derived CsvDataSet descendants }
// CSV Table definition properties:
property CsvFieldDef: string read FCsvFieldDef write SetCsvFieldDef; // Our own "Csv Field Definition String"
property CsvKeyDef: string read FCsvKeyDef write FCsvKeyDef; // Primary key definition.
property CsvUniqueKeys: Boolean read FCsvUniqueKeys write FCsvUniqueKeys; // Rows must be unique on the primary key.

property OpenFileName: string read FOpenFileName; // Set in InternalOpen, used elsewhere.
property FieldDefs stored FieldDefsStored;
property TableName: string read FTableName; // Another name, albeit read only, for the FileName property!
property HasHeaderRow: Boolean read FHasHeaderRow write SetHasHeaderRow default True;
property HeaderRow: string read FHeaderRow; // first row of CSV file.
property SavesChanges: Boolean read FSavesChanges write FSavesChanges default True;
end;

// TJvCsvDataSet is just a TJvCustomCsvDataSet with all properties and events exposed:
TJvCsvDataSet = class(TJvCustomCsvDataSet)
public
property TableName;
property UserData;
property UserTag;
published
property FieldDefs;
property Active;
property BufferCount;
property FileName;
property ReadOnly;
property BeforeOpen;
property AfterOpen;
property BeforeClose;
property AfterClose;
property BeforeInsert;
property AfterInsert;
property BeforeEdit;
property AfterEdit;
property BeforePost;
property AfterPost;
property BeforeCancel;
property AfterCancel;
property BeforeDelete;
property AfterDelete;
property BeforeScroll;
property AfterScroll;
property OnDeleteError;
property OnEditError;
property OnCalcFields;
property AutoCalcFields; // TDataSet property!
//property MasterFields;
//property MasterSource;
property Changed;
property CsvFieldDef;
property CsvKeyDef;
property CsvUniqueKeys;
property HasHeaderRow;
property ValidateHeaderRow;
property ExtendedHeaderInfo;
property CaseInsensitive;
property Separator;
property LoadsFromFile;
property SavesChanges;
property AutoBackupCount;
property StoreDefs;
property OnSpecialData;
property OnGetFieldData;
property OnSetFieldData;
property TimeZoneCorrection;
property EnquoteBackslash;
property HeaderRow;
end;

{ CSV String Processing Functions }
procedure CsvRowToString(RowItem: PCsvRow; var RowString: string);

{ modified! }
procedure StringToCsvRow(const RowString: string; Separator: Char;
RowItem: PCsvRow; PermitEscapeSequences, EnquoteBackslash: Boolean);

function CsvRowItemCopy(Source, Dest: PCsvRow; FieldIndex, FieldSize: Integer): Boolean;
procedure SetCsvRowItem(PItem: PCsvRow; ColumnIndex: Integer; const NewValue: string);
function GetCsvRowItem(PItem: PCsvRow; ColumnIndex: Integer): string;
procedure CsvRowSetDirtyBit(Row: PCsvRow; ColumnIndex: Integer);
procedure CsvRowClearDirtyBit(Row: PCsvRow; ColumnIndex: Integer);
function CsvRowGetDirtyBit(Row: PCsvRow; ColumnIndex: Integer): Boolean;
procedure CsvRowSetColumnMarker(Row: PCsvRow; ColumnIndex: Integer; ColumnMarker: Integer);
function CsvRowGetColumnMarker(Row: PCsvRow; ColumnIndex: Integer): Integer;

{ Date/Time String decoding functions }

// Decides a TIME_T (A common standard-C-library way of encoding date time values
// as a number of seconds since 12:00 AM Jan 1, 1970 UTC) which is stored in Hex
// in the CSV file.
function TimeTHexToDateTime(const HexStr: string; TimeZoneCorrection: Integer): TDateTime;

function JvIsoDateTimeStrToDateTime(const AsciiDateTimeStr: string): TDateTime; // [formerly TimeTAsciiToDateTime]
function JvIsoDateStrToDate(const AsciiDateStr: string): TDateTime; // new.
function JvIsoTimeStrToTime(const AsciiTimeStr: string): TDateTime; // new. If INVALID value: returns -1.0

{ Date/Time string encoding functions }
function JvDateTimeIsoStr(ADateTime: TDateTime): string; // renamed! formerly DateTimeToTimeToIsoAscii

// new: JvDateIsoStr [support function for new Date ASCII CSV column type]
function JvDateIsoStr(ADateTime: TDateTime): string;

// new: JvTimeIsoStr [support function for new Date ASCII CSV column type]
function JvTimeIsoStr(ADateTime: TDateTime): string;

function DateTimeToTimeTHex(ADateTime: TDateTime; TimeZoneCorrection: Integer): string;

{ Routine to keep backup copies of old Data files around }
function JvCsvBackupPreviousFiles(const FileName: string; MaxFiles: Integer): Boolean;

//JvCsvWildcardMatch:
// Recursive wildcard (%=AnyString, ?=SingleChar) matching function with
// Boolean sub expressions (|=or, &=and).
function JvCsvWildcardMatch(Data, Pattern: string): Boolean;

{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.n..._PREPARATION/run/JvCsvData.pas $';
Revision: '$Revision: 10670 $';
Date: '$Date: 2006-06-08 16:01:34 +0200 (jeu., 08 juin 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}

implementation

uses
{$IFDEF HAS_UNIT_VARIANTS}
Variants,
{$ENDIF HAS_UNIT_VARIANTS}
SysUtils, Controls, Forms,
JvVCL5Utils,
JvJVCLUtils,
JvJCLUtils, JvCsvParse, JvConsts, JvResources, JvTypes;

const
// These characters cannot be used for separator for various reasons:
// Either they are used as field type specifiers, break lines or are used to
// delimit field content
cInvalidSeparators = [#0, Backspace, Lf, #12, Cr, #39, '"', '\',
'$', '%', '&', '@', '#', '^', '!', '-', '/', '*' ];

var
// These arrays are needed by the string-input validation routines
// that validate the ascii input for ISO date/time formats:

//YYYY MM DD HH NN SS
AsciiTime_MinValue: array [1..6] of Integer = (1, 1, 1900, 0, 0, 0);
AsciiTime_MaxValue: array [1..6] of Integer = (31, 12, 3999, 23, 59, 59);
AsciiTime_ExpectLengths: array [1..6] of Integer = (4, 2, 2, 2, 2, 2);

procedure JvCsvDatabaseError(const TableName, Msg: string);
begin
// (rom) no OutputDebugString in production code
{$IFDEF DEBUGINFO_ON}
OutputDebugString(PChar('JvCsvDatabaseError in ' + TableName + ': ' + Msg));
{$ENDIF DEBUGINFO_ON}
raise EJvCsvDataSetError.CreateResFmt(@RsECsvErrFormat, [TableName, Msg]);
end;

procedure JvCsvDatabaseError2(const TableName, Msg: string;Code:Integer);
begin
// (rom) no OutputDebugString in production code
{$IFDEF DEBUGINFO_ON}
OutputDebugString(PChar('JvCsvDatabaseError in ' + TableName + ': ' + Msg));
{$ENDIF DEBUGINFO_ON}
raise EJvCsvDataSetError.CreateResFmt(@RsECsvErrFormat2, [TableName, Msg, Code]);
end;

// note that file is not being locked!

constructor TJvCustomCsvDataSet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSeparator := ',';
FCreatePaths := True; // Creates subdirectories automatically when saving.

FInitialWorkingDirectory := GetCurrentDir; // from SysUtils;

FTempBuffer := AllocMem(MAXLINELENGTH + 1); // AllocMem fills with zeros

// FRecordSize = size of a csv text buffer and the indexes pointing
// into that buffer:

FRecordSize := SizeOf(TJvCsvRow) - SizeOf(TJvCsvBookmark);

// FBuffer size includes CSV Text buffer, and the bookmark Data, followed
// by space for storing the binary form of a calculated-field:

// initial FBufferSize size: My theory is that we should pick a conservative
// estimate plus a margin for error:

FBufferSize := SizeOf(TJvCsvRow) + MaxCalcDataOffset; //;128; {CalcFieldsSize}
//; // our regular record + calculated field Data.

FReadOnly := False;
FCursorOpen := False;
FRecordPos := ON_BOF_CRACK;
FLoadsFromFile := True;
FSavesChanges := True;
FHasHeaderRow := True;
FValidateHeaderRow := True;

{ Additional initialization }
FCsvColumns := TJvCsvColumns.Create;
FData := TJvCsvRows.Create;
FData.EnquoteBackslash := FEnquoteBackslash;
FCsvFileAsStrings := TStringList.Create;
end;

destructor TJvCustomCsvDataSet.Destroy;
begin
FCsvFileAsStrings.Free;
FreeMem(FTempBuffer); // Free the memory we allocated.
FTempBuffer := nil;

try
if FCursorOpen then
InternalClose;
except
end;
if Assigned(FCsvColumns) then
begin
FCsvColumns.Clear;
FCsvColumns.Free;
end;
if Assigned(FData) then
begin
FData.Clear;
FData.Free;
end;
inherited Destroy;
end;

// Each ROW Record has an internal Data pointer (similar to the
// user-accessible 'Data: Pointer' stored in treeviews, etc)

function TJvCustomCsvDataSet.GetRowUserData: Pointer;
var
RecNo: Integer;
begin
RecNo := GetRecNo;
Result := FData.GetUserData(RecNo);
end;

procedure TJvCustomCsvDataSet.SetRowUserData(UserData: Pointer);
var
RecNo: Integer;
begin
RecNo := GetRecNo;
FData.SetUserData(RecNo, UserData);
end;

function TJvCustomCsvDataSet.GetRowTag: Integer;
var
RecNo: Integer;
begin
RecNo := GetRecNo;
Result := FData.GetUserTag(RecNo);
end;

procedure TJvCustomCsvDataSet.SetRowTag(TagValue: Integer);
var
RecNo: Integer;
begin
RecNo := GetRecNo;
FData.SetUserTag(RecNo, TagValue);
end;

function _WildcardsMatchBoolOp(const Data, Pattern: string; BoolOp: Char): Boolean;
var
SubPattern: array [0..20] of string;
I, Count: Integer;
begin
Count := StrSplit(Pattern, BoolOp, {Chr(0)=No Quoting} Chr(0), SubPattern, 20);
if Count > 0 then
begin
for I := 0 to Count - 1 do
begin
Result := JvCsvWildcardMatch(Data, SubPattern[I]);
// If ANY OR True return True;
// if ANY AND False return False;
if (BoolOp = '|') = Result then
Exit;
end;
end
else
begin // split failed...
Result := False;
Exit;
end;
// if we get here, no short circuit was possible.
if BoolOp = '|' then
Result := False // NONE of the OR conditions were met!
else
Result := True; // ALL of the AND condition were met!
end;

procedure TJvCustomCsvDataSet.SetAllUserTags(TagValue: Integer);
var
I: Integer;
begin
FData.SetUserTag(FData.Count - 1, TagValue);
for I := 0 to FData.Count - 2 do
FData.SetUserTag(I, TagValue);
end;

procedure TJvCustomCsvDataSet.SetAllUserData(Data: Pointer);
var
I: Integer;
begin
FData.SetUserData(FData.Count - 1, Data); // Optimization. Ensures we only call SetLength ONCE!
for I := 0 to FData.Count - 2 do
FData.SetUserData(I, Data);
end;

function TJvCustomCsvDataSet.GetUserTag(RecNo: Integer): Integer;
begin
Result := FData.GetUserTag(RecNo);
end;

procedure TJvCustomCsvDataSet.SetUserTag(RecNo, NewValue: Integer);
begin
FData.SetUserTag(RecNo, NewValue);
end;

function TJvCustomCsvDataSet.GetUserData(RecNo: Integer): Pointer;
begin
Result := FData.GetUserData(RecNo);
end;

procedure TJvCustomCsvDataSet.SetUserData(RecNo: Integer; NewValue: Pointer);
begin
FData.SetUserData(RecNo, NewValue);
end;

// Recursive wildcard matching function

function JvCsvWildcardMatch(Data, Pattern: string): Boolean;
var
I: Integer;
FirstWildcard: Integer;
DataLength, PatternLength, DataPosition, PatternPosition: Integer;
FirstBoolCondition: Integer;
begin
Result := True;
PatternLength := Length(Pattern);
if PatternLength = 0 then
Exit;
// no Data?
DataLength := Length(Data);
if DataLength = 0 then
begin
Result := (Pattern = '%') or (Pattern = '');
Exit; // definitely no match.
end;
// replace all '%%' -> '%' (don't put duplicate wildcards in)
I := 1;
while I < PatternLength do
if (Pattern[I] = '%') and (Pattern[I + 1] = '%') then
begin
Pattern := Copy(Pattern, 1, I) + Copy(Pattern, I + 2, PatternLength);
PatternLength := Length(Pattern);
end
else
Inc(I);
// find any | and split into two or more strings, and run ORs on them
FirstBoolCondition := Pos('&', Pattern);
if FirstBoolCondition > 0 then
begin
Result := _WildcardsMatchBoolOp(Data, Pattern, '&');
Exit;
end;
FirstBoolCondition := Pos('|', Pattern);
if FirstBoolCondition > 0 then
begin
Result := _WildcardsMatchBoolOp(Data, Pattern, '|');
Exit;
end;

FirstWildcard := Pos('%', Pattern); // wildcards?
if FirstWildcard = 0 then
FirstWildcard := Pos('?', Pattern); // other wildcard.

if FirstWildcard <= 0 then
begin // no wildcard case.
if Data = Pattern then
Result := True
else
Result := False;
Exit; // simple match returns immediately.
end;
// wildcard tail?
if (FirstWildcard = PatternLength) and (Pattern[1] <> '?') then
begin // prefix match
if Copy(Data, 1, PatternLength - 1) = Copy(Pattern, 1, PatternLength - 1) then
Result := True
else
Result := False;
Exit; // tail case is easy!
end;
// match literal characters until we hit wildcards,
// then search for a wildcard resync, which continues
// recursively.
Result := True;
DataPosition := 1;
PatternPosition := 1;
while (DataPosition <= DataLength) and (PatternPosition <= PatternLength) do
begin
// WILDCARD HANDLER
if Pattern[PatternPosition] = '?' then
begin // match any one character or nothing.
Inc(PatternPosition);
Inc(DataPosition);
end
else
if Pattern[PatternPosition] = '%' then
begin
if PatternPosition = PatternLength then
begin // last byte!
Result := True;
Exit;
end;
// Resync after %:
I := Pos(Pattern[PatternPosition + 1], Data);
while I > 0 do
begin // possible resync point!
Result := JvCsvWildcardMatch(Copy(Data, I, Length(Data)),
Copy(Pattern, PatternPosition + 1, PatternLength));
if Result then
Exit; // found a resync, and rest of strings match
Data := Copy(Data, I + 1, DataLength);
DataLength := Length(Data);
// DataPosition := 0;
if DataLength = 0 then
begin
Result := False;
Exit;
end;
I := Pos(Pattern[PatternPosition + 1], Data);
end;
// failed to resync
Result := False;
Exit;
end
else
begin // NORMAL CHARACTER
if Data[DataPosition] <> Pattern[PatternPosition] then
begin
Result := False; // failed.
Exit;
end;
Inc(DataPosition);
Inc(PatternPosition);
end;
end;
if (DataPosition <= DataLength) and (PatternPosition <= PatternLength) then
Result := False; // there is pattern left over, or Data left over.
end;

// NEW: TJvCustomCsvDataSet.SetFilter
//
// XXX Simplest possible filtering routine. Not very flexible.
// XXX Todo: Make this more flexible.
// XXX Users can also subclass and write their own filter.
// XXX Perhaps a OnFilter event should be provided, and SetCustomFilter
// XXX method would allow us to do a row by row filtering scan, and then
// XXX hide rows that the user sets HideRow := True in the event handler.
// XXX

{ New: Custom Filtering }

procedure TJvCustomCsvDataSet.CustomFilter(FilterCallback: TJvCustomCsvDataSetFilterFunction);
var
I: Integer;
PRow: PCsvRow;
begin
Assert(Assigned(FilterCallback));
// Now check if field value matches given pattern for this row.
for I := 0 to FData.Count - 1 do
begin
PRow := PCsvRow(FData[I]);
Assert(Assigned(PRow));
// if custom function returns False, hide the row.
PRow^.Filtered := not FilterCallback(I);
end;
FIsFiltered := True;
if Active then
First;
end;

procedure TJvCustomCsvDataSet.SetFilterOnNull(const FieldName: string; NullFlag: Boolean);
var
I: Integer;
PRow: PCsvRow;
FieldRec: PCsvColumn;
FieldIndex: Integer;
FieldValue: string;
begin
FieldRec := FCsvColumns.FindByName(FieldName);

if not Assigned(FieldRec) then
Exit;
FieldIndex := FieldRec^.FPhysical;

// Now filter out if IsNull matches NullFlag
for I := 0 to FData.Count - 1 do
begin
PRow := PCsvRow(FData[I]);
if not PRow^.Filtered then
begin
FieldValue := FData.GetARowItem(I, FieldIndex);
if (Length(FieldValue) > 0) = NullFlag then
PRow^.Filtered := True;
end;
end;
FIsFiltered := True;
if Active then
First;
end;

procedure TJvCustomCsvDataSet.SetHasHeaderRow(const Value: Boolean);
begin
if FHasHeaderRow <> Value then
begin
FHasHeaderRow := Value;
// Mantis 3479: Now unactivates the dataset and cleans FHeaderRow
Active := False;
FHeaderRow := '';
end;
end;

// Make Rows Visible Only if they match filterString

procedure TJvCustomCsvDataSet.SetFilter(const FieldName: string; Pattern: string);
var
ValueLen, I: Integer;
PRow: PCsvRow;
FieldRec: PCsvColumn;
FieldIndex: Integer;
FieldValue: string;
//stillVisible : Integer;
//m: TBookmark;
begin
// m := GetBookmark;
FieldRec := FCsvColumns.FindByName(FieldName);
// stillVisible := 0;
if not Assigned(FieldRec) then
Exit;
FieldIndex := FieldRec^.FPhysical;
ValueLen := Length(Pattern); // if valuelen is zero then we are searching for blank or nulls
Pattern := UpperCase(Pattern); // make value case insensitive.

// Now check if field value matches given pattern for this row.
for I := 0 to FData.Count - 1 do
begin
PRow := PCsvRow(FData[I]);
if not PRow^.Filtered then
begin
FieldValue := FData.GetARowItem(I, FieldIndex);
if (Length(FieldValue) > 0) and (FieldValue[1] = '"') then
FieldValue := _Dequote(FieldValue); // remove quotes.
if ValueLen = 0 then
begin
if FieldValue <> '' then // if not empty, hide row.
PRow^.Filtered := True;
end
else
begin
FieldValue := UpperCase(FieldValue);
if JvCsvWildcardMatch(FieldValue, Pattern) then // hide row if not same prefix
begin
// Inc(stillVisible) // count the number that are still visible.
end
else
PRow^.Filtered := True
end;
end
end;
FIsFiltered := True;
if Active then
First;
end;

procedure TJvCustomCsvDataSet._ClearFilter; // Clear Previous Filtering.
var
I: Integer;
PRow: PCsvRow;
begin
for I := 0 to FData.Count - 1 do
begin
PRow := PCsvRow(FData[I]);
if Assigned(PRow) then
PRow^.Filtered := False; // clear all filter bits.
end;
FIsFiltered := False;
end;

procedure TJvCustomCsvDataSet.ClearFilter; // Clear Previous Filtering.
var
M: TBookmark;
begin
M := GetBookmark;
_ClearFilter;
// Update screen.
if Active then
if Assigned(M) then
GotoBookmark(M)
else
First;
end;

function TJvCustomCsvDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
Result := (Bookmark <> nil) and (PInteger(Bookmark)^ >= 0) and (PInteger(Bookmark)^ < FData.Count);
end;

function TJvCustomCsvDataSet.AllocRecordBuffer: PChar;
var
RowPtr: PCsvRow;
begin
RowPtr := AllocMem(FBufferSize); {SizeOf(TJvCsvRow)}
// Trace('AllocRecordBuffer Result=$'+IntToHex(Integer(Pointer(RowPtr)),8));
Result := PChar(RowPtr);
end;

{ calc fields support }

procedure TJvCustomCsvDataSet.ClearCalcFields(Buffer: PChar);
begin
// Assumes that our buffer is a TJvCsvRow followed by
// a dynamically resized buffer used for calculated field
// storage:
FillChar(Buffer[SizeOf(TJvCsvRow)], CalcFieldsSize, 0);
end;

{ calc fields support and buffer support }

function TJvCustomCsvDataSet.GetActiveRecordBuffer: PChar;
begin
case State of
dsBrowse:
if IsEmpty then
Result := nil
else
Result := ActiveBuffer;
dsCalcFields:
Result := CalcBuffer;
dsFilter:
Result := FFilterBuffer;
dsEdit, dsInsert:
Result := ActiveBuffer;
else
Result := nil;
end;
end;

procedure TJvCustomCsvDataSet.SetCsvFieldDef(const Value: string);
begin
if FCsvFieldDef <> Value then
begin
CheckInactive;
FCsvFieldDef := Value;
FHeaderRow := '';
FieldDefs.Clear; // Clear VCL Database field definitions
FCsvColumns.Clear; // Clear our own CSV related field Data
FData.Clear; // Clear out Data
end;
end;

procedure TJvCustomCsvDataSet.FreeRecordBuffer(var Buffer: PChar);
//var
// RowPtr: PCsvRow;
begin
//Trace( 'FreeRecordBuffer '+IntToHex(Integer(Buffer),8) );
// try
if Buffer <> nil then
FreeMem(Buffer);
// except
//Trace( 'FreeRecordBuffer - Exception freeing '+IntToHex(Integer(Buffer),8) );
// end;
// //Trace('TJvCustomCsvDataSet.FreeRecordBuffer');

end;

{ called after the record is allocated }

procedure TJvCustomCsvDataSet.InternalInitRecord(Buffer: PChar);
var
RowPtr: PCsvRow;
begin
//Trace( 'InternalInitRecord '+IntToHex(Integer(Buffer),8) );

FillChar(Buffer^, FBufferSize, 0);
RowPtr := PCsvRow(Buffer); // Zero out the buffer.
CsvRowInit(RowPtr);
end;

// CsvRowInit
//
// Internal handy dandy function to set up a new csv row.
// which is intially full of just commas.
//

procedure TJvCustomCsvDataSet.CsvRowInit(RowPtr: PCsvRow);
var
I: Integer;
ColCount: Integer;
begin
RowPtr^.Index := -1; // Not Yet Indexed
RowPtr^.IsDirty := False;
RowPtr^.Bookmark.Flag := bfEOF;
RowPtr^.Bookmark.Data := ON_BOF_CRACK; // no index into FData yet.
CsvRowSetColumnMarker(RowPtr, {column} 0, {marker value} 0);

ColCount := FCsvColumns.Count;
if ColCount <= 0 then
ColCount := 10;

for I := 1 to ColCount do
begin // create an empty line of just commas
if I < ColCount then
RowPtr^.Text[I - 1] := FSeparator
else
RowPtr^.Text[I - 1] := Chr(0);
RowPtr^.Text[I] := Chr(0);
CsvRowSetColumnMarker(RowPtr, {column} I - 1, {marker value} I - 1);
CsvRowSetColumnMarker(RowPtr, {column} I, {marker value} COLUMN_ENDMARKER);
end;
end;

function TJvCustomCsvDataSet.IsKeyUnique: Boolean;
// Checks current row's key uniqueness. Note that FCsvKeyDef MUST be set!
begin
Result := False; // not yet implemented! XXX
end;

function TJvCustomCsvDataSet.GetFieldValueAsVariant(CsvColumnData: PCsvColumn;
Field: TField; RecordIndex: Integer): Variant;
var
RowPtr: PCsvRow;
{ActiveRowPtr: PCsvRow;}
TempString: string;
PhysicalLocation: Integer;
L: Integer;
begin
Assert(Assigned(FCsvColumns));

if not Assigned(CsvColumnData) then
begin
JvCsvDatabaseError(FTableName, Format(RsEUnableToLocateCSVFileInfo, [Field.Name]));
Exit;
end;

PhysicalLocation := CsvColumnData^.FPhysical;

if (PhysicalLocation < 0) and FPendingCsvHeaderParse then
begin
FPendingCsvHeaderParse := False;
ProcessCsvHeaderRow;
PhysicalLocation := CsvColumnData^.FPhysical;
end;

if PhysicalLocation < 0 then
begin
JvCsvDatabaseError(FTableName, Format(RsEPhysicalLocationOfCSVField, [Field.FieldName]));
Exit;
end;

RowPtr := FData[RecordIndex];

TempString := GetCsvRowItem(RowPtr, PhysicalLocation);

// Strip quotes first!
if Field.DataType = ftString then
begin
L := Length(TempString);
if L >= 2 then
if (TempString[1] = '"') and (TempString[L] = '"') then
TempString := _Dequote(TempString); // quoted string!
end;

try
case Field.DataType of
ftString:
Result := TempString;
ftInteger:
Result := StrToInt(TempString);
ftFloat:
Result := StrToFloatUS(TempString);
ftBoolean:
if StrToIntDef(TempString, 0) <> 0 then
Result := True
else
Result := False;
ftDateTime:
{ one of three different datetime formats}
if Length(TempString) > 0 then
case CsvColumnData^.FFlag of
jcsvAsciiTime:
Result := JvIsoDateTimeStrToDateTime(TempString);
jcsvAsciiDate:
Result := JvIsoDateTimeStrToDateTime(TempString);
jcsvAsciiDateTime:
Result := JvIsoDateTimeStrToDateTime(TempString);
jcsvGMTDateTime:
Result := TimeTHexToDateTime(TempString,0);
jcsvTZDateTime:
Result := TimeTHexToDateTime(TempString, FTimeZoneCorrection);
end;
end;
except
Result := Unassigned; // No value.
end;
end;

// Auto-increment

function TJvCustomCsvDataSet.GetAutoincrement(const FieldName: string): Integer;
var
RecIndex: Integer;
FieldLookup: TField;
CsvColumnData: PCsvColumn;
Max, Value: Integer;
RowPtr: PCsvRow;
begin
Result := -1; // failed.
FieldLookup := FieldByName(FieldName);
if FieldLookup.DataType <> ftInteger then
Exit; // failed. Can only auto increment on integer fields!

if not Assigned(FieldLookup) then
Exit; //failed.

CsvColumnData := FCsvColumns.FindByFieldNo(FieldLookup.FieldNo);
Max := -1;
for RecIndex := 0 to Self.FData.Count - 1 do
try
// skip filtered rows:
RowPtr := FData[RecIndex];
Assert(Assigned(RowPtr)); // FData should never contain nils!
if RowPtr^.Filtered then
Continue; // skip filtered row!

Value := GetFieldValueAsVariant(CsvColumnData, FieldLookup, RecIndex);
if Value > Max then
Max := Value; // keep maximum.
except
on E: EVariantError do
Exit; // failed.
end;
if Max < 0 then
Result := 0 // autoincrement starts at zero
else
Result := Max + 1; // count upwards.
end;

// XXX TODO: REMOVE HARD CODED LIMIT OF 20 FIELDS SEARCHABLE!!!
function TJvCustomCsvDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
Options: TLocateOptions): Boolean; // override;
// Options is [loCaseInsensitive]
// or [loPartialKey]
// or [loPartialKey,loCaseInsensitive]
// or [] {none}
var
KeyFieldArray: array [0..20] of string;
FieldLookup: array [0..20] of TField;
CsvColumnData: array [0..20] of PCsvColumn;
FieldIndex: array [0..20] of Integer;
RecIndex, I, Lo, Hi, Count, VarCount: Integer;
Value: Variant;
MatchCount: Integer;
StrValueA, StrValueB: string;
CompareResult: Boolean;
begin
Result := False;
Lo := -1;
// Hi := -1; // Value is never used

if not Active then
Exit;
if Pos(',', KeyFields) > 0 then
Count := StrSplit(KeyFields, ',', Chr(0), KeyFieldArray, 20)
else
Count := StrSplit(KeyFields, ';', Chr(0), KeyFieldArray, 20);

(* Single value need not be an array type! *)
if (VarType(KeyValues) and VarArray) > 0 then
begin
Lo := VarArrayLowBound(KeyValues, 1);
Hi := VarArrayHighBound(KeyValues, 1);
VarCount := (Hi - Lo) + 1;
end
else
VarCount := 1;
if VarCount <> Count then
Exit;
if Count = 0 then
Exit;
if KeyFieldArray[0] = '' then
Exit;
for I := 0 to 20 do
begin
if I < Count then
begin
FieldLookup[I] := FieldByName(KeyFieldArray[I]);
CsvColumnData[I] := FCsvColumns.FindByFieldNo(FieldLookup[I].FieldNo);
if not Assigned(FieldLookup[I]) then
Exit;
FieldIndex[I] := FieldLookup[I].Index;
end
else
begin
FieldLookup[I] := nil;
FieldIndex[I] := -1;
end;
end;

// Now search
// First;
for RecIndex := 0 to Self.FData.Count - 1 do
begin
MatchCount := 0;
for I := 0 to Count - 1 do
begin
Value := GetFieldValueAsVariant(CsvColumnData[I], FieldLookup[I], RecIndex);
if Lo < 0 then // non-vararray!
CompareResult := (Value = KeyValues)
else // vararray!
CompareResult := Value = KeyValues[I + Lo];

if CompareResult then
Inc(MatchCount)
else
if Options <> [] then
begin
if VarIsStr(Value) then
begin
StrValueA := Value;
StrValueB := KeyValues[I + Lo];
if loCaseInsensitive in Options then
begin
StrValueA := UpperCase(StrValueA);
StrValueB := UpperCase(StrValueB);
end;
if StrValueA = StrValueB then
Inc(MatchCount)
else
begin
if loPartialKey in Options then
if Pos(StrValueB, StrValueA) = 1 then
Inc(MatchCount);
end;
end;
end;
end;
if MatchCount = Count then
begin
RecNo := RecIndex; // Move cursor position.
Result := True;
Exit;
end;
// Next;
end;
end;

function TJvCustomCsvDataSet.InternalSkipFiltered(DefaultResult: TGetResult;
ForwardBackwardMode: Boolean): TGetResult;
var
LimitReached: Boolean;
RowPtr: PCsvRow;
begin
Result := DefaultResult;
if FRecordPos < 0 then
Exit;
LimitReached := False; // hit BOF or EOF?
while not LimitReached do
begin
{ no skippage required }
RowPtr := PCsvRow(FData.GetRowPtr(FRecordPos));
if not RowPtr^.Filtered then
Exit;
{ skippage ensues }
if ForwardBackwardMode then
begin // ForwardSkip mode
Inc(FRecordPos);
if FRecordPos >= FData.Count then
begin
FRecordPos := ON_EOF_CRACK;
Result := grEOF;
Exit;
end;
end
else
begin // BackwardSkip mode
Dec(FRecordPos);
if FRecordPos < 0 then
begin // hit BOF_CRACK
FRecordPos := ON_BOF_CRACK;
Result := grBOF;
Exit;
end;
end;
end;
end;

function TJvCustomCsvDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
var
RowPtr: PCsvRow;
begin
Buffer[0] := Chr(0);
Result := grEOF;
if FData.Count < 1 then
begin
//Trace(' GetRecord - called when Data buffer empty.');
Exit;
end;
case GetMode of
gmPrior:
begin
//Trace(' GetRecord( Buffer, gmPrior, DoCheck)');
if FRecordPos = ON_BOF_CRACK then
Result := grBOF
else
if FRecordPos = ON_EOF_CRACK then
begin
FRecordPos := FData.Count - 1;

// NEW FILTERING
if FIsFiltered then
Result := InternalSkipFiltered(grOK, False) // skipping backwards.
else
Result := grOK;
end
else
if FRecordPos > 0 then
begin
Dec(FRecordPos);

// NEW FILTERING
if FIsFiltered then
Result := InternalSkipFiltered(grOK, False) // skipping backwards.
else
Result := grOK;
end
else
Result := grBOF;
end;
gmCurrent:
begin
//Trace(' GetRecord( Buffer, gmCurrent, DoCheck)');
if FRecordPos < 0 then // BOF Crack or EOF Crack?
Result := grError
else
Result := grOK;

// NEW FILTERING
if FIsFiltered then
Result := InternalSkipFiltered(Result, True); // skipping forwards.
end;
gmNext:
begin
//Trace(' GetRecord( Buffer, gmNext, DoCheck)');
if FRecordPos = ON_EOF_CRACK then
Result := grEOF
else
begin
Inc(FRecordPos);

if FRecordPos >= FData.Count then
begin
FRecordPos := ON_EOF_CRACK;
Result := grEOF
end
else
begin
// NEW FILTERING
if FIsFiltered then
Result := InternalSkipFiltered(grOK, True) // skipping forwards.
else
Result := grOK;
end;
end;
end;
else
JvCsvDatabaseError(FTableName, RsEGetMode);
end;

if Result = grOK then
begin
//Trace( ' GetRecord FRecordPos='+IntToStr(FRecordPos)+'Result=grOk' );
try
{ get a record into a buffer }
RowPtr := PCsvRow(Buffer); // Cast to a Row Data Structure to our own type.
Move(FData.GetRowPtr(FRecordPos)^, RowPtr^, SizeOf(TJvCsvRow));
RowPtr^.Bookmark.Flag := bfCurrent;
RowPtr^.Bookmark.Data := FRecordPos;

// Update calculated fields for this row:
ClearCalcFields(Buffer);
GetCalcFields(Buffer);
except
on E: EJvCsvDataSetError do
raise; // pass our error through.
on E: Exception do
JvCsvDatabaseError(FTableName, Format(RsEProblemReadingRow, [FRecordPos]) +' ' + E.Message);
end;
end
else
begin
// fudge: Get bookmark into a record for BOF and EOF records:
{ if RowPtr <> NIL then
RowPtr^.bookmark.Data := FRecordPos;}

if (Result = grError) and DoCheck then
JvCsvDatabaseError(FTableName, RsENoRecord);
end;

// if (Result = grError) then
//Trace(' GetRecord Result = grError');
// if (Result = grEof) then
//Trace(' GetRecord Result = grEof');
// if (Result = grBof) then
//Trace(' GetRecord Result = grBof');
end;

// puts whole string in quotes, escapes embedded commas and quote characters!
// Can optionally deal with newlines also.

function TJvCustomCsvDataSet._Enquote(const StrVal: string): string;
var
S: string;
I, L: Integer;
Ch: Char;
LocalEnquoteBackslash: Boolean;
begin
LocalEnquoteBackslash := FEnquoteBackslash; // can force on, or let it turn on automatically.

if Pos(StrVal, Cr) > 0 then // we are going to need to enquote the backslashes
LocalEnquoteBackslash := True; // absolutely need it in just this case.
if Pos(StrVal, Lf) > 0 then
LocalEnquoteBackslash := True; // absolutely need it in just this case.

S := '"';
L := Length(StrVal);
for I := 1 to L do
begin
Ch := StrVal[I];
if Ch = Cr then
// slighlty unstandard csv behavior, hopefully transparently interoperable with other apps that read CSVs
S := S + '\r'
else
if Ch = Lf then // replace linefeed with \n. slightly nonstandard csv behavior.
S := S + '\n'
else
if LocalEnquoteBackslash and (Ch = '\') then
begin // it would be ambiguous not to escape this in this case!
S := S + '\\';
FEnquoteBackslash := True; // XXX This is a lurking bug. Some day we'll get bit by it.
end
else
if Ch = '"' then // always escape quotes by doubling them, since this is standard CSV behaviour
S := S + '""'
else
if Ch = Tab then
S := S + Ch // keep tabs! NEW Sept 2004! WP.
else
if Ch >= ' ' then // strip any other low-ascii-unprintables!
S := S + Ch;
end;
S := S + '"'; // end quote.
Result := S;
end;

function TJvCustomCsvDataSet.GetRecordSize: Word;
begin
// In create:
// FRecordSize := SizeOf(TJvCsvRow) - SizeOf(TJvCsvBookmark);
Result := FRecordSize;
end;

procedure TJvCustomCsvDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var
RowPtr: PCsvRow;
NewVal: string;
CP, PhysicalLocation: Integer;
PDestination: PChar;
CsvColumnData: PCsvColumn;
DT: TDateTime;
ATimeStamp: TTimeStamp;
begin
//Trace( 'SetFieldData '+Field.FieldName );
PDestination := GetActiveRecordBuffer;
RowPtr := PCsvRow(PDestination);

// Dynamic CSV Column Ordering: If we didn't start by
// assigning column orders when we opened the table,
// we've now GOT to assume a physical ordering:
if FHeaderRow = '' then
begin
FHeaderRow := GetColumnsAsString;
ProcessCsvHeaderRow; // process FHeaderRow
end;

// If this is a calculated field or lookup field then...
if (Field.FieldKind = fkCalculated) or (Field.FieldKind = fkLookup) then
begin
if (Field.Offset < 0) or (Field.Offset + Field.DataSize > MaxCalcDataOffset) then
begin
// (rom) no OutputDebugString in production code
{$IFDEF DEBUGINFO_ON}
OutputDebugString(PChar('JvCsvData.pas: ' + Name + '.SetFieldData(Field=' +
string(Field.FieldName) + ',...): Invalid field.Offset in Calculated or Lookup field. '));
{$ENDIF DEBUGINFO_ON}
Exit;
end;
Inc(PDestination, SizeOf(TJvCsvRow) + Field.Offset);
PDestination[0] := Char(Ord(Buffer <> nil));
if PDestination[0] <> #0 then
CopyMemory(@PDestination[1], Buffer, Field.DataSize);
//Result := True; {there is no return value, oops}
Exit;
end;

// If we get