{----------------------------------------------------------------------------- JvCsvDataSet 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: Sept 3, 2009 - Delphi 2009 Version - New Streams based file-I/O system - Flexible record size (instead of fixed record size) - Can now handle carriage-return and linefeed characters inside quotes. This allows multi-line TMemo fields to work properly when attached to JvCsvDataset. -----------------------------------------------------------------------------} // $Id: JvCsvData.pas 12088 2008-12-22 13:50:38Z 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: // For most users it is important to 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. Also, if you want to create new files, starting from a blank // file, you absolutely must set up CsvFieldDef first! // If you insist on using a fly-by-the-seat-of-your-pants approach (not setting // CsvFieldDef), the component will just read the first line of whatever CSV file // you give it, and then assume string field type for all columns, which is // fine for some people since the CSV file really is just strings. This can // be handy if you want to write a tool that can open ANY csv file no matter // what column names or how many columns it contains. // // 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) // ~ = UTF8 CSV Field (ftWideString) [currently implemented on Delphi 2009 only] // // NOTE: YOU SHOULD PROBABLY JUST USE THE BUILT-IN CsvFieldDef PROPERTY EDITOR // (CLICK the '...' button in the properties inspector beside CsvFieldDef) // INSTEAD OF MEMORIZING ALL THIS FIELD TYPE STUFF. // // Originally written by Warren Postma // Contact: warren.postma _@_ gmail _D0T_ com // // Donated to the Delphi JEDI Project. // All Copyrights and Ownership donated to the Delphi JEDI Project. //------------------------------------------------------------------------ unit JvCsvData; {$M+} // REQUIRED in D2007. {$I jcl.inc} // we need to know JVCSV_WIDESTRING or not. {$I jvcl.inc} {$R-} // YOU CANNOT ENABLE RANGE CHECKING IN THIS UNIT! WE DO MANY DYNAMIC-ALLOCATED-MEMORY TECHNIQUES AND // GROWABLE-DATA-STRUCTURES AT RUNTIME THAT ARE INCOMPATIBLE WITH DELPHI'S RANGE CHECKING TECHNIQUES. // YOU ALSO PROBABLY CAN'T CONVERT THIS UNIT TO DOTNET IN ANY REASONABLE OR EASY WAY. THERE ARE A TON // OF UNSAFE LOW LEVEL MEMORY AND POINTER ACTIVITIES IN THIS UNIT! interface {$IFDEF COMPILER7_UP} // The WideString field code will COMPILE on Delphi 7, but the WideString field only WORKS // on Delphi 2007 and up. {$DEFINE JVCSV_WIDESTRING} {$ENDIF COMPILER7_UP} uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} Windows, Classes, {$IFNDEF NO_UNICODE} JclBase, // now BOM constants are in JclBase formerly in JclUnicode {$ENDIF NO_UNICODE} JvJCLUtils, // some constants needed. SysUtils, DB; const JvCsvRowMagic = $91AF9823; JvCsvRowMagic2 = $91AF9824; {$IFDEF COMPILER12_UP} JvZeroByte = 0; JvCsvQuote = 34; JvCsvLf = 10; JvCsvCR = 13; {$ELSE} JvZeroByte = #0; JvCsvQuote = #34; JvCsvLf = #10; JvCsvCR = #13; {$ENDIF COMPILER12_UP} JvCsv_MaxCalcDataOffset = 256; // # bytes per record for Calculated Field Data. JvCsv_MAXCOLUMNS = 120; JvCsv_MAXLINELENGTH = 16384; JvCsv_DEFAULT_CSV_STR_FIELD = 80; // If CsvFieldDef doesn't have :123 suffix specifying numeric field length, then default to 80 chars. JvCsv_MINLINELENGTH = 10; JvCsv_COLUMN_ENDMARKER = $FFFF; JvCsv_ON_BOF_CRACK = -1; JvCsv_ON_EOF_CRACK = -2; RowAlreadySaved=0; RowNeedsSaving=1; { return values from CompareBookmarks: } Bookmark_Less = -1; // b1 < b2 Bookmark_Gtr = 1; // b1 > b2 Bookmark_Eql = 0; // b1 = b2 {these values can be changed at runtime, but not at design time,and should only be changed before the dataset is opened or any rows are created:} JvCsvDefaultTextBufferSize = 2048; // Default memory allocation sizes are the same as before. JvCsvDefaultMarginSize = 2; // Two bytes of margin. Remove at your own risk! { fmJVCSV__xxx constants: } { File stream mode flags used setting the mode of TJvCsvStream. } { These bits must be in the high-word, because the Least } { Significant 16 bits are reserved for standard file stream mode bits. } { Standard system values like fmOpenReadWrite are in SysUtils. } fmJVCSV_APPEND_FLAG = $20000; fmJVCSV_REWRITE_FLAG = $10000; fmJVCSV_Append = fmOpenReadWrite or fmJVCSV_APPEND_FLAG; fmJVCSV_OpenReadShared = fmOpenRead or fmShareDenyWrite;// or fmShareDenyNone; // yet another friendly mode constant fmJVCSV_OpenRewrite = fmOpenReadWrite or fmJVCSV_REWRITE_FLAG; // yet another friendly mode constant. fmJVCSV_Truncate = fmCreate or fmJVCSV_REWRITE_FLAG; // yet another friendly mode constant. fmJVCSV_Rewrite = fmCreate or fmJVCSV_REWRITE_FLAG; // yet another friendly mode constant. JvCsvStreamReadChunkSize = 8192; // 8k chunk reads. type EJvCsvDataSetError = class(EDatabaseError); // Subclass DB.EDatabaseError so we can work nicely with existing Delphi apps. EJvCsvKeyError = class(EDatabaseError); // Key Uniqueness or Key Problem {$IFDEF COMPILER12_UP} TJvRecordBuffer = TRecordBuffer; // Delphi 2009 {$ELSE} TJvRecordBuffer = PChar; {$ENDIF COMPILER12_UP} { Special Event Types } TJvCsvOnSpecialData = procedure(Sender: TObject; Index: Integer; NonCsvData: AnsiString) of object; TJvCsvOnGetFieldData = procedure(Sender: TObject; UserTag: Integer; UserData: Pointer; FieldName: string; var Value: AnsiString) of object; TJvCsvOnSetFieldData = procedure(Sender: TObject; UserTag: Integer; UserData: Pointer; FieldName: string; Value: AnsiString) 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, // means not a valid type jcsvString, jcsvNumeric, // Integer or Float (% or &) jcsvAsciiDateTime, jcsvGMTDateTime, jcsvTZDateTime, jcsvAsciiDate, jcsvAsciiTime, jcsvStringUTF8 // special NEW column type (~) - september 2008 ); // SetFilterNum takes one of these as a compareOperator: // utility function JvCsvNumCondition uses this too. TJvCsvFilterNumCompare = ( jfIntEqual, jfIntNotEqual, jfLessThan, jfGreaterThan ); { 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 { Memory usage by JvCsvDataSet: A row is an allocated BLOCK of memory grabbed by ALLOCMEM and it must be copyable as a flat record type, so there can be NO ABSOLUTE POINTER REFERENCES only lookups to various points within this current block. First we have a JvCsvRow, then at some point after that, a JvCsvRowWordFields record is placed, which we must know how to locate by knowing what the effective size of the variable length JvCsvRow.Text field is. After the JvCsvRowWordFields record which is also variable length is stored the calculated field data. } TJvCsvRow = record { this MUST be a record, not a class, and must be a flag Data record type } Magic:Cardinal; // This is expected to be a magic value. If it's not, then the CSV data set is corrupt! AllocSize:Integer; // Size of this record. YOu can't copy CSV records between two CSV data sets if their sizes or separators differ! IsDirty: Byte; // record is dirty (needs to be written to disk) Separator:AnsiChar; // CSV Separator Character Columns: Integer; Index: Integer; // FData Index (-1 means not in FData) Bookmark: TJvCsvBookmark; Filtered: Boolean; // row is hidden from view right now. RecursionFlag: Boolean; // helps us fix endless recursion bug in GetFieldData callbacks. WordFieldsAddr:Integer; // 0 or -1 means WordFieldsAddr not allocated yet! 1..n means how many bytes after first byte of TJvCsvRow is the TJvCsvRowWordFields record. TextMaxLen:Integer; // Max size of Text area! _Text: array [0..JvCsv_MINLINELENGTH] of AnsiChar; // at least 10 characters of storage. typically MUCH MUCH more (ie 2k typical) end; TJvCsvRowWordFields = record Magic2:Cardinal; // Another magic value. WordField: array [0..JvCsv_MAXCOLUMNS + 1] of Word; // Contains a 15 bit offset value in range 0..37267 maximum, // the 16th (high bit) reserved as a this-column-dirty-bit! end; PJvCsvRowWordFields = ^TJvCsvRowWordFields; { Row collection } TJvCsvRows = class(TList) private function GetDecimalSeparator: AnsiChar; procedure SetDecimalSeparator(const Value: AnsiChar); protected FEnquoteBackslash: Boolean; FBackslashCrLf:Boolean; // Are CR/LFs changed to \r and \n? FRecordsValid:Boolean; // Optional user Data (only allocated if used, how efficient is that, eh.) FUserData: array of Pointer; FUserTag: array of Integer; FUserLength: Integer; // new dynamic-allocation-sizing fields: FTextBufferSize : Integer; // How big is TJvCsvRow.Text effectively? FMarginSize : Integer; // How much margin space after the calculated fields? FSeparator:AnsiChar; FDecimalSeparator:AnsiChar; { NOTE: DEFAULT value for historical backwards compatibilty reasons is the USA default of '.' } function GetUserTag(Index: Integer): Integer; procedure SetUserTag(Index, Value: Integer); function GetUserData(Index: Integer): Pointer; procedure SetUserData(Index: Integer; Value: Pointer); function GetRowAllocSize:Integer; function RecordSize:Word; procedure InternalInitRecord(Buffer:TJvRecordBuffer {was PChar}); { note these are not intended to be used outside this unit, so they are protected. access these throught the CsvDataSet class public or published properties only. } property DecimalSeparator : AnsiChar read GetDecimalSeparator write SetDecimalSeparator default USDecimalSeparator; property Separator : AnsiChar read FSeparator write FSeparator; public constructor Create; procedure AddRow(Item: PCsvRow); function AllocRecordBuffer:TJvRecordBuffer; { was PChar, now in tiburon it is PByte } procedure InsertRow(const Position: Integer; Item: PCsvRow); procedure AddRowStr(const Item: AnsiString); // convert string->TJvCsvRow function GetRowPtr(const RowIndex: Integer): PCsvRow; function GetRowAnsiStr(const RowIndex: Integer): AnsiString; procedure SetRowStr(const RowIndex: Integer; Value: AnsiString); procedure DeleteRow(const RowIndex: Integer); procedure SetARowItem(const RowIndex, ColumnIndex: Integer; Value: AnsiString); function GetARowItem(const RowIndex, ColumnIndex: Integer): AnsiString; procedure Clear; override; property EnquoteBackslash: Boolean read FEnquoteBackslash write FEnquoteBackslash; property BackslashCrLf:Boolean read FBackslashCrLf write FBackslashCrLf; // Are CR/LFs changed to \r and \n? property UserTag[Index: Integer]: Integer read GetUserTag write SetUserTag; property UserData[Index: Integer]: Pointer read GetUserData write SetUserData; { these properties should ONLY be set before any actual rows have been allocated. } property TextBufferSize : Integer read FTextBufferSize write FTextBufferSize; // How big is TJvCsvRow.Text effectively? property MarginSize : Integer read FMarginSize write FMarginSize; // How much margin space after the calculated fields? (typically 2 bytes) end; TArrayOfPCsvColumn = array of PCsvColumn; { TJvCustomCsvDataSetFilterFunction: Defines callback function to be passed to CustomFilter routine } TJvCustomCsvDataSetFilterFunction = function(RecNo: Integer): Boolean of object; //------------------------------------------------------------------------- // TJvCsvStream: // // Csv File Reader/Writer Class. Contains a JclFileStream. // Encapsulates reading/writing of CSV files. This version works // only with ASCII files but the plan is to extend it to work with UTF8. // // TJvCsvStream contains an internal TFileStream instead of a JCL Stream because it // is higher performance, do NOT replace the TFileStream below with a JCL // stream. //------------------------------------------------------------------------- TJvCsvStream = class(TObject) private FStream: TFileStream; // Tried TJclFileStream also but it was too slow! Do NOT use JCL streams here. -wpostma. FFilename: string; FStreamBuffer: {$IFDEF COMPILER12_UP}PByte{$ELSE}PChar{$ENDIF COMPILER12_UP}; FStreamIndex: Integer; FStreamSize: Integer; FLastReadFlag: Boolean; procedure _StreamReadBufInit; public function ReadLine: AnsiString; { read a string, one per line, wow. Text files. Cool eh?} procedure Append; procedure Rewrite; procedure Write(const s: AnsiString); {write a string. wow, eh? } procedure WriteLine(const s: AnsiString); {write string followed by Cr+Lf } procedure WriteChar(c: AnsiChar); procedure WriteCrLf; //procedure Write(const s: string); function Eof: Boolean; {is at end of file? } { MODE is typically a fmJVCSV_xxx constant thatimplies a default set of stream mode bits plus some extended bit flags that are specific to this stream type.} constructor Create(const FileName: string; Mode: DWORD = fmJVCSV_OpenReadShared; Rights: Cardinal = 0); reintroduce; virtual; destructor Destroy; override; function Size: Int64; //override; // sanity { read-only properties at runtime} property Filename: string read FFilename; property Stream: TFileStream read FStream; { Get at the underlying stream object} end; //------------------------------------------------------------------------- // TJvCustomCsvDataSet: BASE CLASS. // Easily Customizeable DataSet descendant our CSV handler and // any other variants we create: //------------------------------------------------------------------------- TJvCustomCsvDataSet = class(TDataSet) private 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; FFormatSettings: TFormatSettings; procedure SetSeparator(const Value: AnsiChar); 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); function GetEnquoteBackslash: Boolean; procedure SetEnquoteBackslash(const Value: Boolean); function GetSeparator: AnsiChar; function GetMarginSize: Integer; function GetTextBufferSize: Integer; procedure SetMarginSize(const Value: Integer); procedure SetTextBufferSize(const Value: Integer); function GetBackslashCrLf: Boolean; procedure SetBackslashCrLf(const Value: Boolean); function GetDecimalSeparator: AnsiChar; procedure SetDecimalSeparator(const Value: AnsiChar); function _CsvFloatToStr(fvalue:Double):string; protected // (rom) inacceptable names. Probably most of this should be private. FTempBuffer: TJvRecordBuffer { was PChar}; // Allocated on first access to field variable data only! FInitialWorkingDirectory: string; // Current working dir may change in a delphi app, causing us trouble. FStoreDefs: Boolean; 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: AnsiString; // A string of just separators (used to add a new empty row) FHeaderRow: AnsiString; // 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; FCursorOpen: Boolean; FFilterBuffer: TJvRecordBuffer { was 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; // Can't handle embedded cr/lfs in CSV records. So we replace with our own reader. FCsvFileTopLine:AnsiString; // similar to FHeaderRow, but blank unless we actually loaded from a real CSV file on disk. FCsvFileLoaded:Boolean; // Did InternalFileOpen already load the file? (makes it so that Duplicate calls don't re-load the entire file.) FCsvStream:TJvCsvStream; FSpecialDataMarker:string; // Unless defined, OnSpecialData won't ever be called. { event pointers } FOnSpecialData: TJvCsvOnSpecialData; // XXX Deprecated feature - suggest removal. -Wpostma. 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. FAlwaysEnquoteStrings:Boolean; // Always put Double quotes around strings (for some CSV file reading software this is required.) FAlwaysEnquoteFloats:Boolean; // Always put Double quotes around floating point values (useful when DecimalSeparator==CsvSeparator) FUseSystemDecimalSeparator:Boolean; // Default is false which always uses US mode. FAppendOnly:Boolean; // If true, we don't load the entire content of the CSV from disk, only the last row, and every time we append and write, we only maintain the last row in memory (saves a lot of RAM.) procedure SetActive(Value: Boolean); override; //function GetRowAllocSize:Integer; // Internal Use Only Protected Methods // function GetDataFileSize: Integer; virtual; function GetActiveRecordBuffer: TJvRecordBuffer { was 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; function ReadCsvFileStream: Boolean; function WriteCsvFileStream: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: AnsiString; Index: Integer); procedure SetCsvFieldDef(const Value: string); { Mandatory VCL TDataSet Overrides - Pure Virtual Methods of Base Class } function AllocRecordBuffer: TJvRecordBuffer; override; procedure FreeRecordBuffer(var Buffer: TJvRecordBuffer { was PChar}); override; procedure InternalInitRecord(Buffer: TJvRecordBuffer { was PChar}); override; function GetRecord(Buffer: TJvRecordBuffer { was PChar}; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; function GetRecordSize: Word; override; procedure SetFieldData(Field: TField; Buffer: Pointer); override; procedure ClearCalcFields(Buffer: TJvRecordBuffer { was PChar}); override; // Bookmark methods: procedure GetBookmarkData(Buffer: TJvRecordBuffer { was PChar}; Data: Pointer); override; function GetBookmarkFlag(Buffer: TJvRecordBuffer { was PChar}): TBookmarkFlag; override; procedure InternalGotoBookmark(Bookmark: Pointer); override; procedure InternalSetToRecord(Buffer: TJvRecordBuffer { was PChar}); override; // on Insertion??? procedure SetBookmarkFlag(Buffer: TJvRecordBuffer { was PChar}; Value: TBookmarkFlag); override; procedure SetBookmarkData(Buffer: TJvRecordBuffer { was 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: AnsiString): AnsiString; virtual; // puts whole string in quotes, escapes embedded separators and quote characters! function _Dequote(const StrVal: AnsiString): AnsiString; virtual; // removes quotes property Separator: AnsiChar read GetSeparator write SetSeparator default ','; property DecimalSeparator:AnsiChar read GetDecimalSeparator write SetDecimalSeparator default ' '; // space means system default. public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function BookmarkValid(Bookmark: TBookmark): Boolean; override; function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; function _AllocateRow:PCsvRow; // Don't try to create your own CsvRow Objects outside JvCsvDataSet by just allocating a TJvCsvDataRow object. Call this instead. // 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 LIKE : procedure SetFilter(const FieldName: string; Pattern: AnsiString); // Make Rows Visible Only if they match filterString procedure SetFilterNum(const FieldName: string; compareOperator:TJvCsvFilterNumCompare; numValue: Double ); // SELECT * FROM TABLE WHERE IS : 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: AnsiString): Boolean; // Sort the table: procedure Sort(const SortFields: AnsiString; 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; {$IFDEF COMPILER12_UP} function GetRowAsAnsiString(const Index: Integer): AnsiString; virtual; {$ENDIF COMPILER 12_UP} 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); procedure DeleteCsvColumn(const AFieldName: string); // must be done when not Active! [NEW 2007!] {These are made protected so that you can write another derived component which has access to various protected fields } 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 GetEnquoteBackslash write SetEnquoteBackslash default False; property BackslashCrLf:Boolean read GetBackslashCrLf write SetBackslashCrLf; // Are CR/LFs changed to \r and \n? {new} property CreatePaths: Boolean read FCreatePaths write FCreatePaths default True; // When saving, create subdirectories/paths if it doesn't exist? property SpecialDataMarker:string read FSpecialDataMarker write FSpecialDataMarker; // Unless defined, OnSpecialData won't ever be called. If you have NON-CSV data being parsed/ignored when a certain marker/prefix is found, set it up here. { 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. // not currently valuable, but maybe soon: //property CsvColumns:TJvCsvColumns read FCsvColumns; 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 FHasHeaderRow default True; property HeaderRow: AnsiString read FHeaderRow; // first row of CSV file. property SavesChanges: Boolean read FSavesChanges write FSavesChanges default True; property AlwaysEnquoteStrings:Boolean read FAlwaysEnquoteStrings write FAlwaysEnquoteStrings; // Always put Double quotes around strings (for some CSV file reading software this is required.) property AlwaysEnquoteFloats:Boolean read FAlwaysEnquoteFloats write FAlwaysEnquoteFloats; // Always put Double quotes around floating point values (useful when DecimalSeparator==CsvSeparator) property UseSystemDecimalSeparator:Boolean read FUseSystemDecimalSeparator write FUseSystemDecimalSeparator default false; // Default is false which always uses US mode. Must be false by default because of existing code assuming this behaviour. property AppendOnly:Boolean read FAppendOnly write FAppendOnly; // If true, we don't load the entire content of the CSV from disk, only the last row, and every time we append and write, we only maintain the last row in memory (saves a lot of RAM.) property TextBufferSize : Integer read GetTextBufferSize write SetTextBufferSize; // How big is TJvCsvRow.Text effectively? property MarginSize : Integer read GetMarginSize write SetMarginSize; // How much margin space after the calculated fields? (typically 2 bytes) end; // TJvCsvDataSet is just a TJvCustomCsvDataSet with all properties and events exposed: TJvCsvDataSet = class(TJvCustomCsvDataSet) public property TableName; property UserData; property UserTag; property DecimalSeparator; 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 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; property AlwaysEnquoteStrings; property AlwaysEnquoteFloats; property UseSystemDecimalSeparator; property AppendOnly; end; { CSV string Processing Functions } procedure JvCsvRowToAnsiString(RowItem: PCsvRow; var RowString: AnsiString); { modified! } procedure JvStringToCsvRow(const RowString: AnsiString; Separator: AnsiChar; RowItem: PCsvRow; PermitEscapeSequences, EnquoteBackslash: Boolean); function CsvRowItemCopy(Source, Dest: PCsvRow; FieldIndex, FieldSize: Integer): Boolean; procedure SetCsvRowItem(PItem: PCsvRow; ColumnIndex: Integer; const NewValue: AnsiString); function GetCsvRowItem(PItem: PCsvRow; ColumnIndex: Integer): AnsiString; 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 JvTimeTHexToDateTime(const HexStr: AnsiString; TimeZoneCorrection: Integer): TDateTime; function JvIsoDateTimeStrToDateTime(const AsciiDateTimeStr: AnsiString): TDateTime; // [formerly TimeTAsciiToDateTime] function JvIsoDateStrToDate(const AsciiDateStr: AnsiString): TDateTime; // new. function JvIsoTimeStrToTime(const AsciiTimeStr: AnsiString): TDateTime; // new. If INVALID value: returns -1.0 { Date/Time AnsiString encoding functions } function JvDateTimeIsoStr(ADateTime: TDateTime): AnsiString; // renamed! formerly DateTimeToTimeToIsoAscii // new: JvDateIsoStr [support function for new Date ASCII CSV column type] function JvDateIsoStr(ADateTime: TDateTime): AnsiString; // new: JvTimeIsoStr [support function for new Date ASCII CSV column type] function JvTimeIsoStr(ADateTime: TDateTime): AnsiString; function JvDateTimeToTimeTHex(ADateTime: TDateTime; TimeZoneCorrection: Integer): AnsiString; { 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: AnsiString): Boolean; // numeric filter helper function: function JvCsvNumCondition(FieldValue: Double; CompareOperator: TJvCsvFilterNumCompare; NumValue: Double): Boolean; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvCsvData.pas $'; Revision: '$Revision: 12088 $'; Date: '$Date: 2008-12-22 14:50:38 +0100 (lun., 22 déc. 2008) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} //var // DebugPJvCsvRowWordFields : PJvCsvRowWordFields; // XXX debug code implementation uses {$IFDEF HAS_UNIT_VARIANTS} Variants, {$ENDIF HAS_UNIT_VARIANTS} {$IFDEF HAS_UNIT_ANSISTRINGS} AnsiStrings, {$ENDIF HAS_UNIT_ANSISTRINGS} Controls, Forms, JvVCL5Utils, JvJVCLUtils, 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 = (1900, 1, 1, 0, 0, 0); AsciiTime_MaxValue: array [1..6] of Integer = (3999, 12, 31, 23, 59, 59); AsciiTime_ExpectLengths: array [1..6] of Integer = (4, 2, 2, 2, 2, 2); procedure JvCsvDatabaseError(const TableName, Msg: string); begin raise EJvCsvDataSetError.CreateResFmt(@RsECsvErrFormat, [TableName, Msg]); end; procedure JvCsvDatabaseError2(const TableName, Msg: string; Code: Integer); begin raise EJvCsvDataSetError.CreateResFmt(@RsECsvErrFormat2, [TableName, Msg, Code]); end; function JvCsvStrToFloatDef(const StrValue: string; DefValue: Double; ASeparator: AnsiChar): Double; begin { does not raise exceptions} Result := JvSafeStrToFloatDef(StrValue, DefValue, Char(ASeparator)); // JvJCLUtils end; function JvCsvStrToFloat(const StrValue: string; ASeparator: AnsiChar): Double; begin { raises EConvertError exception } Result := JvSafeStrToFloat(StrValue, Char(ASeparator)); // JvJCLUtils end; { Trim TRAILING CrLf but not leading, or middle, or spaces } function JvTrimAnsiStringCrLf(const S: AnsiString): AnsiString; var I: Integer; begin for I := Length(S) downto 1 do begin if (S[I] <> #10) and (S[I] <> #13) then begin Result := Copy(S, 1, I); Exit; end; end; Result := S; end; {Word fields are fixed size, but variable location, so we need to FIND them.} function GetWordFields(RowItem: PCsvRow): PJvCsvRowWordFields; var P: PAnsiChar; Magic: Cardinal; begin Assert(Assigned(RowItem)); if RowItem^.Magic <> JvCsvRowMagic then raise EJvCsvDataSetError.Create('Internal error. Memory corruption suspected in CsvRow memory area'); Assert(RowItem^.WordFieldsAddr > 0); P := Pointer(RowItem); Inc(P, RowItem.WordFieldsAddr); Result := PJvCsvRowWordFields(P); Magic := Result^.Magic2; if Magic <> JvCsvRowMagic2 then raise EJvCsvDataSetError.Create('Memory Corruption Suspected in WordFields area of CsvRow memory'); // memory corruption check! end; {Calculated data area is now after the word fields, and we need to locate the area } function GetCalcDataOffset(RowItem:PCsvRow):Integer; begin Assert(Assigned(RowItem)); Assert(RowItem^.Magic = JvCsvRowMagic ); Assert(RowItem^.AllocSize>0); Assert(RowItem^.WordFieldsAddr > 0); Result := RowItem^.WordFieldsAddr + SizeOf(TJvCsvRowWordFields); Assert(Result < RowItem^.AllocSize); end; //------------------------------------------------------------------------- // TJvCsvStream METHODS //------------------------------------------------------------------------- function GetFileSizeEx(h: HFILE; FileSize: PULargeInteger): BOOL; stdcall; external Kernel32; procedure TJvCsvStream.Append; begin Stream.Seek(0, soFromEnd); end; constructor TJvCsvStream.Create(const FileName: string; Mode: DWORD; Rights: Cardinal); var IsAppend: Boolean; IsRewrite: Boolean; begin FFilename := FileName; FLastReadFlag := False; IsAppend := (Mode and fmJVCSV_APPEND_FLAG) = fmJVCSV_APPEND_FLAG; IsRewrite := (Mode and fmJVCSV_REWRITE_FLAG) = fmJVCSV_REWRITE_FLAG; FStream := TFileStream.Create(Filename, {16 lower bits only}Word(Mode){$IFDEF COMPILER6_UP}, Rights{$ENDIF COMPILER6_UP}); //Stream := FStream; { this makes everything in the base class actually work if we inherited from Easy Stream} if IsAppend then Self.Append // seek to the end. else Stream.Position := 0; if IsRewrite then Rewrite; _StreamReadBufInit; end; destructor TJvCsvStream.Destroy; begin if Assigned(FStream) then FStream.Position := 0; // avoid nukage FreeAndNil(FStream); FreeMem(FStreamBuffer); // Buffered reads for speed. inherited; end; function TJvCsvStream.Eof: Boolean; begin if not Assigned(FStream) then Result := False //Result := True else Result := FLastReadFlag and (FStreamIndex >= FStreamSize); //Result := FStream.Position >= FStream.Size; end; { TJvCsvStream.ReadLine: This reads a line of text, normally terminated by carriage return + linefeed but it is a bit special, and adapted for CSV usage because CR/LF characters inside quotes are read as a single line. This is a VERY PERFORMANCE CRITICAL function. We loop tightly inside here. So there should be as few procedure-calls inside the repeat loop as possible. This code is entirely new in JVCL 3.36 or later, added in September 2008. } function TJvCsvStream.ReadLine: AnsiString; var Buf: array of {$IFDEF COMPILER12_UP}Byte{$ELSE}Char{$ENDIF COMPILER12_UP}; n: Integer; ok: Boolean; QuoteFlag, LfFlag, CrFlag: Boolean; begin { Ignore linefeeds, read until carriage return, strip carriage return, and return it } SetLength(Buf,150); // SetLength(Buf,JvCsv_MAXLINELENGTH);//16384; // count := 1; n := 0; LfFlag := False; CrFlag := False; QuoteFlag := False; repeat if n >= Length(Buf) then SetLength(Buf, n + 100); if FStreamIndex >= FStreamSize then begin FStreamSize := Stream.Read(FStreamBuffer[0], JvCsvStreamReadChunkSize); if FStreamSize = 0 then begin if FStream.Position >= FStream.Size then FLastReadFlag:= True else raise EJvCsvDataSetError.CreateFmt('Can''t read CSV file %s', [FFilename]); end else if FStreamSize < JvCsvStreamReadChunkSize then FLastReadFlag := True; FStreamIndex := 0; end; if FStreamIndex >= FStreamSize then ok := False else begin Buf[n] := FStreamBuffer[FStreamIndex]; // p^; Inc(FStreamIndex); ok := True; end; if ok then begin if Buf[n]> JvCsvQuote {34} then // test for MOST common case first! begin Inc(n); CrFlag := False; LfFlag := False; end else begin if Buf[n] = JvCsvQuote {34} then // quote QuoteFlag := not QuoteFlag; if Buf[n] = JvCsvLf {10} then // linefeed begin LfFlag := True; Inc(n); end else if Buf[n]= JvCsvCR {13} then // carriage return begin CrFlag := True; Inc(n); end else begin Inc(n); CrFlag := False; LfFlag := False; end; if CrFlag and LfFlag and not QuoteFlag then Break; end; end; until not ok; Inc(n); Buf[n] := {$IFDEF COMPILER12_UP}0{$ELSE}#0{$ENDIF COMPILER12_UP}; SetLength(Buf, n); Result := PAnsiChar(@Buf[0]); { was string(Buf) } end; procedure TJvCsvStream.Rewrite; begin if Assigned(FStream) then FStream.Size := 0;// truncate! end; function TJvCsvStream.Size: Int64; { Get file size } begin if Assigned(FStream) then GetFileSizeEx(FStream.Handle, PULargeInteger(@Result)) {int64 Result} else Result := 0; end; { Look at this. A stream that can handle a string parameter. What will they think of next? } procedure TJvCsvStream.Write(const s: AnsiString); begin Stream.Write(s[1], Length(s)); {The author of TStreams would like you not to be able to just write Stream.Write(s). Weird. } end; procedure TJvCsvStream.WriteChar(c: AnsiChar); begin Stream.Write(c, 1); end; procedure TJvCsvStream.WriteCrLf; begin WriteChar(#13); WriteChar(#10); end; procedure TJvCsvStream.WriteLine(const s: AnsiString); begin Write(s); WriteCrLf; end; procedure TJvCsvStream._StreamReadBufInit; begin if not Assigned(FStreamBuffer) then begin //FStreamBuffer := AllocMem( JvCsvStreamReadChunkSize); GetMem(FStreamBuffer,JvCsvStreamReadChunkSize); end; end; //------------------------------------------------------------------------- // TJvCustomCsvDataSet METHODS //------------------------------------------------------------------------- constructor TJvCustomCsvDataSet.Create(AOwner: TComponent); begin inherited Create(AOwner); FData := TJvCsvRows.Create; {$IFDEF RTL150_UP} GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FFormatSettings); { this is updated later, to modify to have custom DecimalSeparator } {$ELSE} FFormatSettings.DecimalSeparator := DecimalSeparator; {$ENDIF RTL150_UP} Separator := ','; // set After creating FData! FCreatePaths := True; // Creates subdirectories automatically when saving. FInitialWorkingDirectory := GetCurrentDir; // from SysUtils; FReadOnly := False; FCursorOpen := False; FRecordPos := JvCsv_ON_BOF_CRACK; FLoadsFromFile := True; FSavesChanges := True; FHasHeaderRow := True; FValidateHeaderRow := True; { Additional initialization } FCsvColumns := TJvCsvColumns.Create; // FData.EnquoteBackslash := FEnquoteBackslash; //FCsvFileAsStrings := TStringList.Create; end; destructor TJvCustomCsvDataSet.Destroy; begin //FCsvFileAsStrings.Free; FreeMem(FTempBuffer); // Free the memory we allocated. FreeAndNil(FCsvStream); 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; function TJvCustomCsvDataSet.GetSeparator: AnsiChar; begin Assert(Assigned(FData)); Result := FData.Separator; end; function TJvCustomCsvDataSet._CsvFloatToStr(fvalue:Double):string; begin // raises exception EJvConvertError (same as EConvertError) FFormatSettings.DecimalSeparator := {$IFDEF COMPILER12_UP}Char({$ENDIF COMPILER12_UP}GetDecimalSeparator {$IFDEF COMPILER12_UP}){$ENDIF COMPILER12_UP}; Result := FloatToStr(fvalue{$IFDEF RTL150_UP}, FFormatSettings{$ENDIF RTL150_UP}); end; function TJvCustomCsvDataSet.GetTextBufferSize: Integer; begin Assert(Assigned(FData)); Result := FData.TextBufferSize; 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; { Filtering via wildcards requires the following helper function: } function _WildcardsMatchBoolOp(const Data, Pattern: AnsiString; BoolOp: AnsiChar): Boolean; var SubPattern: array [0..20] of AnsiString; I, Count: Integer; begin Count := JvAnsiStrSplit(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.SetActive(Value: Boolean); begin inherited; FFileDirty := False; if FUseSystemDecimalSeparator then begin FData.DecimalSeparator := {$IFDEF COMPILER12_UP}AnsiChar({$ENDIF COMPILER12_UP}SysUtils.DecimalSeparator{$IFDEF COMPILER12_UP}){$ENDIF COMPILER12_UP}; end; 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; // JvCsv Numeric filtering helper function: function JvCsvNumCondition(FieldValue: Double; CompareOperator: TJvCsvFilterNumCompare; NumValue: Double):Boolean; begin case CompareOperator of jfIntEqual: Result := Trunc(FieldValue) = Trunc(NumValue); jfIntNotEqual: Result := Trunc(FieldValue) <> Trunc(NumValue); jfLessThan: Result := FieldValue < NumValue; jfGreaterThan: Result := FieldValue > NumValue; else Result := False; end; end; // Recursive wildcard matching function function JvCsvWildcardMatch(Data, Pattern: AnsiString): 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 begin 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); end; // find any | and split into two or more strings, and run ORs on them FirstBoolCondition := Pos('&', string(Pattern)); if FirstBoolCondition > 0 then begin Result := _WildcardsMatchBoolOp(Data, Pattern, '&'); Exit; end; FirstBoolCondition := Pos('|', string(Pattern)); if FirstBoolCondition > 0 then begin Result := _WildcardsMatchBoolOp(Data, Pattern, '|'); Exit; end; FirstWildcard := Pos('%', string(Pattern)); // wildcards? if FirstWildcard = 0 then FirstWildcard := Pos('?', string(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: AnsiString; 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.SetMarginSize(const Value: Integer); begin if Active then raise Exception.Create('Can''t change memory properties on an active data set'); Assert(Assigned(FData)); FData.MarginSize := Value; end; // Numeric Filtering: Make Rows Visible Only if they match an Integer or floating point numeric comparison operator. // evaluate condition: // [FieldName] [numericoperator: < > = <> ] [Numeric Value Parameter] procedure TJvCustomCsvDataSet.SetFilterNum(const FieldName: string; compareOperator:TJvCsvFilterNumCompare; numValue: Double ); var I: Integer; PRow: PCsvRow; FieldRec: PCsvColumn; FieldIndex: Integer; sFieldValue: AnsiString; FieldValue:Double; //stillVisible : Integer; //m: TBookmark; begin // m := GetBookmark; FieldRec := FCsvColumns.FindByName(FieldName); // stillVisible := 0; if not Assigned(FieldRec) then Exit; FieldIndex := FieldRec^.FPhysical; // 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 sFieldValue := FData.GetARowItem(I, FieldIndex); if (Length(sFieldValue) > 0) and (sFieldValue[1] = '"') then sFieldValue := _Dequote(sFieldValue); // remove quotes. //sFieldValue := UpperCase(sFieldValue); // pointless on numerics try FieldValue := JvCsvStrToFloat(string(sFieldValue), GetDecimalSeparator); // remember, this baby throws EConvertError on exception! // if { FieldValue [ = <> > < ] numValue } then.... if JvCsvNumCondition(FieldValue, compareOperator, numValue) then // hide row if not same prefix begin // Inc(stillVisible) // count the number that are still visible. end else PRow^.Filtered := True except on E: EConvertError do PRow^.Filtered := True; // hide error rows. end; end;{if not already hidden!} end;{ for loop} FIsFiltered := True; if Active then First; end; // string Filtering: Make Rows Visible Only if they match filterString procedure TJvCustomCsvDataSet.SetFilter(const FieldName: string; Pattern: AnsiString); var ValueLen, I: Integer; PRow: PCsvRow; FieldRec: PCsvColumn; FieldIndex: Integer; FieldValue: AnsiString; //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 := {$IFDEF HAS_UNIT_ANSISTRINGS}AnsiStrings.{$ENDIF HAS_UNIT_ANSISTRINGS}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 := {$IFDEF HAS_UNIT_ANSISTRINGS}AnsiStrings.{$ENDIF HAS_UNIT_ANSISTRINGS}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; { Some advanced JvCsvData set users, like WP himself, the original component author need to create and modify CSV records directly. For example, a query engine constructed using JvCsvDataSet, may wish to move tuples (row memory objects) directly from one dataset to another, not value-by-value but the whole row at once. } function TJvCustomCsvDataSet._AllocateRow: PCsvRow; begin Result := PCsvRow( AllocMem( FData.GetRowAllocSize )); FData.InternalInitRecord( TJvRecordBuffer(Result)); // {was PChar(Result) } 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; { You shouldn't create a "TJvCsvRow-memory-buffer-record-aggregate" anywhere else than here. } function TJvCustomCsvDataSet.AllocRecordBuffer: TJvRecordBuffer; begin Assert(Assigned(FData)); Result := FData.AllocRecordBuffer; end; { calc fields support } procedure TJvCustomCsvDataSet.ClearCalcFields(Buffer: TJvRecordBuffer { was PChar}); begin // Assumes that our buffer is a TJvCsvRow followed by // a dynamically resized buffer used for calculated field // storage: { was FillChar } FillChar(Buffer[GetCalcDataOffset(PCsvRow(Buffer))], JvCsv_MaxCalcDataOffset{CalcFieldsSize}, {initbytevalue}0 ); end; { calc fields support and buffer support } function TJvCustomCsvDataSet.GetActiveRecordBuffer: TJvRecordBuffer { was 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.SetDecimalSeparator(const Value: AnsiChar); begin FData.DecimalSeparator := Value; end; procedure TJvCustomCsvDataSet.SetEnquoteBackslash(const Value: Boolean); begin Assert(Assigned(FData)); FData.FEnquoteBackslash := Value; end; function TJvCustomCsvDataSet.GetEnquoteBackslash: Boolean; begin Assert(Assigned(FData)); Result := FData.FEnquoteBackslash; end; procedure TJvCustomCsvDataSet.FreeRecordBuffer(var Buffer: TJvRecordBuffer { was PChar} ); begin if Buffer <> nil then FreeMem(Buffer); end; { called after the record is allocated } procedure TJvCustomCsvDataSet.InternalInitRecord(Buffer: TJvRecordBuffer { was PChar}); var RowPtr: PCsvRow; begin //Trace( 'InternalInitRecord '+IntToHex(Integer(Buffer),8) ); Assert(Assigned(FData)); FData.InternalInitRecord(Buffer); 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; RowPtrText:PAnsiChar; begin RowPtr^.Index := -1; // Not Yet Indexed RowPtr^.IsDirty := RowAlreadySaved; RowPtr^.Bookmark.Flag := bfEOF; RowPtr^.Bookmark.Data := JvCsv_ON_BOF_CRACK; // no index into FData yet. CsvRowSetColumnMarker(RowPtr, {column} 0, {marker value} 0); ColCount := FCsvColumns.Count; if ColCount <= 0 then ColCount := 10; RowPtrText:= @RowPtr^._Text[0]; for I := 1 to ColCount do begin // create an empty line of just commas if I < ColCount then RowPtrText[I - 1] := Separator else RowPtrText[I - 1] := Chr(0); RowPtrText[I] := Chr(0); CsvRowSetColumnMarker(RowPtr, {column} I - 1, {marker value} I - 1); CsvRowSetColumnMarker(RowPtr, {column} I, {marker value} JvCsv_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: AnsiString; 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 (Both floating point and string fields can get enquoted on us) if Field.DataType in [ftString,ftFloat] then begin L := Length(TempString); if L >= 2 then if (TempString[1] = '"') and (TempString[L] = '"') then TempString := _Dequote(TempString); // quoted string or floating point value. end; try case Field.DataType of ftString: Result := TempString; ftInteger: Result := StrToInt( string(TempString) ); ftFloat: { Default CLASSIC behaviour of this component is to encode outgoing data in US format regardless of system regional settings. This has become more flexible now, but we still default at designtime-defaults to using a DOT. } Result := JvCsvStrToFloat( string(TempString), GetDecimalSeparator ); ftBoolean: if StrToIntDef(string(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 := JvTimeTHexToDateTime(TempString,0); jcsvTZDateTime: Result := JvTimeTHexToDateTime(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 StrValueA: AnsiString; StrValueB: AnsiString; KeyFieldArray: array [0..20] of AnsiString; 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; CompareResult: Boolean; begin Result := False; Lo := -1; // Hi := -1; // Value is never used if not Active then Exit; if Pos(',', KeyFields) > 0 then Count := JvAnsiStrSplit( AnsiString(KeyFields), ',', Chr(0), KeyFieldArray, 20) else Count := JvAnsiStrSplit( AnsiString(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( string(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 := AnsiString(Value); StrValueB := AnsiString(KeyValues[I + Lo]); if loCaseInsensitive in Options then begin StrValueA := {$IFDEF HAS_UNIT_ANSISTRINGS}AnsiStrings.{$ENDIF HAS_UNIT_ANSISTRINGS}UpperCase(StrValueA); StrValueB := {$IFDEF HAS_UNIT_ANSISTRINGS}AnsiStrings.{$ENDIF HAS_UNIT_ANSISTRINGS}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 := JvCsv_ON_EOF_CRACK; Result := grEOF; Exit; end; end else begin // BackwardSkip mode Dec(FRecordPos); if FRecordPos < 0 then begin // hit BOF_CRACK FRecordPos := JvCsv_ON_BOF_CRACK; Result := grBOF; Exit; end; end; end; end; function TJvCustomCsvDataSet.GetRecord(Buffer: TJvRecordBuffer { was PChar}; GetMode: TGetMode; DoCheck: Boolean): TGetResult; var RowPtr: PCsvRow; begin Buffer[0] := JvZeroByte; 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 = JvCsv_ON_BOF_CRACK then Result := grBOF else if FRecordPos = JvCsv_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 = JvCsv_ON_EOF_CRACK then Result := grEOF else begin Inc(FRecordPos); if FRecordPos >= FData.Count then begin FRecordPos := JvCsv_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^, FData.GetRowAllocSize ); 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: AnsiString): AnsiString; var S: AnsiString; I, L: Integer; Ch: AnsiChar; LocalEnquoteBackslash: Boolean; begin LocalEnquoteBackslash := GetEnquoteBackslash; // can force on, or let it turn on automatically. if Pos( string(StrVal), Cr) > 0 then // we are going to need to enquote the backslashes LocalEnquoteBackslash := True; // absolutely need it in just this case. if Pos( string(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) and (BackslashCrLf) then // slighlty unstandard csv behavior, hopefully transparently interoperable with other apps that read CSVs S := S + '\r' else if (Ch = Lf) and (BackslashCrLf) 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 + '\\'; EnquoteBackslash := 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 // we used to strip any other low-ascii-unprintables but we don't anymore! S := S + Ch; end; S := S + '"'; // end quote. Result := S; end; function TJvCustomCsvDataSet.GetRecordSize: Word; begin Result := FData.RecordSize; end; procedure TJvCustomCsvDataSet.SetFieldData(Field: TField; Buffer: Pointer); var RowPtr: PCsvRow; NewVal: AnsiString; CP, PhysicalLocation: Integer; PDestination:TJvRecordBuffer; {was PChar;} CsvColumnData: PCsvColumn; DT: TDateTime; ATimeStamp: TTimeStamp; {$IFDEF JVCSV_WIDESTRING} NewUniVal: WideString; {$ENDIF JVCSV_WIDESTRINGS} begin //Trace( 'SetFieldData '+Field.FieldName ); PDestination := GetActiveRecordBuffer; RowPtr := PCsvRow(PDestination); Assert(RowPtr.Magic = JvCsvRowMagic, 'Internal data corruption detected in JvCustomCsvDataSet.SetFieldData'); // 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 := AnsiString(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 > JvCsv_MaxCalcDataOffset) then begin Exit; end; Inc(PDestination, GetCalcDataOffset(RowPtr) + Field.Offset); PDestination[0] := {$IFDEF COMPILER12_UP}Byte{$ELSE}AnsiChar{$ENDIF COMPILER12_UP}(Ord(Buffer <> nil)); if PDestination[0] <> JvZeroByte then {was .. <> #0} CopyMemory(@PDestination[1], Buffer, Field.DataSize); //Result := True; {there is no return value, oops} Exit; end; // If we get here, we are dealing with a physical record: // Set a field Data, taking the physical to logical ordering translation into // account: CsvColumnData := FCsvColumns.FindByFieldNo(Field.FieldNo); if not Assigned(CsvColumnData) then begin {$IFDEF DEBUGINFO_ON} OutputDebugString('JvCsvData.pas: Column data corrupt or missing.'); {$ENDIF DEBUGINFO_ON} Exit; end; PhysicalLocation := CsvColumnData^.FPhysical; // ----- BUG FIX FEB 2004 WP (Location #1 of 2) if (PhysicalLocation < 0) and FPendingCsvHeaderParse then begin FPendingCsvHeaderParse := False; // Just-in-time-CSV-header-parsing fixes a long standing bug. ProcessCsvHeaderRow; PhysicalLocation := CsvColumnData^.FPhysical; end; // ----- end if PhysicalLocation < 0 then Exit; if Buffer = nil then NewVal := '' else case Field.DataType of {$IFDEF JVCSV_WIDESTRING} ftWideString: { New and only working in Delphi 2009. Private-Convention-Warning: Wide fields ALWAYS enquoted. } begin { NOTE: This dies on Delphi 7, because Buffer was never initialized!} NewUniVal := WideString(PWideChar(Buffer)); //NewUniVal := PWideString(Buffer)^; {doesn't work either} NewVal := _Enquote(Utf8Encode(NewUniVal)); end; {$ENDIF JVCSV_WIDESTRING} ftString: begin // ftString appears to be limited to ANSI Strings even in Delphi 2009. if PAnsiChar(Buffer)[0] = Chr(0) then // WPFix Sept 2008 begin CP := -1 end else begin if Field.Size = 1 then begin CP := 0; end else begin for CP := 1 to Field.Size - 1 do if PAnsiChar(Buffer)[CP] = Chr(0) then Break; end; end; if CP > Field.Size - 1 then CP := Field.Size - 1; NewVal := Copy(PAnsiChar(Buffer), 1, CP + 1); //---------------------------------------------------------------------------------------------------- // string ENQUOTING IN CSV: If user displayed value contains a comma, a backslash, or a Double quote character // then we MUST encode the whole string as a string literal in quotes with the embeddded quotes // and backslashes preceded by a backslash character. //---------------------------------------------------------------------------------------------------- if AlwaysEnquoteStrings or (Pos(string(Separator), string(NewVal)) > 0) or (Pos(Cr, string(NewVal)) > 0) or (Pos(Lf, string(NewVal)) > 0) or (Pos('"', string(NewVal)) > 0) or ((Pos('\', string(NewVal)) > 0) and EnquoteBackslash) then NewVal := _Enquote(NewVal); // puts whole string in quotes, escapes embedded commas and quote characters! end; ftInteger: begin NewVal := AnsiString(IntToStr(PInteger(Buffer)^)); end; ftFloat: begin NewVal := AnsiString(_CsvFloatToStr(PDouble(Buffer)^)); if (AlwaysEnquoteFloats or (Separator = GetDecimalSeparator ) ) then NewVal := _Enquote(NewVal); // puts whole string in quotes, escapes embedded commas and quote characters! end; ftBoolean: NewVal := AnsiString(IntToStr(Ord(PWordBool(Buffer)^))); // bugfix May 26, 2003 - WP // There are two ways of handling date and time: ftDate: // NEW: TDateField support! if (CsvColumnData^.FFlag = jcsvAsciiDate) then begin ATimeStamp.Time := 0; ATimeStamp.Date := Integer(Buffer^); DT := TimeStampToDateTime(ATimeStamp); NewVal := JvDateIsoStr(DT); end else JvCsvDatabaseError2(FTableName, RsEFieldTypeNotHandled, Ord(CsvColumnData^.FFlag)); ftTime: // NEW: TTimeField support! if CsvColumnData^.FFlag = jcsvAsciiTime then begin ATimeStamp.Time := LongInt(Buffer^); ATimeStamp.Date := DateDelta; DT := TimeStampToDateTime(ATimeStamp); NewVal := JvTimeIsoStr(DT); end else JvCsvDatabaseError2(FTableName, RsEFieldTypeNotHandled, Ord(CsvColumnData^.FFlag)); ftDateTime: case CsvColumnData^.FFlag of // Localized date only (no time) in Ascii jcsvAsciiDate: begin DT := TimeStampToDateTime(MSecsToTimeStamp(Double(Buffer^))); NewVal := JvDateIsoStr(DT); end; // Localized time only (no date) in Ascii jcsvAsciiTime: begin DT := TimeStampToDateTime(MSecsToTimeStamp(Double(Buffer^))); NewVal := JvTimeIsoStr(DT); end; // Localized date+time in Ascii jcsvAsciiDateTime: begin DT := TimeStampToDateTime(MSecsToTimeStamp(Double(Buffer^))); NewVal := JvDateTimeIsoStr(DT); end; // GMT Times are stored in HEX jcsvGMTDateTime: begin DT := TimeStampToDateTime(MSecsToTimeStamp(Double(Buffer^))); NewVal := JvDateTimeToTimeTHex(DT, 0); end; jcsvTZDateTime: // Move a GMT time into a timezone: begin DT := TimeStampToDateTime(MSecsToTimeStamp(Double(Buffer^))); NewVal := JvDateTimeToTimeTHex(DT, FTimeZoneCorrection); end; else JvCsvDatabaseError2(FTableName, RsETimeTConvError, Ord(CsvColumnData^.FFlag)); end; else JvCsvDatabaseError2(FTableName, RsEFieldTypeNotHandled, Ord(CsvColumnData^.FFlag)); end; // Set new Data value (NewVal = string) SetCsvRowItem(RowPtr, PhysicalLocation, NewVal); if Assigned(FOnSetFieldData) and (RowPtr^.Index >= 0) then FOnSetFieldData(Self, FData.GetUserTag(RowPtr^.Index), FData.GetUserData(RowPtr^.Index), Field.FieldName, NewVal); // Set a dirty bit so we remember to write this later: CsvRowSetDirtyBit(PCsvRow(PDestination), PhysicalLocation); // Set the file-wide dirty bit: FFileDirty := True; // Notify controls of a field change: DataEvent(deFieldChange, Longint(Field)); end; // Removes first and last character of the string (assumes they are quotes, // to be called byGetFieldData only!) function TJvCustomCsvDataSet._Dequote(const StrVal: AnsiString): AnsiString; var S: AnsiString; I, L: Integer; Ch: AnsiChar; SkipFlag: Boolean; begin L := Length(StrVal); SkipFlag := False; S := ''; if Length(StrVal) < 2 then begin Result := S; Exit; end; for I := 2 to L - 1 do begin Ch := StrVal[I]; if EnquoteBackslash then begin if (not SkipFlag) and (Ch = '\') then begin SkipFlag := True; // whatever is after the backslash is an escaped literal character. Continue; end else begin // backslashed escape codes for carriage return, linefeed. if SkipFlag then begin case Ch of 'r': Ch := Cr; 's': Ch := #32; 't': Ch := Tab; 'n': Ch := Lf; end; end; SkipFlag := False; end; end else begin if (not SkipFlag) and (Ch = '"') and (I < (L - 1)) and (StrVal[I + 1] = '"') then begin SkipFlag := True; Continue; // skip first of the doubled quote characters. end else SkipFlag := False; end; S := S + Ch; end; Result := S; end; // Tells controls to redraw. procedure TJvCustomCsvDataSet.Refresh; var M: TBookmark; begin if State <> dsBrowse then Exit; DisableControls; try M := GetBookmark; // This appears a bit silly but it works very well. First; // Redraws all controls once to relocate to top. GotoBookmark(M); // Go back where we were. This could Result in some odd scrolling behaviour but I haven't seen it yet. finally EnableControls; end; end; function TJvCustomCsvDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean; var RowPtr:PCsvRow; PSource:TJvRecordBuffer; {was PChar;} UserString, TempString: AnsiString; PhysicalLocation: Integer; CsvColumnData: PCsvColumn; ADateTime: TDateTime; length_n:Integer; ts: TTimeStamp; {$IFDEF JVCSV_WIDESTRING} GetUniValue:WideString; {$ENDIF JVCSV_WIDESTRING} begin Result := False; //Trace( 'GetFieldData '+Field.FieldName ); if not FCursorOpen then Exit; if Field = nil then Exit; // 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 := AnsiString(GetColumnsAsString); ProcessCsvHeaderRow; // process FHeaderRow end; PSource := GetActiveRecordBuffer; // This should not be nil EXCEPT if table is Empty or Closed. if PSource = nil then begin // It is possible we could raise an exception here: // "GetActiveRecordBuffer is nil but table is not empty. (Internal Fault Condition)." Exit; end; RowPtr := PCsvRow(PSource); //------------------------------------------------------------------------ // Calculated and Lookup Field Handling // // direct memory copy into calculated field or lookup field Data area //------------------------------------------------------------------------ if (Field.FieldKind = fkCalculated) or (Field.FieldKind = fkLookup) then begin if (Field.Offset < 0) or (Field.Offset + Field.DataSize > JvCsv_MaxCalcDataOffset) then begin //It is possible we could raise an exception here: //Invalid field.Offset in Calculated or Lookup field Exit; end; Inc(PSource, GetCalcDataOffset( RowPtr ) + Field.Offset); if Buffer = nil then begin // NULL CHECK MEANS THAT SOMEONE IS ASKING IF THIS FIELD HAS A VALUE. RETURN True. Result := (Field.DataSize > 0); // Yes, we could read this field if you asked us to! Exit; end; if Field.DataSize <= 0 then PAnsiChar(Buffer)[0] := Chr(0) else // Get the field Data from the buffer: CopyMemory(Buffer, @PSource[1], Field.DataSize); if (Buffer <> nil) and (Field.DataSize > 0) then Result := True; Exit; end; //------------------------------------------------------------------------ // If we get here we must be dealing with a real column of Data // that is part of the CSV file rather than a calculated or lookup // field that is just in internal-memory: //------------------------------------------------------------------------ CsvColumnData := FCsvColumns.FindByFieldNo(Field.FieldNo); if not Assigned(CsvColumnData) then begin JvCsvDatabaseError(FTableName, Format(RsEUnableToLocateCSVFileInfo, [Field.Name])); Exit; end; PhysicalLocation := CsvColumnData^.FPhysical; // ----- BUG FIX FEB 2004 WP (Location #2 of 2) if (PhysicalLocation < 0) and FPendingCsvHeaderParse then begin FPendingCsvHeaderParse := False; // Just In Time! ProcessCsvHeaderRow; PhysicalLocation := CsvColumnData^.FPhysical; end; // --- if PhysicalLocation < 0 then begin // does it really exist in the CSV Row? JvCsvDatabaseError(FTableName, Format(RsEPhysicalLocationOfCSVField, [Field.FieldName])); Exit; end; //------------------------------------------------------------------------ // All items in the CSV table are natively stored as strings. Note that // an empty string is considered to be a NULL if the field type is anything // other than a ftString. There are no NULLs in ftString fields because // a CSV file can store an empty string but has no way of indicating a NULL. //------------------------------------------------------------------------ if Field.Offset + Field.DataSize > JvCsv_MAXLINELENGTH then begin Exit; end; TempString := GetCsvRowItem(RowPtr, PhysicalLocation); // Strip quotes first! if Field.DataType = ftString then begin length_n := Length(TempString); if length_n >= 2 then if (TempString[1] = '"') and (TempString[length_n] = '"') then // quoted string! TempString := _Dequote(TempString); end; // Custom Get Method allows us to create a "Virtual DataSet" where the Data // in the CSV rows is really just a mirror which can be updated when displayed // but which we really are fetching from somewhere else. if Assigned(FOnGetFieldData) and (RowPtr^.Index >= 0) and (not RowPtr^.RecursionFlag) then begin RowPtr^.RecursionFlag := True; UserString := TempString; FOnGetFieldData(Self, FData.GetUserTag(RowPtr^.Index), FData.GetUserData(RowPtr^.Index), Field.FieldName, UserString); if UserString <> TempString then begin // Write changed value back to row: SetCsvRowItem(RowPtr, PhysicalLocation, UserString); TempString := UserString; // Notify controls of a field change: //DataEvent(deFieldChange, LongInt(Field)); // XXX Doesn't do what I needed. left here commented out // in case I ever go back and try to get something like this // working again. end; RowPtr^.RecursionFlag := False; end; // NULL: There are no "Real" NULLS in an ASCII flat file, however for anything // other than a string field, we will return "NULL" to indicate there is an // empty string in the field. if Field.DataType <> ftString then if TempString = '' then Exit; // NULL field. { If buffer is nil, then we are being asked to do a null check only.} if Buffer = nil then begin if TempString = '' then Result := False else Result := True; Exit; { cannot actually copy Data into nil buffer, so returns now. } end; //------------------------------------------------------------------------ // If we get here Buffer must NOT be nil. Now we handle // some csv to TField conversions: //------------------------------------------------------------------------ try case Field.DataType of {$IFDEF JVCSV_WIDESTRING} ftWideString: begin {$IFDEF COMPILER12_UP} GetUniValue := UTF8ToWideString(_Dequote(TempString)); {$ELSE} GetUniValue := UTF8Decode(_Dequote(TempString)); {$ENDIF COMPILER12_UP} length_n := Length(GetUniValue)*2; if (length_n>FData.FTextBufferSize) then length_n := FData.FTextBufferSize; if (length_n>Field.Size*2) then length_n := Field.Size*2; MoveMemory( {dest} Buffer, {src} PWideChar(GetUniValue), {count} length_n); PWideChar(Buffer)[Length(GetUniValue)] := WideChar(0); { wide terminal } end; {$ENDIF JVCSV_WIDESTRING} // Basic string copy, convert from string to fixed-length // buffer, padded with NUL i.e. Chr(0): ftString: begin length_n := Length(TempString); if (length_n>FData.FTextBufferSize) then length_n := FData.FTextBufferSize; if (length_n>Field.Size) then length_n := Field.Size; MoveMemory( {dest} Buffer, {src} PAnsiChar(TempString), {count} length_n); PAnsiChar(Buffer)[length_n] := #0; end; // Standard Integer conversion: ftInteger: PInteger(Buffer)^ := StrToInt(string(TempString)); // Standard Double-precision Float conversion: ftFloat: PDouble(Buffer)^ := JvCsvStrToFloat(string(TempString),GetDecimalSeparator); // was StrToFloatUS ftBoolean: if TempString = '' then PInteger(Buffer)^ := 0 else if StrToIntDef( string(TempString), 0) <> 0 then PWordBool(Buffer)^ := True // bugfix May 26, 2003 - WP else PWordBool(Buffer)^ := False; // bugfix May 26, 2003 - WP ftDate: if ( CsvColumnData^.FFlag = jcsvAsciiDate) then // Ascii Date yyyy/mm/ddd begin ADateTime := JvIsoDateStrToDate(TempString); if ADateTime <= 1.0 then begin Result := False; { field is NULL, no date/time value } Exit; end; // XXX Delphi Weirdness Ahead. Read docs before you try to // understand this. The data in Buffer^ is an Integer timestamp Integer(Buffer^) := DateTimeToTimeStamp(ADateTime).Date; end else JvCsvDatabaseError(FTableName, RsETimeTConvError); ftTime: if ( CsvColumnData^.FFlag = jcsvAsciiTime) then begin ADateTime := JvIsoTimeStrToTime(TempString); if ADateTime < 0.0 then begin Result := False; { field is NULL, no date/time value } Exit; end; // The data in Buffer^ is an Integer timestamp Integer(Buffer^) := DateTimeToTimeStamp(ADateTime).Time; end else JvCsvDatabaseError(FTableName, RsETimeTConvError); ftDateTime: case CsvColumnData^.FFlag of jcsvAsciiDate: // Ascii Date yyyy/mm/ddd begin ADateTime := JvIsoDateStrToDate(TempString); if ADateTime <= 1.0 then begin Result := False; { field is NULL, no date/time value } Exit; end; ts := DateTimeToTimeStamp(ADateTime); if (ts.Time = 0) and (ts.Date = 0) then begin Exit; end; // XXX Delphi Weirdness Ahead. Read docs before you try to // understand this. We want to store 8 bytes at Buffer^, this // is how we do it. Double(Buffer^) := TimeStampToMSecs(DateTimeToTimeStamp(ADateTime)); end; jcsvAsciiTime: // Ascii Time 08:23:15 begin ADateTime := JvIsoTimeStrToTime(TempString); if ADateTime <= 1.0 then begin Result := False; { field is NULL, no date/time value } Exit; end; ts := DateTimeToTimeStamp(ADateTime); if (ts.Time = 0) and (ts.Date = 0) then begin Exit; end; // XXX Delphi Weirdness Ahead. Read docs before you try to // understand this. We want to store 8 bytes at Buffer^, this // is how we do it. Double(Buffer^) := TimeStampToMSecs(DateTimeToTimeStamp(ADateTime)); end; // Ascii Date 1999/03/05 08:23:15 jcsvAsciiDateTime: begin ADateTime := JvIsoDateTimeStrToDateTime(TempString); if ADateTime <= 1.0 then begin Result := False; { field is NULL, no date/time value } Exit; end; ts := DateTimeToTimeStamp(ADateTime); if (ts.Time = 0) and (ts.Date = 0) then begin Exit; end; // XXX Delphi Weirdness Ahead. Read docs before you try to // understand this. We want to store 8 bytes at Buffer^, this // is how we do it. Double(Buffer^) := TimeStampToMSecs(DateTimeToTimeStamp(ADateTime)); end; // GMT Times are Stored in HEX: jcsvGMTDateTime: Double(Buffer^) := TimeStampToMSecs(DateTimeToTimeStamp(JvTimeTHexToDateTime(TempString, 0))); // Move GMT into a Timezone: jcsvTZDateTime: Double(Buffer^) := TimeStampToMSecs(DateTimeToTimeStamp(JvTimeTHexToDateTime(TempString, FTimeZoneCorrection))); else JvCsvDatabaseError(FTableName, RsETimeTConvError); end; else // not a valid ftXXXX type for this TDataSet descendant!? JvCsvDatabaseError2(FTableName, RsEFieldTypeNotHandled, Ord(Field.DataType) ); end except on E: EConvertError do begin Result := False; // return a NULL. Exit; end; end; // All is Well. Result := True; end; // Our bookmark Data is a pointer to a PCsvData function TJvCustomCsvDataSet.GetBackslashCrLf: Boolean; begin if Assigned(FData) then Result := FData.BackslashCrLf else Result := false; end; procedure TJvCustomCsvDataSet.GetBookmarkData(Buffer: TJvRecordBuffer { was PChar}; Data: Pointer); begin // I := PCsvRow(Buffer)^.bookmark.Data; PInteger(Data)^ := PCsvRow(Buffer)^.Bookmark.Data; end; function TJvCustomCsvDataSet.GetBookmarkFlag(Buffer: TJvRecordBuffer { was PChar}): TBookmarkFlag; begin Result := PCsvRow(Buffer)^.Bookmark.Flag; end; // nobody mentioned that I needed this to be overloaded, but I only found // out when I found that DBGrid and other controls that compare bookmarks // won't function if you don't provide a non-default implementation of this. function TJvCustomCsvDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; var V1, V2: Integer; begin // (rom) fixed implementation. V1 := -MaxInt; V2 := -MaxInt; if Bookmark1 <> nil then V1 := PInteger(Bookmark1)^; if Bookmark2 <> nil then V2 := PInteger(Bookmark2)^; Result := Bookmark_Eql; if V1 < V2 then Result := Bookmark_Less else if V1 > V2 then Result := Bookmark_Gtr; end; procedure TJvCustomCsvDataSet.SetBookmarkFlag(Buffer: TJvRecordBuffer { was PChar}; Value: TBookmarkFlag); begin PCsvRow(Buffer)^.Bookmark.Flag := Value; end; procedure TJvCustomCsvDataSet.InternalGotoBookmark(Bookmark: Pointer); begin {Bookmark is just pointer to Integer} FRecordPos := PInteger(Bookmark)^; end; procedure TJvCustomCsvDataSet.InternalSetToRecord(Buffer: TJvRecordBuffer { was PChar}); begin FRecordPos := PCsvRow(Buffer)^.Bookmark.Data; // Look up index from the record. // Resync([]); end; // Also used when inserting: procedure TJvCustomCsvDataSet.SetBackslashCrLf(const Value: Boolean); begin if Assigned(FData) then FData.BackslashCrLf := Value; end; procedure TJvCustomCsvDataSet.SetBookmarkData(Buffer: TJvRecordBuffer { was PChar}; Data: Pointer); begin PCsvRow(Buffer)^.Bookmark.Data := PInteger(Data)^; end; procedure TJvCustomCsvDataSet.InternalFirst; begin // Eof := False; FRecordPos := JvCsv_ON_BOF_CRACK; end; // CsvFieldDef: // // A property of our Data Set called CsvFieldDef is treated as // declaration of the fields in the CSV table. // // ,,..., // = columname: // // See comments at the top of this unit for a discussion of the // various VCL DB field types like Integer and string, and how // they map to the special "FieldTypeChar" values defined here. procedure TJvCustomCsvDataSet.InternalInitFieldDefs; var CsvFieldOption : AnsiString; CsvFieldName : AnsiString; aCsvFieldDef : AnsiString; CsvKeys : array of AnsiString; CsvFieldRec : PCsvRow; //record type. PCsvFieldDef : PCsvColumn; I : Integer; ColNum : Integer; Pos1 : Integer; symbolOrdinal : Integer; FieldTypeChar : AnsiChar; // field options (%=Integer, etc) VclFieldType : TFieldType; // official VCL field type FieldLen : Integer; FieldType : TJvCsvColumnFlag; CsvMaxLen : Integer; // Safety! begin CsvMaxLen := 0; CsvFieldRec := PCsvRow(FData.AllocRecordBuffer); try FieldType := jcsvString; VclFieldType := ftString; // create FieldDefs which map to each field in the Data record FieldDefs.Clear; // Clear VCL Database field definitions FCsvColumns.Clear; // Clear our own CSV related field Data aCsvFieldDef := AnsiString(CsvFieldDef); if aCsvFieldDef = '' then begin if FHasHeaderRow and ReadCsvFileStream then begin aCsvFieldDef := FCsvFileTopLine; {formerly FCsvFileAsStrings[0];} {$IFDEF DEBUGINFO_ON} if (aCsvFieldDef='') then OutputDebugString('Top line of file empty. CsvFieldDef not provided either.'); {$ENDIF DEBUGINFO_ON} end; if ExtendedHeaderInfo then CsvFieldDef := string(aCsvFieldDef); end; if Length(aCsvFieldDef) > 0 then begin if (Separator<>',') and (Pos(Separator,aCsvFieldDef)=0) then begin JvStringToCsvRow(aCsvFieldDef, ',', CsvFieldRec, False, False); { workaround for serious annoyance } end else begin JvStringToCsvRow(aCsvFieldDef, Separator, CsvFieldRec, False, False); end; ColNum := 0; while CsvRowGetColumnMarker(CsvFieldRec, ColNum) <> JvCsv_COLUMN_ENDMARKER do begin FieldLen := 80; // default. CsvFieldOption := GetCsvRowItem(CsvFieldRec, ColNum); // get a string in the format COLUMNAME:Options // Look for Colon or Semicolon: Pos1 := Pos(':', string(CsvFieldOption)); if Pos1 <= 0 then Pos1 := Pos(';', string(CsvFieldOption)); if Pos1 <= 0 then begin CsvFieldName := CsvFieldOption; CsvFieldOption := '$'; FieldTypeChar := '$'; end else begin // extract field name: CsvFieldName := Copy(CsvFieldOption, 1, Pos1 - 1); // If character after the colon is a symbol character, grab // it, otherwise default to '$'. New ~ tilda character ordinal is 126. // Other symbols are all less than 65 (capital A). symbolOrdinal := Ord(CsvFieldOption[Pos1 + 1]); if (symbolOrdinal < Ord('A')) or (symbolOrdinal >= Ord('~')) then begin FieldTypeChar := CsvFieldOption[Pos1 + 1]; CsvFieldOption := Copy(CsvFieldOption, Pos1 + 2, 80); end else begin FieldTypeChar := '$'; CsvFieldOption := Copy(CsvFieldOption, Pos1 + 1, 80); end; FieldLen := StrToIntDef( string(CsvFieldOption), JvCsv_DEFAULT_CSV_STR_FIELD); end; case FieldTypeChar of '$': begin // $=string CsvMaxLen := CsvMaxLen + FieldLen; VclFieldType := ftString; FieldType := jcsvString; end; '%': begin // %=Integervalue VclFieldType := ftInteger; FieldType := jcsvNumeric; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 5; end; '&': begin // &=Float value VclFieldType := ftFloat; FieldType := jcsvNumeric; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 5; end; '@': begin // @=Datetime as Ascii YYYY/MM/DD HH:MM:SS VclFieldType := ftDateTime; FieldType := jcsvAsciiDateTime; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 20; end; '/': begin // /=date only as ascii YYYY/MM/DD VclFieldType := ftDate; FieldType := jcsvAsciiDate; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 10; end; '*': begin // *=time only as HH:MM:SS VclFieldType := ftTime; FieldType := jcsvAsciiTime; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 10; end; '!': begin // != Boolean field True/False VclFieldType := ftBoolean; // Boolean field in dataset FieldType := jcsvNumeric; // numeric field in file FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 1; end; '#': begin // #=Datetime as Seconds since 1970 stored in HEX VclFieldType := ftDateTime; FieldType := jcsvGMTDateTime; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 10; end; '-': begin // -=Datetime as Seconds since 1970 stored in HEX VclFieldType := ftDateTime; FieldType := jcsvTZDateTime; FieldLen := 0; // automatic. CsvMaxLen := CsvMaxLen + 10; end; {$IFDEF JVCSV_WIDESTRING} '~': begin // New UTF8 string type. [ Delphi 2009 only ] CsvMaxLen := CsvMaxLen + FieldLen; VclFieldType := ftWideString; FieldType := jcsvStringUTF8; end {$ENDIF JVCSV_WIDESTRING} else JvCsvDatabaseError(FTableName, Format(RsEInvalidFieldTypeCharacter, [FieldTypeChar])); end; if CsvFieldName = '' then begin JvCsvDatabaseError(FTableName, RsEUnexpectedError); Break; end; // sometime later: unpack the rest of the string // and declare ftString,ftFloat,ftInteger,ftDateTime, etc. // now add the field: Inc(ColNum); if (CsvMaxLen> FData.TextBufferSize) then begin raise Exception.Create('Too many fields, or too many long string fields in this record. You must increase the internal record size of the CsvDataSet'); end; // This may throw an exception. but we'll just allow // that as necessary: //Was: TFieldDef.Create(FieldDefs, ...., ColNum); FieldDefs.Add( string(CsvFieldName), VclFieldType, FieldLen, False); // Now create our internal field Data structure: PCsvFieldDef := AllocMem(SizeOf(TJvCsvColumn) {+ 8 BIGFudge}); PCsvFieldDef^.FFlag := FieldType; {such as jcsvString} PCsvFieldDef^.FFieldDef := FieldDefs.Find( string(CsvFieldName)); // Note: field order is established when we open the file (later) PCsvFieldDef^.FPhysical := -1; // not yet located in the physical file! FCsvColumns.AddColumn(PCsvFieldDef); end; // if the file doesn't contain this and we haven't // generated it yet, generate the header row: if (not FHasHeaderRow) and (FHeaderRow = '') then FHeaderRow := AnsiString(GetColumnsAsString); if Length(FHeaderRow) > 0 then ProcessCsvHeaderRow; // process FHeaderRow end else JvCsvDatabaseError(FTableName, RsEFieldDefinitionError); if FCsvKeyDef = '' then FCsvKeyCount := 0 else begin SetLength(CsvKeys, FCsvColumns.Count); FCsvKeyCount := JvAnsiStrSplit(AnsiString(FCsvKeyDef), Separator, {Chr(0)=No Quoting} Chr(0), CsvKeys, FCsvColumns.Count); SetLength(FCsvKeyFields, FCsvKeyCount); if (FCsvKeyCount < 1) or (FCsvKeyCount > FCsvColumns.Count) then JvCsvDatabaseError(FTableName, RsEInvalidCsvKeyDef); for I := 0 to FCsvKeyCount - 1 do begin if CsvKeys[I] = '' then JvCsvDatabaseError(FTableName, RsEInternalErrorParsingCsvKeyDef); PCsvFieldDef := FCsvColumns.FindByName( string(CsvKeys[I])); if not Assigned(PCsvFieldDef) then JvCsvDatabaseError(FTableName, Format(RsEContainsField, [CsvKeys[I]])) else begin PCsvFieldDef^.FKeyFlag := True; FCsvKeyFields[I] := PCsvFieldDef; end; end; end; // New:Array of Booleans used for ascending order on primary key sorting! SetLength(FAscending, FCsvKeyCount + 1); for I := 0 to Length(FAscending) - 1 do FAscending[I] := True; finally FreeMem(CsvFieldRec); end; end; { set our position onto the EOF Crack } procedure TJvCustomCsvDataSet.InternalLast; begin // Eof := True; FRecordPos := JvCsv_ON_EOF_CRACK; // FData.Count; end; // At shutdown or on user-calling this method, check if Data has changed, // and write changes to the file. procedure TJvCustomCsvDataSet.Flush; var n:Integer; CsvLine:AnsiString; begin if FTableName = '' then raise EJvCsvDataSetError.CreateRes(@RsETableNameNotSet); if FFileDirty and FSavesChanges and (Length(FTableName) > 0) then begin // Make backup first, if enabled (>2) if FAutoBackupCount > 0 then begin if FAutoBackupCount < 10 then FAutoBackupCount := 10; // can't be between 1 and 9, must be at least 10. JvCsvBackupPreviousFiles(FOpenFileName, FAutoBackupCount); end; // Now write new file. // creates a TStringList: old method: ExportCsvFile(FOpenFileName); if not WriteCsvFileStream then raise EJvCsvDataSetError.Create('Unable to write to csv file '+FTableName); if FHasHeaderRow then begin FCsvStream.WriteLine(FHeaderRow); end; for n := 0 to RecordCount-1 do begin {$IFDEF COMPILER12_UP} CsvLine := JvTrimAnsiStringCrLf( GetRowAsAnsiString(n)); {$ELSE} CsvLine := JvTrimAnsiStringCrLf( GetRowAsString(n)); {$ENDIF COMPILER12_UP} FCsvStream.WriteLine(CsvLine); end; FreeAndNil(FCsvStream); FFileDirty := False; end; end; {procedure TJvCustomCsvDataSet.DestroyFields; begin inherited DestroyFields; // Clear out local TCsvFieldDefs. FCsvColumns.Clear; end;} procedure TJvCustomCsvDataSet.InternalClose; begin if not FCursorOpen then Exit; Flush; BindFields(False); if DefaultFields then DestroyFields; FData.Clear; FCursorOpen := False; FRecordPos := JvCsv_ON_BOF_CRACK; FOpenFileName := ''; FCsvFileLoaded := false; FData.FRecordsValid:=false; end; procedure TJvCustomCsvDataSet.InternalHandleException; begin // standard implementation for this method: if Application <> nil then Application.HandleException(Self); end; procedure TJvCustomCsvDataSet.InternalDelete; begin if (FRecordPos >= 0) and (FRecordPos < FData.Count) then // FreeMem performed inside DeleteRow! FData.DeleteRow(FRecordPos); if FRecordPos >= FData.Count then FRecordPos := FData.Count - 1; FFileDirty := True; end; { returns -1 if not found, else returns record index } function TJvCustomCsvDataSet.InternalFindByKey(Row: PCsvRow): Integer; var I: Integer; begin Result := -1; for I := 0 to FData.Count - 1 do if InternalCompare(FCsvKeyFields, FCsvKeyCount, {Left} Row, {Right} FData.Items[I], FAscending) = 0 then begin Result := I; Break; end; end; function TJvCustomCsvDataSet.FindByCsvKey(const Key: AnsiString): Boolean; var LogicalRow, PhysicalRow: PCsvRow; I, RecNo: Integer; aStr: AnsiString; begin Result := False; LogicalRow := PCsvRow(FData.AllocRecordBuffer); PhysicalRow := PCsvRow(FData.AllocRecordBuffer); try JvStringToCsvRow( Key + Separator, Separator, LogicalRow, False, False); // initialize row and put items in their logical order. CsvRowInit(@PhysicalRow); // Move from Logical (TFieldDef order) to their physical (As found in CSV file) ordering: for I := 0 to FCsvKeyCount - 1 do begin aStr := GetCsvRowItem(@LogicalRow, I); SetCsvRowItem(@PhysicalRow, FCsvKeyFields[I].FPhysical, aStr); end; RecNo := InternalFindByKey(PhysicalRow); if RecNo < 0 then Exit; FRecordPos := RecNo; Resync([]); Result := True; finally FreeMem(LogicalRow); FreeMem(PhysicalRow); end; end; procedure TJvCustomCsvDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); var RecPos: Integer; PAddRec: PCsvRow; // KeyIndex: Integer; RowPtrText :PAnsiChar; begin if FInsertBlocked then begin JvCsvDatabaseError(FTableName, RsEInsertBlocked); Exit; end; if FRecordPos = JvCsv_ON_BOF_CRACK then FRecordPos := 0; if FRecordPos = JvCsv_ON_EOF_CRACK then FRecordPos := FData.Count; PAddRec := PCsvRow( AllocMem( FData.GetRowAllocSize )); if Buffer <> nil then Move(PCsvRow(Buffer)^, PAddRec^, FData.GetRowAllocSize ) else FData.InternalInitRecord({was PChar} TJvRecordBuffer(PAddRec)); RowPtrText:= @PAddRec^._Text[0]; if RowPtrText = '' then JvStringToCsvRow(FEmptyRowStr, Separator, PAddRec, False, False); // initialize row. PAddRec^.IsDirty := RowNeedsSaving; PAddRec^.Index := -1; // Was not loaded from the file! // FData.EnquoteBackslash := EnquoteBackslash; // {finally stupidity like this is solved} FFileDirty := True; if Append then begin //this is the parameter not a TDataSet method invocation! PAddRec^.Index := FData.Count; FData.AddRow(PAddRec); InternalLast; end else begin if (FRecordPos = JvCsv_ON_EOF_CRACK) or (FRecordPos = JvCsv_ON_BOF_CRACK) then begin PAddRec^.Index := FData.Count; FData.AddRow(PAddRec); InternalLast; end else begin RecPos := FRecordPos; PAddRec^.Index := RecPos; FData.Insert(RecPos, Pointer(PAddRec)); // XXX Renumber everything else. end; end; end; { During the parsing stage only, we have the contents of the file loaded in memory as a TString LIst. This creates that TString List. } function TJvCustomCsvDataSet.GetFileName: string; begin // If FTableName is not set, you can't save or load a file, fire an exception: Assert(Length(FTableName) <> 0, RsEInvalidTableName); if (Length(FTableName) > 2) and (FTableName[1] = '.') and IsPathDelimiter(FTableName, 2) then // reasonably portable, okay? // Design-time local paths that don't move if the current working // directory moves. These paths reference the directory the program // starts in. To use this at design time you have to enter the // table name as '.\Subdirectory\FileName.csv' (or './subdir/...' on Kylix) Result := IncludeTrailingPathDelimiter(FInitialWorkingDirectory) + FTableName // SPECIAL CASE. else Result := ExpandUNCFilename(FTableName); // Expand using current working directory to full path name. DEFAULT BEHAVIOR. end; function TJvCustomCsvDataSet.GetMarginSize: Integer; begin Assert(Assigned(FData)); Result := FData.MarginSize; end; { ReadCsvFileStream: formerly InternalLoadFileStrings, which used to use a TStringLIst to load CSVs. WHich is fine for toy use, but not for real world cases like when CR/LF characters are embedded. Also, it's wasteful of memory to create a giant in-memory TStringList and then copy it to our table record objects, so now we read the disk file, and create our single set of objects, saving memory, and maybe even being faster, especially when memory is not plentiful or the CSV file being loaded is very large. } function TJvCustomCsvDataSet.ReadCsvFileStream: Boolean; begin Result := False; if (FTableName='') or (not FileExists(FTableName)) then Exit; // We can return immediately ONLY if there is no file to load, // otherwise this routine is parsing already-loaded Data, and we should NOT // return, or we won't get our Data in the table. -WP. if FCsvFileLoaded then begin Result := True; //loaded already! just return true and quit. Exit; // don't repeat! end; FCsvFileLoaded := true; if FLoadsFromFile then begin if not Assigned(FCsvStream) then FCsvStream := TJvCsvStream.Create(FOpenFileName) else FCsvStream.Stream.Position := 0; // rewind. if FHasHeaderRow then FCsvFileTopLine := JvTrimAnsiStringCrLf(FCsvStream.ReadLine); {$IFNDEF NO_UNICODE} //------------------------------------------------------------------------- // This is the first unicode-friendly feature in JvCsvDataSet... // We can at least still open UTF8 files if they are really just ASCII // files plus a BOM marker like Windows notepad and some other apps add. //------------------------------------------------------------------------- //FUtf8Detected := false; {Future.} if (Length(FCsvFileTopLine)>3) then begin // JvCsvData can detect the standard UTF-8 mark and work anyways when it is present // but cannot yet decode any special characters. This is a step on the route to proper // UTF-8 support. [uses JclUnicode.BOM_UTF8 to detect.] if (BOM_UTF8[0]= Ord(FCsvFileTopLine[1])) and (BOM_UTF8[1]= Ord(FCsvFileTopLine[2])) and (BOM_UTF8[2]= Ord(FCsvFileTopLine[3])) then begin // strip UTF-8 marker: FCsvFileTopLine := Copy(FCsvFileTopLine,4,Length(FCsvFileTopLine)); //FUtf8Detected := true; {future.} end; end; {$ENDIF ~NO_UNICODE} Result := True; // it worked! end; end; function TJvCustomCsvDataSet.WriteCsvFileStream: Boolean; begin Result := False; if FTableName = '' then Exit; // We can return immediately ONLY if there is no file to load, // otherwise this routine is parsing already-loaded Data, and we should NOT // return, or we won't get our Data in the table. -WP. FreeAndNil(FCsvStream); FCsvStream := TJvCsvStream.Create(FOpenFileName, fmJVCSV_Truncate ); Result := True; // it worked! end; { XXXX TODO: FIX ME ! XXXX During the parsing stage only, we have the contents of the file loaded in memory as a TString LIst. This cleans up that TString List. NOTE: After removing the TStringLIst.LoadFromFile method of loading up the CSV Data Set, this code was not needed,but at some point I need to reimplement it, which is why I didn't delete this block of commented out code. There are cases where a user of this CSV Data Set component will add fields to his CSV component, then open an old CSV file, and we want a transparent upgrade of the customer/end-user's CSV file to contain the new CSV commas. Perhaps the CSV parser/stream readline component needs to have a fixup mode? } // Add 1+ commas to FCsvFileAsStrings[1 .. Count-1] (*procedure TJvCustomCsvDataSet.AppendPlaceHolderCommasToAllRows(Strings: TStrings); var Commas: AnsiString; I: Integer; begin for I := 1 to AppendedFieldCount do Commas := Commas + Separator; Strings.BeginUpdate; try for I := 1 to Strings.Count - 1 do Strings[I] := Strings[I] + string(Commas); finally Strings.EndUpdate; end; end; *) procedure TJvCustomCsvDataSet.InternalOpen; var TempBuf: array [0..JvCsv_MAXCOLUMNS] of AnsiChar; // Contains a string containing a whole bunch of commas! AppendStr:AnsiString; CsvLine:AnsiString; Counter:Integer; csvFileExists :Boolean; begin if FCursorOpen then InternalClose; // close first! Counter := 0; FOpenFileName := GetFileName; // Always use the same file name to save as you did to load!!! MARCH 2004.WP FFileDirty := False; if (FTableName = '') and FLoadsFromFile then JvCsvDatabaseError(RsENoTableName, RsETableNameRequired); InternalInitFieldDefs; // initialize FieldDef objects. // Create TField components when no persistent fields have been created if DefaultFields then CreateFields; BindFields(True); // bind FieldDefs to actual Data if FCsvColumns.Count > 1 then begin // Create a null terminated string which is just a bunch of commas: FillChar(TempBuf, JvCsv_MAXCOLUMNS - 1, 0); FillChar(TempBuf, FCsvColumns.Count - 1, Separator); TempBuf[FCsvColumns.Count - 1] := Chr(0); // When adding an empty row, we add this string as the ascii equivalent: FEmptyRowStr := TempBuf; end else FEmptyRowStr := ''; // nothing. FRecordPos := JvCsv_ON_BOF_CRACK; // initial record pos before BOF BookmarkSize := SizeOf(Integer); // initialize bookmark size for VCL (Integer uses 4 bytes on 32 bit operating systems) csvFileExists:= False; if FLoadsFromFile then // ReadCsvFileStream:Creates file stream and start reading it. Sets FCsvFileTopLine. csvFileExists := ReadCsvFileStream; if FHasHeaderRow then begin if csvFileExists and not ExtendedHeaderInfo and (FCsvFileTopLine <> '') then FHeaderRow := FCsvFileTopLine else begin FHeaderRow := AnsiString(GetColumnsAsString); // creating a new file! set up HeaderRow FCsvFileTopLine := FHeaderRow; end; if Length(FHeaderRow) > 0 then try ProcessCsvHeaderRow; except FHeaderRow:= ''; FreeAndNil(FCsvStream); raise; end; if FAppendedFieldCount > 0 then begin FillChar(TempBuf, FAppendedFieldCount, Separator); TempBuf[FAppendedFieldCount] := Chr(0); AppendStr := TempBuf; end; end; // Load rows from disk to memory, using Stream object to read line by line. if FLoadsFromFile and Assigned(FCsvStream) then begin while not FCsvStream.Eof do begin CsvLine := JvTrimAnsiStringCrLf(FCsvStream.ReadLine);// leading space, trailing space and crlf are removed by Trim! if CsvLine <> '' then begin if (FSpecialDataMarker <> '') and (Pos(FSpecialDataMarker, string(CsvLine)) = 1) and Assigned(FOnSpecialData) then begin // This very rarely used feature should // probably be removed from the JVCL? -WPostma. FOnSpecialData(Self, Counter, CsvLine); end else begin // Process the row: ProcessCsvDataRow(CsvLine, Counter); Inc(Counter); end; end; end; {while} end;{if} if Active then First; FCursorOpen := True; { clean up stream object } FreeAndNil( FCsvStream); end; procedure TJvCustomCsvDataSet.InternalPost; var PInsertRec: PCsvRow; RecPos: Integer; KeyIndex: Integer; // If unique key enforcement is on, this is the key search Result. begin if FRecordPos = JvCsv_ON_BOF_CRACK then FRecordPos := 0; if FRecordPos = JvCsv_ON_EOF_CRACK then FRecordPos := FData.Count; if FPostBlocked then begin JvCsvDatabaseError(FTableName, RsEPostingHasBeenBlocked); Exit; end; { Unique Key Enforcement : WARNING This doesn't exactly work correctly right now! - WP APRIL 2004.} if FCsvUniqueKeys then begin KeyIndex := InternalFindByKey(PCsvRow(ActiveBuffer)); // If posting an update, KeyIndex better be <0 or else equal to FRecordPos! // Otherwise, if adding, KeyIndex better be <0. if KeyIndex >= 0 then if ((State = dsInsert) and {XXX NEW}(FRecordPos < RecordCount)) or ((State = dsEdit) and (KeyIndex <> FRecordPos)) then begin raise EJvCsvKeyError.CreateResFmt(@RsEKeyNotUnique, [FTableName]); Exit; // never get here, since normally JvCsvDatabaseError raises an exception. end; end; if State = dsEdit then begin FFileDirty := True; RecPos := FRecordPos; Move(PCsvRow(ActiveBuffer)^, FData.GetRowPtr(RecPos)^, FData.GetRowAllocSize ); FData.GetRowPtr(RecPos)^.IsDirty := RowNeedsSaving; end else if State = dsInsert then begin if FInsertBlocked then begin JvCsvDatabaseError(FTableName, RsECannotInsertNewRow); Exit; end; FFileDirty := True; PInsertRec := PCsvRow( AllocRecordBuffer); Move(PCsvRow(ActiveBuffer)^, PInsertRec^, FData.GetRowAllocSize ); PInsertRec^.IsDirty := RowNeedsSaving; FData.Insert(FRecordPos, Pointer(PInsertRec)); FRecordPos := FData.IndexOf(Pointer(PInsertRec)); PInsertRec^.Bookmark.Data := FRecordPos; end else JvCsvDatabaseError(FTableName, RsECannotPost); end; function TJvCustomCsvDataSet.IsCursorOpen: Boolean; begin // "Cursor" is open if Data file is open. File is open if FDataFile's // Mode includes the FileMode in which the file was open. { Result := TFileRec(FDataFile).Mode <> 0; } Result := FCursorOpen; // bogus value: Valid field definition end; function TJvCustomCsvDataSet.GetRecordCount: Integer; begin if FData.Count > 0 then Result := FData.Count else Result := 0; end; function TJvCustomCsvDataSet.GetRecNo: Integer; {RecNo := FRecordPos+1} var BufPtr: TJvRecordBuffer; { was PChar; } begin CheckActive; // UpdateCursorPos; {FUDGE!?} { UpdateCursorPos; if (FRecordPos = -1) and (RecordCount > 0) then Result := 0 // 1 //FUDGE!? else Result := FRecordPos + 1; } if Assigned(FData) and (FData.FRecordsValid) then begin if State = dsCalcFields then BufPtr := CalcBuffer else BufPtr := ActiveBuffer; Result := (PCsvRow(BufPtr)^.Bookmark.Data); // Record number. end else begin Result := 0; end; end; procedure TJvCustomCsvDataSet.SetRecNo(Value: Integer); begin if (Value >= 0) and (Value <= FData.Count - 1) then begin FRecordPos := Value; {-1 XXXXXX } if RecordCount > 0 then Resync([]); end; end; procedure TJvCustomCsvDataSet.SetTableName(const Value: string); begin CheckInactive; // NOTE: TABLE MUST BE *CLOSED* TO CHANGE THE NAME! WE RAISE EXCEPTION HERE IF OPEN. FTableName := Value; // if (ExtractFileExt(FTableName) = '') and (FTableName <> '') then // FTableName := ChangeFileExt(FTableName,'.csv'); { update internal filename table } // FBmkFileName:= ChangeFileExt(FTableName, '.bmk' ); // bookmark file end; procedure TJvCustomCsvDataSet.SetTextBufferSize(const Value: Integer); begin if Active then raise Exception.Create('Can''t change memory properties on an active data set'); Assert(Assigned(FData)); FData.TextBufferSize := Value; end; procedure TJvCustomCsvDataSet.EmptyTable; begin // Erase Rows. while (FData.Count > 0) do FData.DeleteRow(FData.Count - 1); // Refresh controls. First; if FSavesChanges then DeleteFile(FOpenFileName); end; // InternalCompare of two records, of a specific field index. // INTERNAL USE ONLY METHOD: // Record comparison between two PCsvRows: // Returns 0 if Left=Right, 1 if Left>Right, -1 if Left 0.02 then Result := 1 else Result := 0; // For our purposes, .02 difference or less is a match. Exit; end; else Result := StrComp(PAnsiChar(StrLeft), PAnsiChar(StrRight)); end; end; // InternalCompare of multiple fields. // INTERNAL USE ONLY METHOD: // Record comparison between two PCsvRows: // Returns 0 if Left=Right, 1 if Left>Right, -1 if Left= SortColumnCount); // null check, raise exception if (not Assigned(Left)) or (not Assigned(Right)) then JvCsvDatabaseError(FTableName, RsEInternalCompare); // now check each field: for I := 0 to SortColumnCount - 1 do begin if not Assigned(SortColumns[I]) then JvCsvDatabaseError(FTableName, RsEInternalCompare); // raise exception Result := InternalFieldCompare(SortColumns[I], Left, Right); if Result <> 0 then begin if not SortAscending[I] then // inverts comparison Result when Descending! Result := -Result; // XXX REPEAT Result := InternalFieldCompare( SortColumns[I],Left,Right); Exit; // found greater or less than condition end; end; // now we have compared all fields, and if we get here, they were all // equal, and Result is already set to 0. end; procedure TJvCustomCsvDataSet.InternalQuickSort(SortList: PPointerList; L, R: Integer; SortColumns: TArrayOfPCsvColumn; ACount: Integer; SortAscending: Array of Boolean); var I, J: Integer; P, T: Pointer; begin // TODO: optimization (median of three, insertion sort when Count < 20 etc) repeat I := L; J := R; P := SortList^[(L + R) shr 1]; repeat while InternalCompare(SortColumns, ACount, SortList^[I], P, SortAscending ) < 0 do Inc(I); while InternalCompare(SortColumns, ACount, SortList^[J], P, SortAscending ) > 0 do Dec(J); if I <= J then begin T := SortList^[I]; SortList^[I] := SortList^[J]; SortList^[J] := T; Inc(I); Dec(J); end; until I > J; if L < J then InternalQuickSort(SortList, L, J, SortColumns, ACount, SortAscending); L := I; until I >= R; end; procedure TJvCustomCsvDataSet.QuickSort(AList: TList; SortColumns: TArrayOfPCsvColumn; ACount: Integer; SortAscending: Array of Boolean); begin if (AList <> nil) and (AList.Count > 1) then InternalQuickSort(AList.List, 0, AList.Count - 1, SortColumns, ACount, SortAscending); end; (* Originalversion Jvcl 336 von mir auskommentiert. Siehe Ersetzung weiter unten *) (* procedure TJvCustomCsvDataSet.Sort(const SortFields: AnsiString; Ascending: Boolean); var // Index: array of Pointer; // swap: Pointer; SortFieldNames: array of AnsiString; SortAscending: array of Boolean; SortColumns: TArrayOfPCsvColumn; SortColumnCount: Integer; // comparison, I, U, L: Integer; I: Integer; begin // Create an indexed list which can be sorted more easily than // doing an item swap: // L := FData.Count; // SetLength(Index, L); // for I := 0 to L - 1 do // begin // Index[I] := FData.Items[I]; // Initial values. // end; SetLength(SortFieldNames, FCsvColumns.Count); SetLength(SortAscending, FCsvColumns.Count); SortColumnCount := JvAnsiStrSplit(SortFields, Separator, {Chr(0)=No Quoting} AnsiChar(0), SortFieldNames, FCsvColumns.Count); SetLength(SortColumns, SortColumnCount); if (SortFields = '') or (SortColumnCount = 0) then JvCsvDatabaseError(FTableName, RsESortFailedCommaSeparated); // Now check if the fields exist, and find the pointers to the fields for I := 0 to SortColumnCount - 1 do begin SortAscending[I] := Ascending; if SortFieldNames[I] = '' then JvCsvDatabaseError(FTableName, RsESortFailedFieldNames); if SortFieldNames[I][1] = '!' then begin SortAscending[I] := not SortAscending[I]; SortFieldNames[I] := Copy(SortFieldNames[I],2,Length(SortFieldNames[I])); end; SortColumns[I] := FCsvColumns.FindByName( string(SortFieldNames[I])); if not Assigned(SortColumns[I]) then JvCsvDatabaseError(FTableName, Format(RsESortFailedInvalidFieldNameInList, [SortFieldNames[I]])); end; QuickSort(FData, SortColumns, SortColumnCount, SortAscending); FFileDirty := True; First; // reposition! end; *) {* Hier die neue Version aus Jvcl 337 Beta *************************************************************************************************************************** *} procedure TJvCustomCsvDataSet.Sort(const SortFields: string; Ascending: Boolean); var // Index: array of Pointer; // swap: Pointer; SortFieldNames: array of string; SortAscending: array of Boolean; SortColumns: TArrayOfPCsvColumn; SortColumnCount: Integer; // comparison, I, U, L: Integer; I: Integer; begin // Create an indexed list which can be sorted more easily than // doing an item swap: // L := FData.Count; // SetLength(Index, L); // for I := 0 to L - 1 do // begin // Index[I] := FData.Items[I]; // Initial values. // end; SetLength(SortFieldNames, FCsvColumns.Count); SetLength(SortAscending, FCsvColumns.Count); SortColumnCount := JvStrSplit(SortFields, Separator, {Chr(0)=No Quoting} #0, SortFieldNames, FCsvColumns.Count); SetLength(SortColumns, SortColumnCount); if (SortFields = '') or (SortColumnCount = 0) then JvCsvDatabaseError(FTableName, RsESortFailedCommaSeparated); // Now check if the fields exist, and find the pointers to the fields for I := 0 to SortColumnCount - 1 do begin SortAscending[I] := Ascending; if SortFieldNames[I] = '' then JvCsvDatabaseError(FTableName, RsESortFailedFieldNames); if SortFieldNames[I][1] = '!' then begin SortAscending[I] := not SortAscending[I]; SortFieldNames[I] := Copy(SortFieldNames[I],2,Length(SortFieldNames[I])); end; SortColumns[I] := FCsvColumns.FindByName( string(SortFieldNames[I])); if not Assigned(SortColumns[I]) then JvCsvDatabaseError(FTableName, Format(RsESortFailedInvalidFieldNameInList, [SortFieldNames[I]])); end; QuickSort(FData, SortColumns, SortColumnCount, SortAscending); FFileDirty := True; First; // reposition! end; {* ************************************************************************************************************************ *} { Support Delphi VCL TDataSetDesigner's field persistence } procedure TJvCustomCsvDataSet.DefChanged(Sender: TObject); begin FStoreDefs := True; end; { Support Delphi VCL TDataSetDesigner's field persistence } function TJvCustomCsvDataSet.FieldDefsStored: Boolean; begin Result := FStoreDefs and (FieldDefs.Count > 0); end; function TJvCustomCsvDataSet.GetCanModify: Boolean; begin Result := not FReadOnly; // You can modify if it's NOT read only. end; { CsvColumns dynamic array of pointers } procedure TJvCsvColumns.AddColumn(Item: PCsvColumn); begin Add(Pointer(Item)); end; function TJvCsvColumns.FindByName(const FieldName: string): PCsvColumn; var I: Integer; begin try for I := 0 to Count - 1 do begin Result := PCsvColumn(Get(I)); if Assigned(Result.FFieldDef) then // Case insensitive field name matching: if SameText(Result.FFieldDef.Name, FieldName) then Exit; //return that field was found! end; except // ignore exceptions end; Result := nil; end; function TJvCsvColumns.FindByFieldNo(FieldNo: Integer): PCsvColumn; var I: Integer; begin Result := nil; try for I := 0 to Count - 1 do begin Result := PCsvColumn(Get(I)); if Assigned(Result) then if Assigned(Result^.FFieldDef) then if Result^.FFieldDef.FieldNo = FieldNo then Exit; //return that field was found! end; except // ignore exceptions Result := nil; end; end; procedure TJvCsvColumns.Clear; var I: Integer; begin for I := 0 to Count - 1 do FreeMem(Items[I]); inherited Clear; end; { CsvRows: dynamic array of pointers } function TJvCsvRows.GetUserTag(Index: Integer): Integer; begin if (Index < 0) or (Index >= FUserLength) then Result := 0 else Result := FUserTag[Index]; end; procedure TJvCsvRows.SetUserTag(Index, Value: Integer); begin if (Index < 0) or (Index >= Count) then Exit; if Index >= FUserLength then begin FUserLength := Index + 1; SetLength(FUserTag, FUserLength); SetLength(FUserData, FUserLength); end; FUserTag[Index] := Value; end; function TJvCsvRows.GetUserData(Index: Integer): Pointer; begin if (Index < 0) or (Index >= FUserLength) then Result := nil else Result := FUserData[Index]; end; procedure TJvCsvRows.SetUserData(Index: Integer; Value: Pointer); begin if (Index < 0) or (Index >= Count) then Exit; if Index >= FUserLength then begin FUserLength := Index + 1; SetLength(FUserTag, FUserLength); SetLength(FUserData, FUserLength); end; FUserData[Index] := Value; end; procedure TJvCsvRows.AddRow(Item: PCsvRow); begin Add(Pointer(Item)); end; procedure TJvCsvRows.InsertRow(const Position: Integer; Item: PCsvRow); begin Insert(Position, Pointer(Item)); end; procedure TJvCsvRows.InternalInitRecord(Buffer: TJvRecordBuffer { was PChar}); var RowPtr: PCsvRow; p:TJvRecordBuffer; {was PChar;} begin RowPtr := PCsvRow(Buffer); RowPtr.Magic := JvCsvRowMagic; RowPtr.TextMaxLen := FTextBufferSize; RowPtr.WordFieldsAddr := (SizeOf(TJvCsvRow)-JvCsv_MINLINELENGTH)+ FTextBufferSize; RowPtr.AllocSize := GetRowAllocSize; RowPtr.Separator := Separator; // initialize magic in WordFields: p := Buffer; Inc(p, RowPtr.WordFieldsAddr ); PJvCsvRowWordFields(p)^.Magic2 := JvCsvRowMagic2; //DebugPJvCsvRowWordFields := PJvCsvRowWordFields(p); FREcordsValid := true; end; function TJvCsvRows.RecordSize: Word; begin Result := GetRowAllocSize; { - BookmarkSize??? } end; procedure TJvCsvRows.AddRowStr(const Item: AnsiString); // convert string->TJvCsvRow var PNewItem: PCsvRow; begin PNewItem := PCsvRow(AllocRecordBuffer); JvStringToCsvRow(Item, Separator, PNewItem, True, FEnquoteBackslash); // decode a csv line that can contain escape sequences AddRow(PNewItem); end; function TJvCsvRows.AllocRecordBuffer: TJvRecordBuffer { was PChar}; begin Assert(FTextBufferSize >= JvCsv_MINLINELENGTH); Result := AllocMem( GetRowAllocSize ); {was SizeOf(TJvCsvRow)} InternalInitRecord(Result); end; function TJvCsvRows.GetRowAllocSize: Integer; begin Assert(FTextBufferSize >= JvCsv_MINLINELENGTH); Result := (SizeOf(TJvCsvRow) - JvCsv_MINLINELENGTH) + FTextBufferSize + SizeOf(TJvCsvRowWordFIelds) + JvCsv_MaxCalcDataOffset + FMarginSize; end; function TJvCsvRows.GetRowPtr(const RowIndex: Integer): PCsvRow; begin if (RowIndex >= 0) and (RowIndex < Count) then Result := PCsvRow(Get(RowIndex)) // return pointer to a row item. else raise EJvCsvDataSetError.CreateRes(@RsECsvNoRecord); { NO Such Record } end; function TJvCsvRows.GetRowAnsiStr(const RowIndex: Integer): AnsiString; var ResultStr: AnsiString; begin JvCsvRowToAnsiString(GetRowPtr(RowIndex), ResultStr); Result := ResultStr; end; procedure TJvCsvRows.SetRowStr(const RowIndex: Integer; Value: AnsiString); begin JvStringToCsvRow(Value, Separator, GetRowPtr(RowIndex), True, FEnquoteBackslash); end; procedure TJvCsvRows.DeleteRow(const RowIndex: Integer); var P: Pointer; begin if (RowIndex >= 0) and (RowIndex < Count) then begin P := Self[RowIndex]; if P <> nil then FreeMem(P); end; Delete(RowIndex); end; procedure TJvCsvRows.SetARowItem(const RowIndex, ColumnIndex: Integer; Value: AnsiString); begin SetCsvRowItem(GetRowPtr(RowIndex), ColumnIndex, Value); end; procedure TJvCsvRows.SetDecimalSeparator(const Value: AnsiChar); begin FDecimalSeparator := Value; end; function TJvCsvRows.GetARowItem(const RowIndex, ColumnIndex: Integer): AnsiString; begin Result := GetCsvRowItem(GetRowPtr(RowIndex), ColumnIndex); end; function TJvCsvRows.GetDecimalSeparator: AnsiChar; begin Result := FDecimalSeparator; end; procedure TJvCsvRows.Clear; var I: Integer; begin for I := 0 to Count - 1 do FreeMem(Items[I]); inherited Clear; end; constructor TJvCsvRows.Create; begin FTextBufferSize := JvCsvDefaultTextBufferSize; FMarginSize := JvCsvDefaultMarginSize; { DecimalSeparator: This 'US' constant value is important for backwards compatibility. DO NOT CHANGE this default, it would break people's code. } FDecimalSeparator := USDecimalSeparator; end; { Call this one first, then AssignFromStrings on subsequent updates only.} procedure TJvCustomCsvDataSet.OpenWith(Strings: TStrings); begin Active := False; if FHasHeaderRow then FHeaderRow := AnsiString(Strings[0]); AssignFromStrings(Strings); // parse strings end; procedure TJvCustomCsvDataSet.AppendWith(Strings: TStrings); begin //Active := False; if FHasHeaderRow then begin FHeaderRow := AnsiString(Strings[0]); FPendingCsvHeaderParse := True; // NEW: Just-in-time-CSV-header-parsing. end; AssignFromStrings(Strings); // parse strings // Refresh. // DataEvent(deDataSetChange, 0); // DataEvent(deRecordChange, 0); Resync([]); // DataEvent(deUpdateState, 0); if Active then Last; end; { Additional Custom Methods - internal use } procedure TJvCustomCsvDataSet.AssignFromStrings(const Strings: TStrings); var // HeaderRowFound: Boolean; I: Integer; StartIndex, IndexCounter: Integer; begin // CheckInactive; // NO! DON'T DO THIS! // if NOT FFieldsInitialized then // InternalInitFieldDefs; // must know about field definitions first. if Strings = nil then Exit; // FData.EnquoteBackslash := FEnquoteBackslash; {stupidity solved} IndexCounter := 0; // Skip first Row: if FHasHeaderRow then StartIndex := 1 else StartIndex := 0; for I := StartIndex to Strings.Count - 1 do begin if (FSpecialDataMarker <> '') and (Pos(FSpecialDataMarker, Strings[I]) = 1) and Assigned(FOnSpecialData) then begin // XXX Deprecated feature FOnSpecialData(Self, I, AnsiString(Strings[I])); end else begin // Process the row normally: ProcessCsvDataRow( AnsiString(Strings[I]), IndexCounter); Inc(IndexCounter); end; end; if Active then First; end; procedure TJvCustomCsvDataSet.AssignToStrings(Strings: TStrings); var I: Integer; ansiLine: AnsiString; begin Strings.BeginUpdate; try // copy out the current Data set to a TStringList. Strings.Clear; { Save header row with Data rows? } if FHasHeaderRow then if ExtendedHeaderInfo then Strings.Add(CsvFieldDef) else Strings.Add(GetColumnsAsString); for I := 0 to FData.Count - 1 do begin JvCsvRowToAnsiString(FData.GetRowPtr(I), ansiLine); Strings.Add(string(ansiLine)); end; finally Strings.EndUpdate; end; end; procedure TJvCustomCsvDataSet.AppendRowString(const RowAsString: string); begin if not Active then JvCsvDatabaseError(FTableName, RsEDataSetNotOpen); ProcessCsvDataRow( AnsiString(RowAsString), FData.Count); FFileDirty := True; // added row, make sure it gets saved! Last; end; function TJvCustomCsvDataSet.GetAsString(const Row, Column: Integer): string; //virtual; var GetIndex: Integer; begin if Row < 0 then {lastrow} GetIndex := FData.Count - 1 else GetIndex := Row; { actual index specified } { return string} Result := string( GetCsvRowItem(FData.GetRowPtr(GetIndex), Column) ); end; function TJvCustomCsvDataSet.CurrentRowAsString: string; //virtual; begin Result := GetRowAsString(RecNo); end; function TJvCustomCsvDataSet.GetRowAsString(const Index: Integer): string; var GetIndex: Integer; sTemp: AnsiString; begin if Index < 0 then {lastrow} GetIndex := FData.Count - 1 else GetIndex := Index; { actual index specified } { return string } JvCsvRowToAnsiString(FData.GetRowPtr(GetIndex), sTemp); Result := string(sTemp); end; {$IFDEF COMPILER12_UP} // We have two methods in Delphi 2009 - one to get a row and cast // it up nicely to the default user string type (string), and another // lower level one to help us avoid unecessary Ansi to unicode string // conversions when copying narrow string data from one dataset to another. // If you don't care about speed, you don't need to ever call GetRowAsAnsiString. function TJvCustomCsvDataSet.GetRowAsAnsiString(const Index: Integer): AnsiString; var GetIndex: Integer; begin if Index < 0 then {lastrow} GetIndex := FData.Count - 1 else GetIndex := Index; { actual index specified } { return string } JvCsvRowToAnsiString(FData.GetRowPtr(GetIndex), Result); Result := Result; end; {$ENDIF COMPILER12_UP} // Get names of all the columns as a comma-separated string: function TJvCustomCsvDataSet.GetColumnsAsString: string; var I: Integer; begin // ColCount: if FCsvColumns.Count = 0 then begin Result := ''; Exit; end; // Build a list of column names: , ,...., Result := FieldDefs[0].Name; for I := 1 to FCsvColumns.Count - 1 do Result := Result + string(Separator) + FieldDefs[I].Name; end; { protected internal procedure - now that we have a list of fields that are supposed to exist in this dataset we have a real CSV header which we are hoping contains header information } procedure TJvCustomCsvDataSet.ProcessCsvHeaderRow; var CsvFieldRec: PCsvRow; // CSV Field record type. PtrCsvColumn: PCsvColumn; CsvFieldName: AnsiString; ColNum, I: Integer; ColonPos: Integer; begin CsvFieldRec := PCsvRow(FData.AllocRecordBuffer); try if not ValidateHeaderRow then begin for I := 0 to FCsvColumns.Count - 1 do PCsvColumn(FCsvColumns.Get(I))^.FPhysical := I; Exit; end; FAppendedFieldCount := 0; // Columns Not Yet Found: for I := 0 to FCsvColumns.Count - 1 do PCsvColumn(FCsvColumns.Get(I))^.FPhysical := -1; // Do initial parse. JvStringToCsvRow(FHeaderRow, Separator, CsvFieldRec, False, False); ColNum := 0; while (CsvRowGetColumnMarker(CsvFieldRec, ColNum) <> JvCsv_COLUMN_ENDMARKER) do begin // Get a string in the format COLUMNAME:Options CsvFieldName := JvTrimAnsiStringCrLf(StrEatWhiteSpace(GetCsvRowItem(CsvFieldRec, ColNum))); // Where did #A come from? // Mantis 3192: Remove the options from the field name or FindByName will // never find the column which will lead to a Database error being triggered ColonPos := Pos(':', string(CsvFieldName)); if (ColonPos > 0) then CsvFieldName := Copy(CsvFieldName, 1, ColonPos - 1); if CsvFieldName = '' then JvCsvDatabaseError(FTableName, RsEErrorProcessingFirstLine); PtrCsvColumn := FCsvColumns.FindByName( string(CsvFieldName)); if PtrCsvColumn = nil then begin // raise database exception: JvCsvDatabaseError(FTableName, Format(RsEFieldInFileButNotInDefinition, [CsvFieldName])); Exit; end; try PtrCsvColumn^.FPhysical := ColNum; // numbered from 0. except JvCsvDatabaseError(FTableName, Format(RsECsvFieldLocationError, [CsvFieldName])); Break; end; Inc(ColNum); end; // loop for each column in the physical file's header row. // Check that everything was found and physically given a location // in the CSV file: for I := 0 to FCsvColumns.Count - 1 do begin PtrCsvColumn := PCsvColumn(FCsvColumns[I]); if PtrCsvColumn^.FPhysical < 0 then begin if not FHasHeaderRow then begin // If there is no header row we can't cope with fields that aren't in the file // because FCsvHeader is not written into the file, so we can't just go expanding // what goes into that file. JvCsvDatabaseError(FTableName, Format(RsEFieldNotFound, [PtrCsvColumn^.FFieldDef.Name])); Exit; // Now go fix the CSV file by hand until it matches your new CSVFieldDef. // Sounds like not much fun, eh? end else begin //------------------------------------------------------- // New HANDY DANDY Instant Import Feature // APPEND-NEW-FIELDS-to-Existing-CSV file BEHAVIOUR. // When Triggered, the end user can tell because we have a // new property AppendedFieldCount which will be nonzero. // If we continue, we can use this opportunity to // import an existing CSV file that can now 'upgraded' // in memory (to contain new fields we just added to our // field definitions). //------------------------------------------------------- PtrCsvColumn^.FPhysical := ColNum; Inc(ColNum); CsvFieldName := AnsiString(PtrCsvColumn^.FFieldDef.Name); FHeaderRow := FHeaderRow + Separator + CsvFieldName; Inc(FAppendedFieldCount); end; end; end; finally FreeMem(CsvFieldRec); end; end; procedure TJvCustomCsvDataSet.ProcessCsvDataRow(const DataRow: AnsiString; Index: Integer); var PNewRow: PCsvRow; begin if DataRow = '' then Exit; if Length(DataRow) >= JvCsv_MAXLINELENGTH - 1 then raise EJvCsvDataSetError.CreateResFmt(@RsECsvStringTooLong, [Copy(DataRow, 1, 40)]); PNewRow := PCsvRow(AllocRecordBuffer); JvStringToCsvRow(DataRow, Separator, PNewRow, True, EnquoteBackslash); PNewRow^.Index := Index; FData.AddRow(PNewRow); end; procedure TJvCustomCsvDataSet.AutoCreateDir(const FileName: string); var Path: string; begin if CreatePaths then begin Path := ExtractFilePath(FileName); if Path <> '' then if not DirectoryExists(Path) then ForceDirectories(Path); end; end; { This function is handy to save a portion of a csv table that has grown too large into a file, and then DeleteRows can be called to remove that section of the file. } procedure TJvCustomCsvDataSet.ExportRows(const FileName: string; FromRow, ToRow: Integer); var I: Integer; StrList: TStringList; begin StrList := TStringList.Create; StrList.Add( string(FHeaderRow)); try for I := FromRow to ToRow do StrList.Add( string(FData.GetRowAnsiStr(I))); AutoCreateDir(FileName); StrList.SaveToFile(FileName); finally StrList.Free; end; end; procedure TJvCustomCsvDataSet.DeleteRows(FromRow, ToRow: Integer); var Count: Integer; begin Count := (ToRow - FromRow) + 1; while Count > 0 do begin if FromRow < FData.Count then FData.DeleteRow(FromRow) // Everything moves down one every time we do this. else Break; Dec(Count); end; // Force Redraw of Data Controls: if FRecordPos >= FData.Count then begin FRecordPos := FData.Count - 1; Last; end else First; FFileDirty := True; end; procedure TJvCustomCsvDataSet.ExportCsvFile(const FileName: string); // save out to a file. var Strings: TStringList; begin Strings := TStringList.Create; try AssignToStrings(Strings); AutoCreateDir(FileName); Strings.SaveToFile(FileName); finally Strings.Free; end; end; { GetCsvHeader: XXX Normally you don't need to call this function, if you have already opened the file, then use the HeaderRow property instead! This routine loads just the first line of a CSV file from the disk. This way you can peek at a CSV file, get the first line, parse it or do something else with it, before you decide if you want this component to open the rest of the file. } function TJvCustomCsvDataSet.GetCsvHeader: string; var F: Text; FirstLine: AnsiString; begin if (not FLoadsFromFile) or (not FHasHeaderRow) or (not FileExists(FTableName)) then begin Result := ''; Exit; end; { XXX THIS Set of code sometimes FAILS randomly on Delphi 2007 when applications are running on Vista. TODO: REWRITE using streams, get rid of all AssignFile/Reset/ReadLn(file) code! } { How's this for an ancient Pascal code sequence, AssignFile+Reset is approximately equal to a C fopen() call } AssignFile(F, FTableName); Reset(F); { ReadLn is approximately a gets() call } ReadLn(F, FirstLine); { And finally, the pascal file close procedure } CloseFile(F); // return the first line of the file, without the junk Result := string(JvAnsiStrStrip(FirstLine)); // in JvCsvParse.pas end; function TJvCustomCsvDataSet.GetDecimalSeparator: AnsiChar; begin Result := FData.DecimalSeparator; end; { PROCEDURES: } // convert CSV Row buffer to a single-byte AnsiString procedure JvCsvRowToAnsiString(RowItem: PCsvRow; var RowString: AnsiString); var P: PAnsiChar; begin p := @RowItem^._Text[0]; RowString := AnsiString(P); end; //JvCsvRowDeleteColumn: NEW 2007 // used by TJvCustomCsvDataSet.DeleteCsvColumn... // delete a column from a PCsvRow object: function JvCsvRowDeleteColumn(RowItem: PCsvRow; Column, Count:Integer): AnsiString; var From1, From2: Integer; To1, To2: Integer; RowItemText: PAnsiChar; begin Assert(Column >= 0); RowItemText := @RowItem^._Text[0]; if (Column > 0) and (Column < Count - 1) then begin { del middle Column} From1 := 0; To1 := CsvRowGetColumnMarker(RowItem, Column) - 1; //RowItem^.WordField[Column]; From2 := CsvRowGetColumnMarker(RowItem, Column + 1); //RowItem^.WordField[Column]; To2 := CsvRowGetColumnMarker(RowItem, Count); Result := Copy(RowItemText, From1, To1) + Copy(RowItemText, From2, To2); end else if Column= Count - 1 then begin {del last Column} From1 := 0; To1 := CsvRowGetColumnMarker(RowItem, Column)-1; Result := Copy(RowItemText,From1,To1); end else begin {del first Column } From1 := CsvRowGetColumnMarker(RowItem, Column + 1) + 1; //RowItem^.WordField[Column]; To1 := CsvRowGetColumnMarker(RowItem, Count); Result := Copy(RowItemText, From1, To1); end; end; // convert string into a CSV Row buffer procedure JvStringToCsvRow(const RowString: AnsiString; Separator: AnsiChar; RowItem: PCsvRow; PermitEscapeSequences, EnquoteBackslash: Boolean); var I, L, Col: Integer; QuoteFlag: Boolean; SkipFlag: Boolean; // CharsInColumn: Integer; { was part of validating that row did not exceed limits} WordFields:PJvCsvRowWordFields; RowItemText:PAnsiChar; begin Assert(Assigned(RowItem)); Assert(RowItem^.Magic = JvCsvRowMagic, 'Internal data corruption in JvCsvRow data storage area' ); Col := 0; WordFields := GetWordFields(RowItem); WordFields.WordField[0] := 0; // zero out column marker and dirty bit! // CharsInColumn := 0; QuoteFlag := False; SkipFlag := False; L := Length(RowString); for I := 1 to L do begin //Inc(CharsInColumn); if QuoteFlag then begin // backslash permitted only if specifically enabled by FEnquoteBackslash: if PermitEscapeSequences and (not SkipFlag) and (EnquoteBackslash) and (RowString[I] = '\') then begin SkipFlag := True; Continue; end; // doubled quotes handling: if PermitEscapeSequences and (not SkipFlag) and (RowString[I] = '"') and (I < L) and (RowString[I + 1] = '"') then begin SkipFlag := True; Continue; end; // now if either of the above set the SkipFlag True previously, we ALWAYS skip the next character here // and turn SkipFlag back off if PermitEscapeSequences and SkipFlag then begin // skip next character, regardless. SkipFlag := False; Continue; // by skipping escaped quotes, we don't turn off QuoteFlag in the middle of a string! end; end; // Now we know if we get this far, we are NOT dealing with any escaped characters // Any quotes we see here will turn on/off quote mode directly! if RowString[I] = '"' then begin if PermitEscapeSequences then begin QuoteFlag := not QuoteFlag; end; end; if (RowString[I] = Separator) and not QuoteFlag then begin Inc(Col); // implicitly set Length (low 15 bits) and clear dirty bit (high bit): WordFields.WordField[Col] := (Word(I) and $7FFF); {note that we're going from 1..length } //CharsInColumn := 0; end; if (Col >= JvCsv_MAXCOLUMNS) or (I >= JvCsv_MAXLINELENGTH) then begin raise ERangeError.CreateResFmt(@RsEInternalLimit, [JvCsv_MAXCOLUMNS]); Exit; end; end; // end of string, new flag: Inc(Col); { if we were tracking it, we could check CharsInColumn not too large, here? } WordFields.WordField[Col] := JvCsv_COLUMN_ENDMARKER; // last one has no end marker RowItemText := @RowItem._Text[0]; StrLCopy(RowItemText, PAnsiChar(RowString), RowItem.TextMaxLen ); RowItem.Columns := Col; // Check this later! end; // Copy a single column from one row buffer to another row buffer: function CsvRowItemCopy(Source, Dest: PCsvRow; FieldIndex, FieldSize: Integer): Boolean; var TempStr: AnsiString; begin TempStr := GetCsvRowItem(Source, FieldIndex); // length limiting feature: if FieldSize > 0 then if Length(TempStr) > FieldSize then TempStr := Copy(TempStr, 1, FieldSize); SetCsvRowItem(Dest, FieldIndex, TempStr); Result := True; end; // Copy an item into a csv row buffer: procedure SetCsvRowItem(PItem: PCsvRow; ColumnIndex: Integer; const NewValue: AnsiString); var TempBuf,RowItemText: PAnsiChar; Copy1, Copy2: Integer; Dif, I, Old: Integer; begin Assert(Assigned(PItem)); Assert(PItem^.Magic = JvCsvRowMagic); Assert(PItem^.TextMaxLen>0); Assert(PItem^.Separator<>Chr(0)); Dif := 0; if (ColumnIndex < 0) or (ColumnIndex > JvCsv_MAXCOLUMNS) then Exit; RowItemText := @PItem^._Text[0]; Copy1 := CsvRowGetColumnMarker(PItem, ColumnIndex); if Copy1 = JvCsv_COLUMN_ENDMARKER then begin // Fix CSV damage: StrLCat(RowItemText,@(PItem^.Separator),Length(RowItemText)+1); // XXX todo later: Make sure we add however many commas or whatever are needed! Copy1 := Length(RowItemText); CsvRowSetColumnMarker(PItem,ColumnIndex,Copy1); end; // Update new rows: FIX previous fix! if (ColumnIndex >= PItem^.Columns) then PItem^.Columns := ColumnIndex+1; if Copy1 > JvCsv_MAXLINELENGTH then Exit; // copy initial part of the csv row: TempBuf := AllocMem( PItem^.TextMaxLen +1); try if Copy1 > 0 then begin StrLCopy(TempBuf, RowItemText, Copy1); StrLCat(TempBuf, PAnsiChar(NewValue), PItem^.TextMaxLen); end else StrLCopy(TempBuf, PAnsiChar(NewValue), PItem^.TextMaxLen); Copy2 := CsvRowGetColumnMarker(PItem, ColumnIndex + 1); if Copy2 <> JvCsv_COLUMN_ENDMARKER then begin // difference in length: Dec(Copy2); // subtract one. if Copy2 < 0 then Exit; if Length(NewValue) = Copy2 - Copy1 then Dif := 0 else Dif := Length(NewValue) - (Copy2 - Copy1); StrLCat(TempBuf, RowItemText + Copy2, PItem^.TextMaxLen); end; // Copy over the old memory buffer: StrLCopy(RowItemText, TempBuf, PItem^.TextMaxLen); // Now that we've copied a new item of a different length into the place of the old one // we have to update the positions of the columns after ColumnIndex: if Dif <> 0 then for I := ColumnIndex + 1 to JvCsv_MAXCOLUMNS do begin Old := CsvRowGetColumnMarker(PItem, I); if Old = JvCsv_COLUMN_ENDMARKER then Exit; CsvRowSetColumnMarker(PItem, I, Old + Dif); end; finally FreeMem(TempBuf); end; end; // Copy an item out of a csv row buffer: function GetCsvRowItem(PItem: PCsvRow; ColumnIndex: Integer): AnsiString; var TempBuf: PAnsiChar; Copy1, Copy2: Integer; outText:PAnsiChar; begin Result := ''; if (ColumnIndex < 0) or (ColumnIndex > JvCsv_MAXCOLUMNS) then Result := AnsiString(RsErrorRowItem) else if ColumnIndex < PItem^.Columns then begin Copy1 := CsvRowGetColumnMarker(PItem, ColumnIndex); Copy2 := CsvRowGetColumnMarker(PItem, ColumnIndex + 1); if (Copy1 <> JvCsv_COLUMN_ENDMARKER) and (Copy1>Copy2) then begin raise Exception.Create('GetCsvRowItem:Column index values are corrupt.'); end; if Copy1 <> JvCsv_COLUMN_ENDMARKER then begin if Copy2 = JvCsv_COLUMN_ENDMARKER then // copy the rest of the line Copy2 := JvCsv_MAXLINELENGTH - Copy1 // All the characters left in the buffer else Dec(Copy2); if (Copy1 <= JvCsv_MAXLINELENGTH) and (Copy2 <= JvCsv_MAXLINELENGTH) then begin // Copy out just one column from the string: TempBuf := AllocMem( PItem^.TextMaxLen ); try outText := (@PItem^._Text[0]); Inc(outText, Copy1); StrLCopy(TempBuf, outText, Copy2 - Copy1); JvEatWhitespaceChars(@TempBuf[0]); Result := AnsiString(TempBuf); finally FreeMem(TempBuf); end; end; end; end; end; {new} procedure CsvRowSetDirtyBit(Row: PCsvRow; ColumnIndex: Integer); var WordFields:PJvCsvRowWordFields; begin if Row = nil then Exit; if (ColumnIndex < 0) or (ColumnIndex >= JvCsv_MAXCOLUMNS) then Exit; WordFields := GetWordFields(Row); Row^.IsDirty := RowNeedsSaving; // triggers search for 'dirty bit' in columns WordFields.WordField[ColumnIndex] := (WordFields.WordField[ColumnIndex] or $8000); end; procedure CsvRowClearDirtyBit(Row: PCsvRow; ColumnIndex: Integer); var WordFields:PJvCsvRowWordFields; begin if Row = nil then Exit; if (ColumnIndex < 0) or (ColumnIndex >= JvCsv_MAXCOLUMNS) then Exit; WordFields := GetWordFields(Row); WordFields.WordField[ColumnIndex] := (WordFields.WordField[ColumnIndex] and $7FFF); end; function CsvRowGetDirtyBit(Row: PCsvRow; ColumnIndex: Integer): Boolean; var WordFields:PJvCsvRowWordFields; begin Result := False; if Row = nil then Exit; if (ColumnIndex < 0) or (ColumnIndex >= JvCsv_MAXCOLUMNS) then Exit; WordFields := GetWordFields(Row); if WordFields.WordField[ColumnIndex] = JvCsv_COLUMN_ENDMARKER then Exit; Result := (WordFields.WordField[ColumnIndex] and $8000) <> 0; end; procedure CsvRowSetColumnMarker(Row: PCsvRow; ColumnIndex: Integer; ColumnMarker: Integer); var Old: Word; WordFields:PJvCsvRowWordFields; begin if Row = nil then Exit; if (ColumnIndex < 0) or (ColumnIndex >= JvCsv_MAXCOLUMNS) then Exit; if ColumnMarker < 0 then Exit; WordFields := GetWordFields(Row); if ColumnMarker = JvCsv_COLUMN_ENDMARKER then WordFields.WordField[ColumnIndex] := JvCsv_COLUMN_ENDMARKER else begin Old := WordFields.WordField[ColumnIndex]; if Old = JvCsv_COLUMN_ENDMARKER then WordFields.WordField[ColumnIndex] := ColumnMarker and $7FFF // auto-clear Dirty bit else WordFields.WordField[ColumnIndex] := (Old and $8000) or // Keep Old Dirty Bit (Word(ColumnMarker) and $7FFF); // new value. end; //DebugPJvCsvRowWordFields := WordFields; end; function CsvRowGetColumnMarker(Row: PCsvRow; ColumnIndex: Integer): Integer; var W: Word; WordFields:PJvCsvRowWordFields; begin Result := -1; if Row = nil then Exit; if (ColumnIndex < 0) or (ColumnIndex >= JvCsv_MAXCOLUMNS) then Exit; WordFields := GetWordFields(Row); W := WordFields^.WordField[ColumnIndex]; if W = JvCsv_COLUMN_ENDMARKER then Result := JvCsv_COLUMN_ENDMARKER else Result := Integer(W and $7FFF); end; {endnew} //------------------------------------------------------------------------------ // TimeTHexToDateTime // // The Delphi TDateTime format is a whole number representing days since Dec 30, 1899. // Whereas the TIME_T type is a standard C library time representing seconds since // 12:00 UTC on Jan 1 1970. // // We accept the hex encoded TIME_T and convert it to a TDateTime by getting // the base date (Jan 1, 1970) and adding 1 for every day since then, and // a fractional part representing the seconds. By dividing the seconds // by the number of seconds in a day (24*24*60=86400) we obtain this Result. // // The incoming value in hex will roll over in mid-Janary 2038, and // hopefully by then this code won't be in use any more! :-) // // Note: TDateTime is really a Double floating-point and zero is considered // an invalidate date indicator. (on screen this appears as 1899/nn/nn //------------------------------------------------------------------------------ function JvTimeTHexToDateTime(const HexStr: AnsiString; TimeZoneCorrection: Integer): TDateTime; var SecondsSince1970: Double; Base: TDateTime; { DateTimeAsStr: string; //debug Code.} begin Result := 0.0; SecondsSince1970 := StrToIntDef('$' + string(HexStr), 0) + TimeZoneCorrection; if SecondsSince1970 <= 0.0 then Exit; Base := EncodeDate(1970, 1, 1); Base := Base + (SecondsSince1970 / 86400.0); { DateTimeAsStr := FormatDateTime('yyyy/mm/dd hh:nn:ss',Base);} // Inc(CallCount); Result := Base; end; // JvIsoDateTimeStrToDateTime [formerly TimeTAsciiToDateTime] function JvIsoDateTimeStrToDateTime(const AsciiDateTimeStr: AnsiString): TDateTime; const Separators = '// ::'; // separators in yyyy/mm/dd hh:mm:ss Separators2 = '-- --'; // separators in yyyy/mm/dd hh:mm:ss var Values: array [1..6] of Integer; //year,month,day,hour,minute,second in that order. Ch: AnsiChar; I, U, Len, Index: Integer; begin Result := 0.0; // default Result. Len := Length(AsciiDateTimeStr); // validate ranges: for I := 1 to 6 do Values[I] := 0; // T loops through each value we are looking for (1..6): Index := 1; // what character in AsciiDateTimeStr are we looking at? for I := 1 to 6 do begin if (I >= 3) and (Index >= Len) then Break; // as long as we at least got the date, we can continue. for U := 1 to AsciiTime_ExpectLengths[I] do begin if Index > Len then Break; Ch := AsciiDateTimeStr[Index]; if not (Ch in DigitSymbols) then begin //could raise exception here: //illegal character in datetime string Exit; // failed: invalid character. end; Values[I] := (Values[I] * 10) + (Ord(Ch) - Ord('0')); Inc(Index); if Index > Len then Break; end; // if we haven't reached the end of the string, then // check for a valid separator character: if Index < Len then if (AsciiDateTimeStr[Index] <> AnsiChar(Separators[I])) and (AsciiDateTimeStr[Index] <> AnsiChar(Separators2[I])) then begin Exit; end; // validate ranges: if (Values[I] < AsciiTime_MinValue[I]) or (Values[I] > AsciiTime_MaxValue[I]) then Exit; // a value is out of range. Inc(Index); end; // Now that we probably have a valid value we will try to encode it. // EncodeData will catch any invalid date values we have let slip through // such as trying to encode February 29 on a non-leap year, or the 31st // day of a month with only 30 days, etc. try Result := EncodeDate({year}Values[1], {month} Values[2], {day} Values[3]) + EncodeTime({hour}Values[4], {minute} Values[5], {second} Values[6], {msec} 0); except on E: EConvertError do Result := 0.0; // catch any other conversion errors and just return 0. end; end; function JvIsoDateStrToDate(const AsciiDateStr: AnsiString): TDateTime; // new. const Separators = '//'; // separators in yyyy/mm/dd [a custom nearly-ISO-compliant format] Separators2 = '--'; // separators in yyyy-mm-dd [the real ISO date format uses dashes as separators] var Values: array [1..3] of Integer; //year,month,day Ch: AnsiChar; I, U, Len, Index: Integer; begin Result := 0.0; // default Result. Len := Length(AsciiDateStr); // validate ranges: for I := 1 to 3 do Values[I] := 0; // T loops through each value we are looking for (1..6): Index := 1; // what character in AsciiDateStr are we looking at? for I := 1 to 3 do begin //if (I >= 3) and (Index >= Len) then // Break; // as long as we at least got the date, we can continue. for U := 1 to AsciiTime_ExpectLengths[I] do begin if Index > Len then Break; Ch := AsciiDateStr[Index]; if not (Ch in DigitSymbols) then Exit; // failed: invalid character. Values[I] := (Values[I] * 10) + (Ord(Ch) - Ord('0')); Inc(Index); if Index > Len then Break; end; // if we haven't reached the end of the string, then // check for a valid separator character: if Index < Len then if (AsciiDateStr[Index] <> AnsiChar( Separators[I]) ) and (AsciiDateStr[Index] <> AnsiChar( Separators2[I]) ) then begin Exit; // illegal separator character end; // validate ranges: if (Values[I] < AsciiTime_MinValue[I]) or (Values[I] > AsciiTime_MaxValue[I]) then begin Exit; // a value is out of range. end; Inc(Index); end; // Now that we probably have a valid value we will try to encode it. // EncodeData will catch any invalid date values we have let slip through // such as trying to encode February 29 on a non-leap year, or the 31st // day of a month with only 30 days, etc. try Result := EncodeDate({year}Values[1], {month} Values[2], {day} Values[3]); except on E: EConvertError do Result := 0.0; // catch any other conversion errors and just return 0. end; end; function JvIsoTimeStrToTime(const AsciiTimeStr: AnsiString): TDateTime; // new. const Separators = '::'; // separators hh:mm:ss Separators2 = '--'; // separators hh-mm-ss var Values: array [1..3] of Integer; //year,month,day,hour,minute,second in that order. Ch: AnsiChar; I, U, Len, Index: Integer; begin Result := -1.0; // default Result. (flag for invalid time. 0.0 is a VALID time = midnight!) Len := Length(AsciiTimeStr); // validate ranges: for I := 1 to 3 do Values[I] := 0; // T loops through each value we are looking for (1..6): Index := 1; // what character in AsciiTimeStr are we looking at? for I := 1 to 6 do begin if (I >= 3) and (Index >= Len) then Break; // as long as we at least got the date, we can continue. {Note: AsciiTime_ExpectLengths[ 3+I]:skip to the ISO time fields widths!} for U := 1 to AsciiTime_ExpectLengths[3+I] do begin if Index > Len then Break; Ch := AsciiTimeStr[Index]; if not (Ch in DigitSymbols) then begin Exit; // failed: invalid character. end; Values[I] := (Values[I] * 10) + (Ord(Ch) - Ord('0')); Inc(Index); if Index > Len then Break; end; // if we haven't reached the end of the string, then // check for a valid separator character: if Index < Len then if (AsciiTimeStr[Index] <> AnsiChar(Separators[I])) and (AsciiTimeStr[Index] <> AnsiChar(Separators2[I])) then Exit; // validate ranges: if (Values[I] < AsciiTime_MinValue[3+I]) or (Values[I] > AsciiTime_MaxValue[3+I]) then Exit; // a value is out of range. Inc(Index); end; // Now that we probably have a valid value we will try to encode it. // EncodeData will catch any invalid date values we have let slip through // such as trying to encode February 29 on a non-leap year, or the 31st // day of a month with only 30 days, etc. try Result := EncodeTime({hour}Values[1], {minute} Values[2], {second} Values[3], {msec} 0); except on E: EConvertError do Result := -1.0; // catch any other conversion errors and just return 0. //ahuser: ??? -1.0 is not 0.0 end; end; function JvDateTimeToTimeTHex(ADateTime: TDateTime; TimeZoneCorrection: Integer): AnsiString; var Base: TDateTime; { DateTimeAsStr: string; //debug Code. } SecondsSince1970: Integer; begin try Base := EncodeDate(1970, 1, 1); SecondsSince1970 := Trunc((ADateTime - Base) * 86400.0); Result := AnsiString(IntToHex(SecondsSince1970 - TimeZoneCorrection, 8)); except // Catch Failures! Result := ''; end; end; // JvDateTimeIsoStr [formerly called DateTimeToTimeToIsoAscii] // [support function for DateTime ASCII CSV column type] // Name changed by Warren. Only used internally here. The name was misleading, // complex, and bizarre. It had to change. Curse me or Thank me as you like. :-) function JvDateTimeIsoStr(ADateTime: TDateTime): AnsiString; begin // ISO DATETIME FORMAT: Result := AnsiString(FormatDateTime('yyyy-mm-dd hh:nn:ss', ADateTime)); end; // new: JvDateIsoStr - support function for ASCII DATE csv column type function JvDateIsoStr(ADateTime: TDateTime): AnsiString; begin // ISO DATE FORMAT: Result := AnsiString(FormatDateTime('yyyy-mm-dd', ADateTime)); end; // new: JvTimeIsoStr - support function for ASCII TIME csv column type function JvTimeIsoStr(ADateTime: TDateTime): AnsiString; begin // ISO DATE FORMAT: Result := AnsiString(FormatDateTime('hh:nn:ss', ADateTime)); end; function JvFilePathSplit(FileName: string; var Path, FilenameOnly: string): Boolean; var Len, I: Integer; begin Len := Length(FileName); Result := False; Path := ''; FilenameOnly := ''; for I := Len downto 1 do if FileName[I] = PathDelim then begin Path := Copy(FileName, 1, I); FilenameOnly := Copy(FileName, I + 1, Len); if (Length(FilenameOnly) > 0) and (Length(Path) > 0) and DirectoryExists(Path) then Result := True; Exit; end; end; { Routine to keep backup copies of old Data files around } function JvCsvBackupPreviousFiles(const FileName: string; MaxFiles: Integer): Boolean; var BackupFolder, FilenameOnly, BackupFilename, RemoveFile: string; I: Integer; Found: Boolean; function MakeFilename(Index: Integer): string; begin Result := BackupFolder + FilenameOnly + '.' + IntToStr(Index) + '.bak'; end; begin Result := False; if not FileExists(FileName) then Exit; // failed. if not JvFilePathSplit(FileName, BackupFolder, FilenameOnly) then begin FilenameOnly := FileName; GetDir(0, BackupFolder); BackupFolder := BackupFolder + PathDelim; end; BackupFolder := BackupFolder + 'Backup'+ PathDelim; if not DirectoryExists(BackupFolder) then ForceDirectories(BackupFolder); Found := False; for I := 0 to MaxFiles - 1 do begin BackupFilename := MakeFilename(I); if not FileExists(BackupFilename) then begin RemoveFile := MakeFilename((I + 1) mod MaxFiles); Found := True; Break; end; end; if not Found then begin I := 1; BackupFilename := MakeFilename(I); RemoveFile := MakeFilename((I + 1) mod MaxFiles); end; // We remove an old backup if necessary so that the next time we run // we will find the gap and know where to write the next numbered // backup. That means that anywhere from zero to 998 backups could exist // in a circular fashion. Without this logic, we wouldn't know the next // extension number to use. if FileExists(RemoveFile) then DeleteFile(RemoveFile); Windows.CopyFile(PChar(FileName), PChar(BackupFilename), False); Result := True; end; procedure TJvCustomCsvDataSet.SetSeparator(const Value: AnsiChar); var S: string; begin if Separator <> Value then begin if Value in cInvalidSeparators then begin if Value in [#32..#255] then S := string(Value) else S := Format('#%.2d',[Ord(Value)]); raise EJvCsvDataSetError.CreateResFmt(@RsECsvInvalidSeparatorFmt,[S]); end; FData.Separator := Value; end; end; procedure TJvCustomCsvDataSet.LoadFromFile(const FileName: string); var Tmp: Boolean; begin Close; Tmp := LoadsFromFile; try LoadsFromFile := True; Self.FileName := FileName; Open; finally LoadsFromFile := Tmp; end; end; procedure TJvCustomCsvDataSet.SaveToFile(const FileName: string); begin ExportCsvFile(FileName); end; { Extremely ugly hack to copy a JvCsvRow binary record from one dataset to another } procedure TJvCustomCsvDataSet.CloneRow(DataSet: TJvCustomCsvDataSet); begin if not FCursorOpen then Exit; {basic sanity checks} { make sure the range is valid and that the csv schema is the same } if (RecNo < 0) or (RecNo >= FData.Count) then raise EJvCsvDataSetError.CreateResFmt(@RsEProblemReadingRow, [RecNo]); if FCsvFieldDef <> DataSet.FCsvFieldDef then raise EJvCsvDataSetError.CreateResFmt(@RsEProblemReadingRow, [RecNo]); if (DataSet.FData.GetRowAllocSize <> FData.GetRowAllocSize) then raise EJvCsvDataSetError.Create('TJvCustomCsvDataSet Internal Error. GetRowAllocSize mismatch.'); // TODO Add to resources! {copy the memory record } CopyMemory(FData[RecNo], DataSet.FData[DataSet.RecNo], FData.GetRowAllocSize); PCsvRow(FData[RecNo])^.IsDirty := RowNeedsSaving; FFileDirty := True; //DataSet.Last; // Force update of screen. Resync([]); // Update Data aware controls. end; // get contents of one dataset into this dataset. copies only fields that // match. Raises an exception if an error occurs. returns # of rows copied. function TJvCustomCsvDataSet.CopyFromDataset(DataSet: TDataSet): Integer; var I, MatchFieldCount: Integer; StrValue, FieldName: string; MatchSourceField: array of TField; MatchDestField: array of TField; begin // Result := -1; SetLength(MatchSourceField, FieldCount); SetLength(MatchDestField, FieldCount); MatchFieldCount := 0; for I := 0 to DataSet.FieldCount-1 do begin MatchSourceField[MatchFieldCount] := DataSet.Fields[I]; Assert(Assigned(MatchSourceField[MatchFieldCount])); FieldName := MatchSourceField[MatchFieldCount].FieldName; try MatchDestField[MatchFieldCount] := FieldByName(FieldName); Assert(Assigned(MatchDestField[MatchFieldCount])); Inc(MatchFieldCount); except on E: EDatabaseError do begin // ignore it. end; end; end; if MatchFieldCount = 0 then JvCsvDatabaseError(DataSet.Name, RsENoFieldNamesMatch); Result := 0; DataSet.First; if not Active and not LoadsFromFile then Active := True; while not DataSet.Eof do begin Append; for I := 0 to MatchFieldCount-1 do if MatchSourceField[I].DataType=ftString then begin if MatchSourceField[I].IsNull then StrValue := '' else StrValue := MatchSourceField[I].Value; MatchDestField[I].Value := StrValue; end else MatchDestField[I].Value := MatchSourceField[I].Value; Post; DataSet.Next; Inc(Result); end; end; //------------------------------------------------------------------------- //DeleteCsvColumn // // When JvCsvDataSet can't open a file, because it contains a // column in the file that is not defined in our CsvFieldDef, this can // create a difficult-to-solve problem. If we drop an obsolete or pointless // CSV field from our CsvFieldDef, and we have stuff out there in the // field that contains that data, new versions of our program won't read // the files anymore. // // CSV file editing is not for the faint of heart, and so this method // is considered less destructive than requiring users to repair // their files manually. // // To use this method: // Create a CsvDataSet object with a CsvFieldDef='' (empty) // // Set the Filename property to a fully qualified filename, that // must exist, set Active to true, then to False, so we've read // the column definitions! // // Call this method, specify a column name that must be removed. // The saved file won't contain the column you've removed. // // Of course, this method is inherently destructive of of your data. // Be careful. Make your own backup before you use this method. //------------------------------------------------------------------------- procedure TJvCustomCsvDataSet.DeleteCsvColumn(const AFieldName: string); var CsvCol: PCsvColumn; ColNum: Integer; I: Integer; PTempRow: PCsvRow; DataRow: AnsiString; NewDataRow: AnsiString; begin // filename must be set for this method to work Assert(Length(FileName) > 0); Assert(FileExists(Filename)); // ahuser: Wouldn't it be better to use a normal exception for this? // you should set the filename, but not the CsvFieldDef in this case, // because in this mode, the CsvDataSet is supposed to be able to open // ANY csv file. This is the idea. Open the file, browse it, close it, // do some modifications like adding or removing columns, then save those // changes, then re-open the csv file to view the change. if (Length(FCsvFieldDef) > 0) or Active then raise Exception.Create('This special method DeleteCsvColumn cannot be called except when CsvFieldDef is not set, and no table is currently open!'); PTempRow := PCsvRow(AllocRecordBuffer); try // begin an internal load: FOpenFileName := GetFileName; // Always use the same file name to save as you did to load!!! MARCH 2004.WP InternalInitFieldDefs; // also loads entire file! InternalOpen; Assert(FCsvColumns.Count > 1); // why delete last column in an empty file? besides, it would die later on anyways, opening the empty file. CsvCol := FCsvColumns.FindByName(AFieldName); if not Assigned(CsvCol) then JvCsvDatabaseError(FTableName, Format(RsEFieldNotFound, [AFieldName])); ColNum := CsvCol.FPhysical; if not WriteCsvFileStream then raise Exception.Create('Unable to write to CSV file.'); Assert(Assigned(FCsvStream)); {Write header row minus column} if FHasHeaderRow then begin JvStringToCsvRow(DataRow, Separator, PTempRow, True, EnquoteBackslash); NewDataRow := JvCsvRowDeleteColumn(PTempRow, ColNum, FCsvColumns.Count); FCsvStream.WriteLine(NewDataRow); end; {Write data rows minus column} for I := 0 to RecordCount - 1 do begin {$IFDEF COMPILER12_UP} DataRow := Self.GetRowAsAnsiString(I); {$ELSE} DataRow := Self.GetRowAsString(I); {$ENDIF COMPILER12_UP} if Length(DataRow) >= JvCsv_MAXLINELENGTH - 1 then raise EJvCsvDataSetError.CreateResFmt(@RsECsvStringTooLong, [Copy(DataRow, 1, 40)]); JvStringToCsvRow(DataRow, Separator, PTempRow, True, EnquoteBackslash); // delete column: NewDataRow := JvCsvRowDeleteColumn(PTempRow, ColNum, FCsvColumns.Count); FCsvStream.WriteLine(NewDataRow); end; FreeAndNil(FCsvStream); // close and finalize stream. //InternalClearFileStrings; Self.FieldDefs.Clear; Assert(FieldDefs.Count = 0); Self.Fields.Clear; Assert(Fields.Count = 0); FHeaderRow := ''; // clear header row FData.Clear; finally FreeMem(PTempRow); end; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.