kbmmemcsvstreamformat.pas

内存表控件 kbmMemTable

unit kbmMemCSVStreamFormat;

interface

{$include kbmMemTable.inc}

// =========================================================================
// CSV stream format for kbmMemTable v. 3.xx+
//
// Copyright 1999-2002 Kim Bo Madsen/Optical Services - Scandinavia
// All rights reserved.
//
// LICENSE AGREEMENT
// PLEASE NOTE THAT THE LICENSE AGREEMENT HAS CHANGED!!! 16. Feb. 2000
//
// You are allowed to use this component in any project for free.
// You are NOT allowed to claim that you have created this component or to
// copy its code into your own component and claim that it was your idea.
//
// -----------------------------------------------------------------------------------
// IM OFFERING THIS FOR FREE FOR YOUR CONVINIENCE, BUT
// YOU ARE REQUIRED TO SEND AN E-MAIL ABOUT WHAT PROJECT THIS COMPONENT (OR DERIVED VERSIONS)
// IS USED FOR !
// -----------------------------------------------------------------------------------
//
// -----------------------------------------------------------------------------------
// PLEASE NOTE THE FOLLOWING ADDITION TO THE LICENSE AGREEMENT:
// If you choose to use this component for generating middleware libraries (with similar
// functionality as dbOvernet, Midas, Asta etc.), those libraries MUST be released as
// Open Source and Freeware!
// -----------------------------------------------------------------------------------
//
// You dont need to state my name in your software, although it would be
// appreciated if you do.
//
// If you find bugs or alter the component (f.ex. see suggested enhancements
// further down), please DONT just send the corrected/new code out on the internet,
// but instead send it to me, so I can put it into the official version. You will
// be acredited if you do so.
//
//
// DISCLAIMER
// By using this component or parts theirof you are accepting the full
// responsibility of the use. You are understanding that the author cant be
// made responsible in any way for any problems occuring using this component.
// You also recognize the author as the creator of this component and agrees
// not to claim otherwize!
//
// Please forward corrected versions (source code ONLY!), comments,
// and emails saying you are using it for this or that project to:
//            [e-mail]
//
// Latest version can be found at:
//            http://www.components4developers.com

//=============================================================================
// Remove the remark on the next lines if to keep CSV file compatibility
// between different versions of TkbmMemTable.
//{$define CSV_FILE_1XX_COMPATIBILITY}
//=============================================================================

// History.
// Per v. 3.00, the stream formats will have their own history.
//
// 3.00a alpha
//       Initial v. 3.00 CSV stream format release based on the sources of v. 2.53b.
//
// 3.00b alpha 11. Aug. 2001
//       Fixed loading CSV with CSVQuote=#0 and CSVRecordDelimiter=#0.
//       Fixed not allowing CSVFieldDelimiter=#0.
//       Bugs reported by Dave ([e-mail])
//
// 3.00c alpha 12. Aug. 2001
//       Added support for the Assign method.
//
// 3.00d alpha 20. Sep. 2001
//       Changed GetWord to automatically detect and accept unquoted fields.
//       Contribution by Georg Zimmer ([e-mail]).
//
// 3.00e alpha 17. Nov. 2001
//       Fixed LoadDef not deciphering the field definition list correctly
//       todo with field kind and default expression.
//
// 3.00f beta 30. Jan. 2002
//       Fixed bug reading CSV files with blobs.
//       Reason was a faulty GetWord algorithm.
//
// 3.00f9 beta 25. Feb. 2002
//       Added OnFormatLoadField and OnFormatSaveField event for reformatting of data.
//       Added sfQuoteOnlyStrings flag for selecting to only quote string/binary fields during save.
//       Published sfNoHeader and completed support for it. It controls if a header should be saved or loaded.
//
// 3.00 Final 14. Jun. 2002
//       Changed version status to final.
//
// 3.01 7. Aug. 2002
//      Fixed problem not loading last field if not quoted. Bug reported by several.

uses
  kbmMemTable,Classes,DB,
{$include kbmMemRes.inc}
  SysUtils;

