jvcsvdata.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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,v 1.101 2005/03/09 07:24:57 marquardt Exp $

//------------------------------------------------------------------------
//
// 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 = 80;
  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
  PInteger = ^Integer;
  PDouble = ^Double;
  PBoolean = ^Boolean;
  {$IFDEF COMPILER5}
  PWordBool = ^WordBool;
  {$ENDIF COMPILER5}
  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);

  { 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; // 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);