type
  TkbmStreamFlagLocalFormat   = (sfSaveLocalFormat,sfLoadLocalFormat);
  TkbmStreamFlagNoHeader      = (sfSaveNoHeader,sfLoadNoHeader);
  TkbmStreamFlagQuoteOnlyStrings = (sfSaveQuoteOnlyStrings);
  TkbmStreamFlagPlaceholders  = (sfSavePlaceholders);

  TkbmStreamFlagsLocalFormat  = set of TkbmStreamFlagLocalFormat;
  TkbmStreamFlagsNoHeader     = set of TkbmStreamFlagNoHeader;
  TkbmStreamFlagsPlaceHolders = set of TkbmStreamFlagPlaceHolders;
  TkbmStreamFlagsQuoteOnlyStrings = set of TkbmStreamFlagQuoteOnlyStrings;

  TkbmOnFormatLoadField = procedure(Sender:TObject; Field:TField; var Null:boolean; var Data:string) of object;
  TkbmOnFormatSaveField = procedure(Sender:TObject; Field:TField; var Null:boolean; var Data:string) of object;

  TkbmCustomCSVStreamFormat = class(TkbmCustomStreamFormat)
  private
     FDataset:TkbmCustomMemTable;
     FOnFormatLoadField:TkbmOnFormatLoadField;
     FOnFormatSaveField:TkbmOnFormatSaveField;

     Ods,Oms,Ots,Oths:char;
     Ocf,Onf:Byte;
     Osdf,Ocs:string;

     buf,bufptr:PChar;
     remaining_in_buf:integer;
     Line,Word:string;
     lptr,elptr:PChar;

     ProgressCnt:integer;
     StreamSize:longint;

     FCSVQuote:char;
     FCSVFieldDelimiter:char;
     FCSVRecordDelimiter:char;
     FCSVTrueString,FCSVFalseString:string;
     FsfLocalFormat:TkbmStreamFlagsLocalFormat;
     FsfNoHeader:TkbmStreamFlagsNoHeader;
     FsfPlaceHolders:TkbmStreamFlagsPlaceHolders;
     FsfQuoteOnlyStrings:TkbmStreamFlagsQuoteOnlyStrings;

     procedure SetCSVFieldDelimiter(Value:char);
  protected
     FDefLoaded:boolean;

     function GetChunk:boolean; virtual;
     function GetLine:boolean; virtual;
     function GetWord(var null:boolean):string; virtual;

     function GetVersion:string; override;

     procedure BeforeSave(ADataset:TkbmCustomMemTable); override;
     procedure SaveDef(ADataset:TkbmCustomMemTable); override;
     procedure SaveData(ADataset:TkbmCustomMemTable); override;
     procedure AfterSave(ADataset:TkbmCustomMemTable); override;

     procedure DetermineLoadFieldIDs(ADataset:TkbmCustomMemTable; AList:TStringList; Situation:TkbmDetermineLoadFieldsSituation); override;
     procedure DetermineLoadFieldIndex(ADataset:TkbmCustomMemTable; ID:string; FieldCount:integer; OrigIndex:integer; var NewIndex:integer; Situation:TkbmDetermineLoadFieldsSituation); override;
     procedure BeforeLoad(ADataset:TkbmCustomMemTable); override;
     procedure LoadDef(ADataset:TkbmCustomMemTable); override;
     procedure LoadData(ADataset:TkbmCustomMemTable); override;
     procedure AfterLoad(ADataset:TkbmCustomMemTable); override;

     property OnFormatLoadField:TkbmOnFormatLoadField read FOnFormatLoadField write FOnFormatLoadField;
     property OnFormatSaveField:TkbmOnFormatSaveField read FOnFormatSaveField write FOnFormatSaveField;
     property CSVQuote:char read FCSVQuote write FCSVQuote;
     property CSVFieldDelimiter:char read FCSVFieldDelimiter write SetCSVFieldDelimiter;
     property CSVRecordDelimiter:char read FCSVRecordDelimiter write FCSVRecordDelimiter;
     property CSVTrueString:string read FCSVTrueString write FCSVTrueString;
     property CSVFalseString:string read FCSVFalseString write FCSVFalseString;
     property sfLocalFormat:TkbmStreamFlagsLocalFormat read FsfLocalFormat write FsfLocalFormat;
     property sfNoHeader:TkbmStreamFlagsNoHeader read FsfNoHeader write FsfNoHeader;
     property sfPlaceHolders:TkbmStreamFlagsPlaceHolders read FsfPlaceHolders write FsfPlaceHolders;
     property sfQuoteOnlyStrings:TkbmStreamFlagsQuoteOnlyStrings read FsfQuoteOnlyStrings write FsfQuoteOnlyStrings;
  public
     constructor Create(AOwner:TComponent); override;
     procedure Assign(Source:TPersistent); override;
  end;

  TkbmCSVStreamFormat = class(TkbmCustomCSVStreamFormat)
  published
     property CSVQuote;
     property CSVFieldDelimiter;
     property CSVRecordDelimiter;
     property CSVTrueString;
     property CSVFalseString;
     property sfLocalFormat;
     property sfQuoteOnlyStrings;
     property sfNoHeader;
     property Version;

     property sfData;
     property sfCalculated;
     property sfLookup;
     property sfNonVisible;
     property sfBlobs;
     property sfDef;
     property sfIndexDef;
     property sfPlaceHolders;
     property sfFiltered;
     property sfIgnoreRange;
     property sfIgnoreMasterDetail;
     property sfDeltas;
     property sfDontFilterDeltas;
     property sfAppend;
     property sfFieldKind;
     property sfFromStart;

     property OnFormatLoadField;
     property OnFormatSaveField;
     property OnBeforeLoad;
     property OnAfterLoad;
     property OnBeforeSave;
     property OnAfterSave;
     property OnCompress;
     property OnDeCompress;
  end;

  function StringToCodedString(const Source:string):string;
  function CodedStringToString(const Source:string):string;
  function StringToBase64(const Source:string):string;
  function Base64ToString(const Source:string):string;

{$ifdef LEVEL3}
procedure Register;
{$endif}

implementation

const
  // Table definition magic words.
  kbmTableDefMagicStart = '@@TABLEDEF START@@';
  kbmTableDefMagicEnd = '@@TABLEDEF END@@';

  // Index definition magic words.
  kbmIndexDefMagicStart = '@@INDEXDEF START@@';
  kbmIndexDefMagicEnd = '@@INDEXDEF END@@';

  // File version magic word.
  kbmFileVersionMagic = '@@FILE VERSION@@';

  // Current file versions. V. 1.xx file versions are considered 100, 2.xx are considered 2xx etc.
  kbmCSVFileVersion = 251;

  CSVBUFSIZE=8192;

type
  TkbmProtCustomMemTable = class(TkbmCustomMemTable);
  TkbmProtCommon = class(TkbmCommon);

// General procedures
// ************************************************************

// Code special characters (LF,CR,%,#0)
// CR (#13) -> %c
// LF (#10) -> %n
// #0 -> %0
// % -> %%
function StringToCodedString(const Source:string):string;
var
   i,j:integer;
   l:integer;
begin
     // Count CR/LF.
     l:=0;
     for i:=1 to length(Source) do
         if Source[i] in [#13,#10,'%',#0] then inc(l);

     // If no special characters, return the original string.
     if l=0 then
     begin
          Result:=Source;
          exit;
     end;

     // If any special characters, make room for them.
     SetLength(Result,length(Source)+l);

     // Code special characters.
     j:=1;
     for i:=1 to length(Source) do
         case Source[i] of
              #13: begin
                        Result[j]:='%'; inc(j);
                        Result[j]:='c'; inc(j);
                   end;
              #10: begin
                        Result[j]:='%'; inc(j);
                        Result[j]:='n'; inc(j);
                   end;
              #0:  begin
                        Result[j]:='%'; inc(j);
                        Result[j]:='0'; inc(j);
                   end;
              '%': begin
                        Result[j]:='%'; inc(j);
                        Result[j]:='%'; inc(j);
                   end;
              else
                   begin
                        Result[j]:=Source[i];
                        inc(j);
                   end;
         end;
end;

// Decode special characters (LF,CR,%,#0)
// %c -> CR (#13)
// %n -> LF (#10)
// %% -> %
// %0 -> #0
function CodedStringToString(const Source:string):string;
var
   i,j:integer;
begin
     SetLength(Result,length(Source));

     // Code special characters.
     i:=1;
     j:=1;
     while true do
     begin
          if i>length(Source) then break;
          if Source[i]='%' then
          begin
               inc(i);
               case Source[i] of
                    'c': Result[j]:=#13;
                    'n': Result[j]:=#10;
                    '%': Result[j]:='%';
                    '0': Result[j]:=#0;
               end;
               inc(j);
          end
          else
          begin
               Result[j]:=Source[i];
               inc(j);
          end;
          inc(i);
     end;

     // Cut result string to right length.
     if i<>j then SetLength(Result,j-1);
end;

// Code a string as BASE 64.
function StringToBase64(const Source:string):string;
var
   Act: Word;
   Bits,I,P,Len: Integer;
begin
     Bits:=0;
     Len:=(Length(Source)*4+2) div 3;
     if Len>0 then
     begin
          SetLength(Result,Len);
	        P:=1;
	        Act:=0;