View Issue Details

IDProjectCategoryView StatusLast Update
0022980FPCDatabasepublic2016-06-05 08:50
ReporterJohn Kozikopoulos Assigned ToMichael Van Canneyt  
PrioritynormalSeverityfeatureReproducibilityN/A
Status resolvedResolutionno change required 
PlatformallOSall 
Product Version2.6.1 
Summary0022980: sdfDataset enhancements
DescriptionI have made a few enhancements in the sdfDataset component,
1) enhanced the record parser to correctly recognize quoted value and preserve CRLF when are quoted. see TSDFStringList class.
2) Changed the field parser in the StoreToBuf method to
 a) recognize quoted fields regardless of their position or number in the string
    eg :[ This is "a ""Double Quoted""" field and "everything ""will"" be preserved"] Should produce the result
        [ This is a "double Quoted" field and everything "will" be preserved]
 b) eliminated a infinite loop that was caused by incorrectly ignoring 0000013#10 and doing nothing at the start of the method
3) added a few extra properties to help the end user decide how to handle spaces
   a) TrimLeadingSpaces
   b) TrimrtailingSpaces this one is directly linked with TrimSpaces of FixedLegthDataset
   c) AlwaysUnQuote when true it will remove quotes when the parser sees them if false the quotes has to be in the first character in the string for the removal process to take place. In all cases the quotes are recognized correctly and they either get removed or be part of the value presented to the end user.
4) I have changed the way the FirstLineAsSchema works now if the file has no schema line and the Schema list is empty then the TfieldDefs list is used to create a schema line in all other cases Schema property takes presents.


I am attaching the sdfData.pp file along with a patch that was created against the FPC 2.6.1 svn repository as it was shared on the daily snapshots on 16/SEP/2012 with file name Lazarus-1.1-38674-fpc-2.6.1-20120916-win32.exe

I hope it is useful to someone else as well.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Relationships

related to 0024739 resolvedMichael Van Canneyt [Patch] FCL-base: add csvdocument 
related to 0022894 closedJoost van der Sluis Sdfdataset: empty file with FirstLineAsSchema reports Recordcount 1 instead of 0 
related to 0022882 closedJoost van der Sluis SDFDataset .AllowMultiLine does not support multiline import 

Activities

2012-09-25 20:58

 

sdfdata.pp.patch (29,509 bytes)   
--- c:/lazarus.1.1/fpc/2.6.1/source/packages/fcl-db/src/sdf/sdfdata.pp	Tue Jul 24 19:00:53 2012
+++ D:/jkoz/Lazarus/Projects/MultiLine SDF/newtests2/sdfdata.pp	Mon Sep 24 09:58:09 2012
@@ -2,22 +2,63 @@
 
 {$mode objfpc}
 {$h+}
-
 //-----------------------------------------------------------------------------
 { Unit Name  : SdfData  Application : TSdfDataSet TFixedFormatDataSet Components
   Version    : 2.05
   Author     : Orlando Arrocha           email: oarrocha@hotmail.com
-  Purpose    : This components are designed to access directly text files as
+  Purpose    : These components are designed to access directly text files as
                database tables. The files may be limited (SDF) or fixed size
                columns.
 ---------------
 Modifications
 ---------------
-14/Jul/11 BigChimp:
+24/SEP/2012 JKOZ :
+      Added Property AlwaysDeQuote when true the quotes inside a field's
+      data will always be removed regardless of there position when false they
+      will be removed only if the first character of the data is the FFieldQuote
+      character, default behavior is false.
+22/SEP/2012 JKOZ :
+      Rewrote the Field Parser in the StoreToBuf method to allow it to recognise
+      the quoted data in a fields value better. As of now when a FFieldQuote
+      character is found in  the Field's value the parser will try to dermine the
+      end of the quoted value if for any reason the parser reaches the end of the record
+      while inside a quoted value it will assume that the character that started the
+      quoted value parser was not quote and will revert to non quoted values
+      until the end of the field's data parsing, stoping in the first delimiter
+      character or crlf or the end of record only. This meens that certain parts
+      of a field's data will be double parsed.
+      When a quoted value has found inside a field's data value the dequoter is now
+      removing only the quotes from the quoted portion of the data preserving the
+      extra data outside the quotes as proper data.
+      Added TrimLeadingSpaces and TrimTrailingspaces properties to allow the user
+      to decide what to do with those spaces.
+      Changed the internal representation of empty space in a record from #32 to #1
+      this gave me the ability to distinguise between spaces the user entered and
+      must be kept and empty record space which is always trimed.
+
+19/Sep/2012 JKOZ :
+      Changed the behavior of schema line now if the schema is empty and the
+        fieldDefs collection has items, those items are used to create a schema.
+      The logic of field size calculation has been changed to a Datatype depended method
+        to allow us to keep the fielddefs and not lose the data type information
+        and the validation that comes with it (to be implemented).
+      RecordCount behavior changed, now it does not count the schema line in the records.
+
+15/Sep/2012 JKOZ :
+      Default Value declaration of a property and the value assigned to
+      that property's field in the constructor must be the same. This
+      solves a bug where AllowMultiLine could only be set from code.
+      Subclass TStringList and make it aware of quotes and quoted text;
+      Override SetTextStr and change the parser to walk through quoted fields.
+      Change FData type From TstringList to TSDFStringList.
+      Read support for multiline fields.
+7/Jun/12 Reinier Olislagers aka BigChimp:
+      Quote fields with delimiters or quotes to match Delphi SDF definition
+      (see e.g. help on TStrings.CommaText)
+14/Jul/11 Reinier Olislagers aka BigChimp:
       Added AllowMultiLine property so user can use fields that have line endings
       (Carriage Return and/or Line Feed) embedded in their fields (fields need to be
-      quoted). Enabled by default; will break compatibility with earlier versions of
-      SdfData, but using multilines would have resulted in corrupted import anyway.
+      quoted). For now: output only (reading these fields does not work yet)
 12/Mar/04  Lazarus version (Sergey Smirnov AKA SSY)
       Locate and CheckString functions are removed because of Variant data type.
       Many things are changed for FPC/Lazarus compatibility.
@@ -126,12 +167,34 @@
 }
 //-----------------------------------------------------------------------------
 interface
-
 uses
   DB, Classes, SysUtils, DBConst;
 
+const  //MAX number of characters required to store a value in a text.
+  SDFMaxIntLength       = 11;
+  SDFMaxInt64Length     = 20;
+  SDFMaxCurrencyLength  = 21;
+  SDFMaxExtendedLength  = 50; //random chosen number.
+  SDFMaxBooleanLength   = 4;
+  SDFMaxInt16Length     = 6;
+  SDFMaxInt8Length      = 4;
+  SDFMaxDateLength      = 10;
+  SDFMaxTimeLength      = 12;
+  SDFMaxTimeStampLength = 30; //random chosen number.
+  SDFMaxDateTimeLength  = 24;
+  SDFMaxGUIDLength      = 38;
+
 type
 //-----------------------------------------------------------------------------
+// TSDFStringList
+  TSDFStringList = Class(TStringList)
+  private
+  protected
+    procedure SetTextStr(const Value: string); override;
+  public
+    constructor Create;
+  end;
+//-----------------------------------------------------------------------------
 // TRecInfo
   PRecInfo = ^TRecInfo;
   TRecInfo = packed record
@@ -159,15 +222,15 @@
     function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
     procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
   protected
-    FData               :TStringlist;
-    FCurRec             :Integer;
-    FRecBufSize         :Integer;
-    FRecordSize         :Integer;
-    FLastBookmark       :PtrInt;
-    FRecInfoOfs         :Integer;
-    FBookmarkOfs        :Integer;
-    FSaveChanges        :Boolean;
-    FDefaultRecordLength:Cardinal;
+    FData               : TSDFStringList;
+    FCurRec             : Integer;
+    FRecBufSize         : Integer;
+    FRecordSize         : Integer;
+    FLastBookmark       : PtrInt;
+    FRecInfoOfs         : Integer;
+    FBookmarkOfs        : Integer;
+    FSaveChanges        : Boolean;
+    FDefaultRecordLength: Cardinal;
     FDataOffset         : Integer;
   protected
     function AllocRecordBuffer: TRecordBuffer; override;
@@ -192,7 +255,9 @@
     function GetRecordSize: Word; override;
     procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
     procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
+
     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+
     procedure ClearCalcFields(Buffer: TRecordBuffer); override;
     function GetRecordCount: Integer; override;
     function GetRecNo: Integer; override;
@@ -254,42 +319,162 @@
 // TSdfDataSet
   TSdfDataSet = class(TFixedFormatDataSet)
   private
-    FDelimiter : Char;
-    FFirstLineAsSchema : Boolean;
-    FFMultiLine         :Boolean;
+    FAlwaysDeQuote: Boolean;
+    FDelimiter          : Char;
+    FFieldQuote         : Char;
+    FFirstLineAsSchema  : Boolean;
+    FFMultiLine         : Boolean;
+    FTrimLeadingSpaces  : Boolean;
+    procedure SetAlwaysDeQuote(AValue: Boolean);
+    procedure SetFieldQuote(AValue: Char);
     procedure SetMultiLine(const Value: Boolean);
     procedure SetFirstLineAsSchema(Value : Boolean);
     procedure SetDelimiter(Value : Char);
+    procedure SetTrimLeadingSpaces(AValue: Boolean);
+    procedure SetTrimSpace(AValue: Boolean);
   protected
     procedure InternalInitFieldDefs; override;
     function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
              : TGetResult; override;
     function BufToStore(Buffer: TRecordBuffer): String; override;
     function StoreToBuf(Source: String): String; override;
+    function GetRecordCount: Integer; override;
   public
     constructor Create(AOwner: TComponent); override;
   published
-    property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default True; //Whether or not to allow fields containing CR and/or LF
+    property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default False; //Whether or not to allow fields containing CR and/or LF
     property Delimiter: Char read FDelimiter write SetDelimiter;
     property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
+    property FieldQuote : Char read FFieldQuote write SetFieldQuote default #34;
+    property TrimLeadingSpaces  : Boolean read FTrimLeadingSpaces write SetTrimLeadingSpaces default False;
+    property TrimTrailingSpaces : Boolean read FTrimSpace write SetTrimSpace default False;
+    property AlwaysDeQuote      : Boolean read FAlwaysDeQuote write SetAlwaysDeQuote default False;
   end;
 procedure Register;
 
 implementation
 //{$R *.Res}
 
+{ TSDFStringList }
+const
+  DefaultFieldQuote : Char = '"';
+  WhiteSpace = [#0..#31];
+
+function InternalTrim(const S: string; TrimLeadSpace,TrimTrailSpace:boolean): string;
+var Ofs, Len: integer;
+    WhiteChars : set of Char;
+begin
+  len := Length(S);
+  if TrimTrailSpace then WhiteChars:=WhiteSpace+[#32] else WhiteChars := WhiteSpace;
+  while (Len>0) and (S[Len] in WhiteChars) do
+   dec(Len);
+  Ofs := 1;
+  if TrimLeadSpace then WhiteChars:=WhiteSpace+[#32] else WhiteChars := WhiteSpace;
+  while (Ofs<=Len) and (S[Ofs] in WhiteSpace) do
+   Inc(Ofs);
+  Result := Copy(S, Ofs, 1 + Len - Ofs);
+end ;
+procedure TSDFStringList.SetTextStr(const Value: string);
+  //JKOZ ENH_1 15/9/2012 5:10:44  copied here from stringl.inc I have no desire to reinvent the wheel.
+  Function GetNextLine (Const Value : String; Var S : String; Var P : Integer; aQuoteChar:Char=#0) : Boolean;
+  Var
+    PS : PChar;
+    IP,L : Integer;
+    InQuote:Boolean;
+  begin
+    L:=Length(Value);
+    S:='';
+    Result:=False;
+    If ((L-P)<0) then
+      exit;
+    if ((L-P)=0) and (not (value[P] in [#10,#13])) Then
+      Begin
+        S:=Value[P];
+        Inc(P);
+        Exit(True);
+      End;
+    PS:=PChar(Value)+P-1;
+    IP:=P;
+    InQuote := False;
+    While ((L-P)>=0) and ((not (PS^ in [#10,#13])) or InQuote ) do
+      begin
+      if (aQuoteChar <> #0) and (PS^ = aQuoteChar) then InQuote := not InQuote; //JKOZ ENH_1 Inquote check.
+      P:=P+1;
+      Inc(PS);
+      end;
+    SetLength (S,P-IP);
+    System.Move (Value[IP],Pointer(S)^,P-IP);
+    If (P<=L) and (Value[P]=#13) then
+      Inc(P);
+    If (P<=L) and (Value[P]=#10) then
+      Inc(P); // Point to character after #10(#13)
+    Result:=True;
+  end;
+Var
+  S : String;
+  P : Integer;
+begin
+  Try
+    BeginUpdate;
+    Clear;
+    P:=1;
+    While GetNextLine (Value,S,P, QuoteChar) do
+      Add(S);
+  finally
+    EndUpdate;
+  end;
+end;
+
+constructor TSDFStringList.Create;
+begin
+  inherited Create;
+  QuoteChar := #0;
+end;
+
+function FieldDefSize(aFieldDef:TFieldDef; DefaultSize:Integer):integer;inline;
+begin
+  case aFieldDef.DataType of
+    ftFixedChar,
+    ftFixedWideChar,
+    ftWideString,
+    ftMemo,
+    ftWideMemo,
+    ftFmtMemo,
+    ftString      : Result := aFieldDef.Size;
+    ftInteger     : result := SDFMaxIntLength;
+    ftCurrency    : Result := SDFMaxCurrencyLength;
+    ftBoolean     : Result := SDFMaxBooleanLength; //yes/no/true/false
+    ftLargeint,
+    ftAutoInc     : Result := SDFMaxInt64Length;
+    ftWord,                        //65535
+    ftSmallint    : result := SDFMaxInt16Length;  //-32768..32767
+    ftDate        : Result := SDFMaxDateLength; //YYYY/MM/DD
+    ftDateTime    : result := SDFMaxDateTimeLength; //YYYY/MM/DD HH:MM:SS:nnn
+    ftTime        : Result := SDFMaxTimeLength; //HH:MM:SS:nnn
+    ftTimeStamp   : Result := SDFMaxTimeStampLength; //random number needs to be verified.
+    ftBlob,
+    ftOraBlob,
+    ftOraClob     : Result := aFieldDef.Size*2;//u64 encoding requires 2 chars per byte.
+    ftBCD,
+    ftFloat,
+    ftFMTBcd      : Result := SDFMaxExtendedLength; //random number.
+    ftGuid        : Result := SDFMaxGUIDLength;
+  else
+    Result := DefaultSize;
+  end;
+end;
 //-----------------------------------------------------------------------------
 // TFixedFormatDataSet
 //-----------------------------------------------------------------------------
 constructor TFixedFormatDataSet.Create(AOwner : TComponent);
 begin
   FDefaultRecordLength := 250;
-  FFileMustExist  := TRUE;
-  FLoadfromStream := False;
-  FRecordSize   := 0;
-  FTrimSpace     := TRUE;
-  FSchema       := TStringList.Create;
-  FData         := TStringList.Create;  // Load the textfile into a stringlist
+  FFileMustExist       := TRUE;
+  FLoadfromStream      := False;//?????
+  FRecordSize          := 0;
+  FTrimSpace           := TRUE;
+  FSchema              := TStringList.Create;
+  FData                := TSDFStringList.Create;  // Load the textfile into a stringlist
   inherited Create(AOwner);
 end;
 
@@ -339,7 +524,7 @@
     exit;
   FRecordSize := 0;
   Maxlen := 0;
-  FieldDefs.Clear;
+  //FieldDefs.Clear; //JKOZ : use fieldDefs to allow for design time schema definition.
   for i := FData.Count - 1 downto 0 do  // Find out the longest record
   begin
     len := Length(FData[i]);
@@ -347,11 +532,14 @@
       Maxlen := len;
     FData.Objects[i] := TObject(Pointer(i+1));   // Fabricate Bookmarks
   end;
-  if (Maxlen = 0) then
+  if (Maxlen = 0) or (FData.Count < 2) then
     Maxlen := FDefaultRecordLength;
   LstFields := TStringList.Create;
   try
     LoadFieldScheme(LstFields, Maxlen);
+    FieldDefs.Clear; //JKOZ : Both datasets depend on the Field.size property to allocate memory.
+                     //       This is a patch it converts everything to string loosing
+                     //       all forms of validation.
     for i := 0 to LstFields.Count -1 do  // Add fields
     begin
       len := StrToIntDef(LstFields.Values[LstFields.Names[i]], Maxlen);
@@ -370,7 +558,7 @@
   FCurRec := -1;
   FSaveChanges := FALSE;
   if not Assigned(FData) then
-    FData := TStringList.Create;
+    FData := TSDFStringList.Create;
   if (not FileMustExist) and (not FileExists(FileName)) then
   begin
     Stream := TFileStream.Create(FileName, fmCreate);
@@ -426,7 +614,7 @@
   if assigned(stream) then
   begin
     Active          := False; //Make sure the Dataset is Closed.
-    Stream.Position := 0;     //Make sure you are at the top of the Stream.
+    Stream.Position := 0;     //Make sure you are at the top of the Stream. //JKOZ raise exception.Create('stream is not a file can't move to start');
     FLoadfromStream := True;
     if not Assigned(FData) then
      raise Exception.Create('Data buffer unassigned');
@@ -443,7 +631,7 @@
   if assigned(stream) then
     FData.SaveToStream(Stream)
   else
-    raise exception.Create('Invalid Stream Assigned (Save To Stream');
+    raise exception.Create('Invalid Stream Assigned (Save To Stream'); //
 end;
 
 // Record Functions
@@ -493,12 +681,12 @@
       DatabaseError('No Records');
 end;
 
-function TFixedFormatDataSet.GetRecordCount: Longint;
+function TFixedFormatDataSet.GetRecordCount: Integer;
 begin
   Result := FData.Count;
 end;
 
-function TFixedFormatDataSet.GetRecNo: Longint;
+function TFixedFormatDataSet.GetRecNo: Integer;
 var
   BufPtr: TRecordBuffer;
 begin
@@ -540,13 +728,14 @@
 function TFixedFormatDataSet.TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
 var
   Accepted : Boolean;
+  Temp     : string;
 begin
   Result := grOK;
   repeat
     Accepted := TRUE;
     case GetMode of
       gmNext:
-        if FCurRec >= RecordCount - 1  then
+        if FCurRec >= FData.Count{RecordCount} - 1  then
           Result := grEOF
         else
           Inc(FCurRec);
@@ -556,12 +745,13 @@
         else
           Dec(FCurRec);
       gmCurrent:
-        if (FCurRec < FDataOffset) or (FCurRec >= RecordCount) then
+        if (FCurRec < FDataOffset) or (FCurRec >= FData.Count{RecordCount}) then
           Result := grError;
     end;
     if (Result = grOk) then
     begin
-      Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
+      Temp:=StoreToBuf(FData[FCurRec]);
+      Move(Temp[1], Buffer[0], FRecordSize);
       if Filtered then
       begin
         Accepted := RecordFilter(Buffer, FCurRec +1);
@@ -606,8 +796,14 @@
       tmpSchema.Assign(Schema);
       RemoveWhiteLines(tmpSchema, FALSE);
     end
-    else
-      tmpSchema.Add('Line');
+    else begin//jkoz : use existing fieldDefs to create a Schema.
+      if FieldDefs.Count > 0 then begin
+        for i := 0 to FieldDefs.Count -1 do begin
+          tmpFieldName := Format('%s=%d', [FieldDefs[i].Name, FieldDefSize(FieldDefs[i],MaxSize)]);
+          tmpSchema.Add(tmpFieldName);
+        end;
+      end else tmpSchema.Add('Line');
+    end;
     for i := 0 to tmpSchema.Count -1 do // Interpret Schema
     begin
       tmpFieldName := tmpSchema.Names[i];
@@ -625,6 +821,7 @@
 function TFixedFormatDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 var
   TempPos, recbuf : PChar;
+  WhiteSpace : set of char = [#1..#31];
 begin
   Result := GetActiveRecBuf(TRecordBuffer(RecBuf));
   if Result then
@@ -645,17 +842,15 @@
   if Result and (Buffer <> nil) then
   begin
     StrLCopy(Buffer, RecBuf, Field.Size);
-    if FTrimSpace then
-    begin
-      TempPos := StrEnd(Buffer);
-      repeat
-        Dec(TempPos);
-        if (TempPos[0] = ' ') then
-          TempPos[0]:= #0
-        else
-          break;
-      until (TempPos = Buffer);
-    end;
+    if FTrimSpace then WhiteSpace:=WhiteSpace+[#32];
+    TempPos := StrEnd(Buffer);
+    repeat
+      Dec(TempPos);
+      if (TempPos[0] in WhiteSpace) then
+        TempPos[0]:= #0
+      else
+        break;
+    until (TempPos = Buffer);
   end;
 end;
 
@@ -682,7 +877,7 @@
       BufEnd := StrEnd(pansichar(ActiveBuffer));  // Fill with blanks when necessary
       if BufEnd > RecBuf then
         BufEnd := RecBuf;
-      FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), Ord(' '));
+      FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), #1);
       p := StrLen(Buffer);
       if p > Field.Size then
         p := Field.Size;
@@ -851,7 +1046,11 @@
   inherited Create(AOwner);
   FDelimiter := ',';
   FFirstLineAsSchema := FALSE;
-  FFMultiLine :=False;
+  FFieldQuote        := #34; //"
+  FData.QuoteChar    := FFieldQuote;
+  FTrimLeadingSpaces := False;
+  FTrimSpace         := False;
+  FAlwaysDeQuote     := False;
 end;
 
 procedure TSdfDataSet.InternalInitFieldDefs;
@@ -911,7 +1110,7 @@
 
     until (pEnd > len);
   end;
-  inherited;
+  inherited InternalInitFieldDefs;
 end;
 
 function TSdfDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
@@ -928,8 +1127,8 @@
       end
     else
       begin
-      If (FCurrec=-1) and (GetMode=gmNext) then
-        inc(FCurrec);
+      If (FCurRec=-1) and (GetMode=gmNext) then
+        inc(FCurRec);
       Result := inherited GetRecord(Buffer, GetMode, DoCheck);
       end;
   end
@@ -938,107 +1137,186 @@
 end;
 
 function TSdfDataSet.StoreToBuf(Source: String): String;
+
 const
  CR :char = #13;
  LF :char = #10;
 var
-  i,
-  p             :Integer;
-  pRet,
-  pStr,
-  pStrEnd       :PChar;
-  Ret           :String;
-begin
-  SetLength(Ret, FRecordSize);
+  IsQuoted   // Whether or not field starts with a quote
+                  : Boolean;
+  FieldMaxSize, // Maximum fields size as defined in FieldDefs
+  i,         // Field counter (0..)
+  p          // Length of string in field
+                  : Integer;
+  pDeQuoted, // Temporary buffer for dedoubling quotes
+  pRet,      // Pointer to insertion point in return value
+  pStr,      // Beginning of field
+  pStrEnd    // End of field
+                  : PChar;
+  Ret             : String;
+  WhiteSpaceChars : set of Char;
+  Cntr            : Integer;
+  InQuote         : Boolean = False;
 
-  FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
-    PStrEnd := PChar(Source);
-  pRet := PChar(Ret);
+  IgnoreQuoteStatus : Boolean = False;
+  S                 : string;
 
-  for i := 0 to FieldDefs.Count - 1 do
-   begin
+  function Buildchar(const size:integer;achar:char):string;
+  begin
+    result := '';
+    SetLength(Result,size);
+    FillChar(Result[1],size,achar);
+  end;
 
-    while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
-    begin
-     if FFMultiLine then
-      begin
-       if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
-        begin
-         //view this as text, not control characters, so do nothing
-         //todo: check if this is really necessary, probably revert
-         //to original code as quoted case is handled below
-        end;
-      end
-     else
-      begin
-       Inc(pStrEnd);
+  function Dequote:string;
+  var
+    InQ : boolean;
+    PI  : PChar;
+    Cn  : integer;
+  begin
+    Result:='';
+    if pStr = pStrEnd then Exit;
+    PI := pStr;
+    InQ := False;
+    repeat
+      if InQ and (PI[0] = FFieldQuote) then begin
+        Cn := 0;
+        while (PI[0] = FFieldQuote) and (PI[0] <> PStrEnd) do begin inc(PI);INC(Cn);end;
+        InQ:= (Cn mod 2)<>1;
+        if Cn>1 then Result := Result+Buildchar(Cn div 2, FFieldQuote);
+        Dec(PI);
+      end else
+        if PI[0] = FFieldQuote then InQ:= not InQ
+      else Result := Result + PI[0];
+      Inc(PI);
+    until (PI = pStrEnd) or (PI[0] =#0);
+    if not (PI[0] in [FFieldQuote,#0, FDelimiter]) then Result := Result+PI[0];// else Result := Result + ' ';
+  end;
+
+  procedure ParseToQuoteEnd;
+  var
+    quotecount : Integer=0;
+    Back       : PChar;
+  begin
+    Back:= pStrEnd;
+    repeat
+      inc(pStrEnd);
+      if pStrEnd^ = FFieldQuote then begin
+        quotecount:=0;
+        repeat
+          inc(quotecount);
+          inc(pStrEnd);
+        until pStrEnd^ <> FFieldQuote;
+        InQuote:= (quotecount mod 2) = 0;
+        if not InQuote then Dec(pStrEnd);
       end;
+    until (pStrEnd[0] in [#0,FFieldQuote]) or (not FFMultiLine and (pStrEnd[0] in[#10,#13]));
+    //in case we have reached the end of string and we are still inquote then
+    //reparse the field value ignoring quotes.
+    if InQuote and (pStrEnd[0] <> FFieldQuote) then begin
+      pStrEnd := Back;
+      Inc(pStrEnd);
+      IgnoreQuoteStatus:=True;
+      IsQuoted:=False;
+    end else begin
+      IsQuoted:=True;
+      Inc(pStrEnd);
     end;
+  end;
 
-    if not Boolean(Byte(pStrEnd[0])) then
-     break;
+  procedure ParseFieldValue;
+  begin
+    repeat
+      if (pStrEnd[0] = '"') and (not IgnoreQuoteStatus) then InQuote := not InQuote;
+      if InQuote then ParseToQuoteEnd
+      else Inc(pStrEnd);
+    until pStrEnd[0] in [#0, Delimiter,#13,#10];
+  end;
 
-    pStr := pStrEnd;
+  procedure SkipWhiteSpace;
+  begin
+    while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in WhiteSpaceChars) do
+      Inc(pStrEnd);
+  end;
+  function CharReplace(var InStr:String;const OldChar,NewChar:Char):Integer;
+  var
+    Cntr : Integer;
+  begin
+    Result := 0;
+    for Cntr := 1 to Length(InStr) do
+      if InStr[Cntr] = oldChar then begin InStr[cntr]:=NewChar;inc(Result); end;
+  end;
+begin
+  SetLength(Ret, FRecordSize);
+  FillChar(Ret[1], FRecordSize, #1);
 
-    if (pStr[0] = '"') then
-     begin
-      if FFMultiLine then
-       begin
-        repeat
-         Inc(pStrEnd);
-        until not Boolean(Byte(pStrEnd[0])) or
-         ((pStrEnd[0] = '"') and ((pStrEnd + 1)[0] in [Delimiter,#0]));
-       end
-      else
-       begin
-        // No multiline, so treat cr/lf as end of record
-         repeat
-          Inc(pStrEnd);
-         until not Boolean(Byte(pStrEnd[0])) or
-          ((pStrEnd[0] = '"') and ((pStrEnd + 1)[0] in [Delimiter,CR,LF, #0]));
-       end;
+  PStrEnd := PChar(Source);
+  pRet := PChar(Ret);
 
+  WhiteSpaceChars := WhiteSpace;
+  if FTrimLeadingSpaces then WhiteSpaceChars:=WhiteSpaceChars + [#32];
 
-      if (pStrEnd[0] = '"') then
-        Inc(pStr);
-     end
-    else
-      while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
-        Inc(pStrEnd);
+  for i := 0 to FieldDefs.Count - 1 do
+  begin
+    FieldMaxSize := FieldDefs[i].Size;
+    IgnoreQuoteStatus := False;
+    IsQuoted:=False;
 
-    p := pStrEnd - pStr;
-    if (p > FieldDefs[i].Size) then
-      p := FieldDefs[i].Size;
+    SkipWhiteSpace;
+    if not Boolean(Byte(pStrEnd[0])) then
+     break;    //end of string #0 has been reached.
 
-    Move(pStr[0], pRet[0], p);
+    pStr := pStrEnd;  //field data start
 
-    Inc(pRet, FieldDefs[i].Size);
+    ParseFieldValue;
 
-    if (pStrEnd[0] = '"') then
-      while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
-        Inc(pStrEnd);
+    p := pStrEnd - pStr; // do not include the last char be it delimeter or not
+    if IsQuoted and ((pStr^ = FFieldQuote) or AlwaysDeQuote) then begin
+      S:=Dequote;
+      p:=Length(S);
+    end else begin
+      S:='';
+      SetLength(S,p);
+      Move(pStr[0],S[1],p);
+    end;
+    if (p > FieldMaxSize) then
+      p := FieldMaxSize;
+    Move(S[1], pRet[0], p);
+
+    Inc(pRet, FieldMaxSize);
 
     if (pStrEnd[0] = Delimiter) then
      Inc(pStrEnd);
+
    end;
+
   Result := Ret;
 end;
 
+function TSdfDataSet.GetRecordCount: Integer;
+begin
+  Result:=inherited GetRecordCount;
+  //JKOZ: it reports the schema line as a record too.
+  if FFirstLineAsSchema then Dec(Result);
+end;
+
 function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
-const
- QuoteDelimiter='"';
 var
-  Str : String;
-  p, i : Integer;
-  QuoteMe: boolean;
+  Str     : String;
+  p, i    : Integer;
+  QuoteMe : boolean;
+  iSize   : Integer;
 begin
   Result := '';
   p := 1;
-  QuoteMe:=false;
   for i := 0 to FieldDefs.Count - 1 do
   begin
-    Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
-    Inc(p, FieldDefs[i].Size);
+    QuoteMe:=false;
+    //Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size)); //JKOZ:New Code for size.
+    iSize := FieldDefSize(FieldDefs[i], FDefaultRecordLength);
+    Str := InternalTrim(Copy(PAnsiChar(Buffer), p, iSize), FTrimLeadingSpaces, FTrimSpace);
+    //Inc(p, FieldDefs[i].Size); //JKOZ:New Code for size.
+    Inc(p, iSize);
     if FFMultiLine then
       begin
        // If multiline enabled, quote whenever we find carriage return or linefeed
@@ -1051,21 +1329,28 @@
        Str := StringReplace(Str, #10, '', [rfReplaceAll]);
        Str := StringReplace(Str, #13, '', [rfReplaceAll]);
       end;
-    // Check for any delimiters occurring in field text
-    if ((not QuoteMe) and (StrScan(PChar(Str), FDelimiter) <> nil)) then QuoteMe:=true;
+    // Check for any delimiters or quotes occurring in field text  
+    if (not QuoteMe) then
+	  if (StrScan(PChar(Str), FDelimiter) <> nil) or
+	     (StrScan(PChar(Str), FFieldQuote) <> nil) or
+             (StrScan(PChar(Str), #9) <> nil) then QuoteMe:=true;
     if (QuoteMe) then
       begin
-      Str:=Stringreplace(Str,QuoteDelimiter,QuoteDelimiter+QuoteDelimiter,[rfReplaceAll]);
-      Str := QuoteDelimiter + Str + QuoteDelimiter;
+        Str := AnsiQuotedStr(Str, FFieldQuote); //JKOZ : use system procs as much as possible it will be easier to convert to newer versions.
+        //Str := Stringreplace(Str, FFieldQuote, FFieldQuote+FieldQuote, [rfReplaceAll]);
+        //Str := FFieldQuote + Str + FFieldQuote;
       end;
     Result := Result + Str + FDelimiter;
   end;
   p := Length(Result);
-  while (p > 0) and (Result[p] = FDelimiter) do
+   //should we? How do you define empty fields? the last delimiter must be deleted based on the RFC
+   // but the rest why?
+  if Result[p] = FDelimiter then SetLength(Result,p-1);
+{  while (p > 0) and (Result[p] = FDelimiter) do
   begin
     System.Delete(Result, p, 1);
     Dec(p);
-  end;
+  end;}
 end;
 
 procedure TSdfDataSet.SetDelimiter(Value : Char);
@@ -1074,6 +1359,19 @@
   FDelimiter := Value;
 end;
 
+procedure TSdfDataSet.SetTrimLeadingSpaces(AValue: Boolean);
+begin
+  if FTrimLeadingSpaces=AValue then Exit;
+  FTrimLeadingSpaces:=AValue;
+end;
+
+procedure TSdfDataSet.SetTrimSpace(AValue: Boolean);
+begin
+  if FTrimSpace=AValue then Exit;
+  FTrimSpace:=AValue;
+end;
+
+
 procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
 begin
   CheckInactive;
@@ -1084,6 +1382,19 @@
 procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
 begin
   FFMultiLine:=Value;
+end;
+
+procedure TSdfDataSet.SetFieldQuote(AValue: Char);
+begin
+  if FFieldQuote=AValue then Exit;
+  FFieldQuote:=AValue;
+  FData.QuoteChar:=FFieldQuote;
+end;
+
+procedure TSdfDataSet.SetAlwaysDeQuote(AValue: Boolean);
+begin
+  if FAlwaysDeQuote=AValue then Exit;
+  FAlwaysDeQuote:=AValue;
 end;
 
 
sdfdata.pp.patch (29,509 bytes)   

2012-09-25 20:58

 

sdfdata.pp (47,258 bytes)   
unit SdfData;

{$mode objfpc}
{$h+}
//-----------------------------------------------------------------------------
{ Unit Name  : SdfData  Application : TSdfDataSet TFixedFormatDataSet Components
  Version    : 2.05
  Author     : Orlando Arrocha           email: oarrocha@hotmail.com
  Purpose    : These components are designed to access directly text files as
               database tables. The files may be limited (SDF) or fixed size
               columns.
---------------
Modifications
---------------
24/SEP/2012 JKOZ :
      Added Property AlwaysDeQuote when true the quotes inside a field's
      data will always be removed regardless of there position when false they
      will be removed only if the first character of the data is the FFieldQuote
      character, default behavior is false.
22/SEP/2012 JKOZ :
      Rewrote the Field Parser in the StoreToBuf method to allow it to recognise
      the quoted data in a fields value better. As of now when a FFieldQuote
      character is found in  the Field's value the parser will try to dermine the
      end of the quoted value if for any reason the parser reaches the end of the record
      while inside a quoted value it will assume that the character that started the
      quoted value parser was not quote and will revert to non quoted values
      until the end of the field's data parsing, stoping in the first delimiter
      character or crlf or the end of record only. This meens that certain parts
      of a field's data will be double parsed.
      When a quoted value has found inside a field's data value the dequoter is now
      removing only the quotes from the quoted portion of the data preserving the
      extra data outside the quotes as proper data.
      Added TrimLeadingSpaces and TrimTrailingspaces properties to allow the user
      to decide what to do with those spaces.
      Changed the internal representation of empty space in a record from #32 to #1
      this gave me the ability to distinguise between spaces the user entered and
      must be kept and empty record space which is always trimed.

19/Sep/2012 JKOZ :
      Changed the behavior of schema line now if the schema is empty and the
        fieldDefs collection has items, those items are used to create a schema.
      The logic of field size calculation has been changed to a Datatype depended method
        to allow us to keep the fielddefs and not lose the data type information
        and the validation that comes with it (to be implemented).
      RecordCount behavior changed, now it does not count the schema line in the records.

15/Sep/2012 JKOZ :
      Default Value declaration of a property and the value assigned to
      that property's field in the constructor must be the same. This
      solves a bug where AllowMultiLine could only be set from code.
      Subclass TStringList and make it aware of quotes and quoted text;
      Override SetTextStr and change the parser to walk through quoted fields.
      Change FData type From TstringList to TSDFStringList.
      Read support for multiline fields.
7/Jun/12 Reinier Olislagers aka BigChimp:
      Quote fields with delimiters or quotes to match Delphi SDF definition
      (see e.g. help on TStrings.CommaText)
14/Jul/11 Reinier Olislagers aka BigChimp:
      Added AllowMultiLine property so user can use fields that have line endings
      (Carriage Return and/or Line Feed) embedded in their fields (fields need to be
      quoted). For now: output only (reading these fields does not work yet)
12/Mar/04  Lazarus version (Sergey Smirnov AKA SSY)
      Locate and CheckString functions are removed because of Variant data type.
      Many things are changed for FPC/Lazarus compatibility.
02/Jun/02  Version 2.05 (Doriano Biondelli)
      TrimSpace property added for those cases where you need to retrieve the
      field with spaces.
01/Jan/02  Version 2.04 (Orlando Arrocha)
      FieldList is now populated.
      Locate was changed to improve speed and some bug fixing too. Thanks for
         asking and testing Marcelo Castro
16/Dec/01  Version 2.03 (Orlando Arrocha)
           Fixed some bugs and added some recomentdations. Here is a list:
      Quotations on the last field was not removed properly. Special thanks to
         Daniel Nakasone for helping with the solution.
      Appending first record to empty files was failing. Thanks again Daniel
         Nakasone for the report
      GetFieldData now trims the trailing spaces of the field, so users doesn't
         needs to do it by themselves anymore. Thanks for the recomendation
         Juergen Gehrke.
      FieldDefs is now available from the designer. Recomended by Leslie Drewery.
                ****** THANKS TO ALL & KEEP SENDING RECOMENDATIONS *****
05/Oct/01  Version 2.02 (Ben Hay)
      Locate function : implement the virtual tdataset method "Locate".
                ****** THANKS BEN *****
11/Sep/01  Version 2.01 (Leslie Drewery)
           Added additional logic to handle Corrupt Data by making sure the
           Quotes are closed and the delimiter/<CR>/<LF> are the next
           characters.
           Altered buffer method to create on constructor and cleared when opened.
      New Resource File. Nice Icons
      SavetoStream method included
      LoadFromStream method included
                ****** THANKS LESLIE *****
14/Ago/01  Version 2.00 (Orlando Arrocha)
           John Dung Nguyen showed me how to make this compatible with C-Builder
           and encouraged me to include a filter.
           Dimitry V. Borko says that russian CSV files used other delimiters,
           so now you can change it.
      OnFilter and other events included.
      Delimiter property added to TSdfDataSet. No more dependency on CommaText
         methodology -- choose your own delimiter.
      BufToStore/StoreToBuf methods lets you translate data records to and from
         your propietary storage format.
      TTextDataSet removed dependencies.
      TBaseTextDataSet class removed. // TBaseTextDataSet = TFixedFormatDataSet;
                ****** THANKS JOHN ******   ***** THANKS DIMMY *****
19/Jul/01  Version 1.03 (Orlando Arrocha)
      TBaseTextDataSet class introduced.
      FileName property changed datatype to TFileName and removed the property
         editor to segregate design-time code from runtime units.
      *** To add file browsing functionality please install
      *** TFileNamePropertyEditor -- also freeware.
                                     ********** THANKS WAYNE *********
18/Jun/01  Version 1.02 (Wayne Brantley)
      Schema replaces SchemaFileName property. Same as SchemaFileName, except
         you can define the schema inside the component. If you still need an
         external file, just use Schema.LoadFromFile()
      TFixedFormatDataSet class introduced. Use this class for a Fixed length
         format file (instead of delimited). The full schema definition
         (including lengths) is obviously required.
      Bug Fixed - When FirstLineSchema is true and there were no records, it
         would display garbage.

30/Mar/01  Version 1.01 (Orlando Arrocha)
           Ligia Maria Pimentel suggested to use the first line of the file to
           define the field names.  ****** THANKS LIGIA ******
      FileMustExist property. You must put this property to FALSE if you want to
         create a new file.
      FirstLineSchema property. You can define the field names on the first line
         of your file. Fields have to be defined with this format
            <field_name1> [= field_size1] , <field_name2> [= field_size2] ...
      SchemaFileName property.  (Changed to Schema by 1.02 Wayne)
         Lets you define the fields attributes (only supports field name and
         size). Have to be defined in this format (one field per line) :
            <field_name> [= field_size]
         NOTE: fields that doesn't define the length get the record size.
      RemoveBlankRecords procedure. Removes all the blank records from the file.
      RemoveExtraColumns procedure. If the file have more columns than the
         scheme or the field definition at design time, it remove the extra
         values from the file.
      SaveFileAs. Let you save the file to another filename.
         NOTE: This component save changes on closing the table, so you can use
               this to save data before that event.
Jan 2001 Version 1.0 TSdfDataSet introduced.
---------
TERMS
---------
 This component is provided AS-IS without any warranty of any kind, either
 express or implied. This component is freeware and can be used in any software
 product. Credits on applications will be welcomed.
 If you find it useful, improve it or have a wish list... please drop me a mail,
 I'll be glad to hear your comments.
----------------
How to Install
----------------
 1. Copy this SDFDATA.PAS and the associated SDFDATA.DCR to the folder from
    where you wish to install the component. This will probably be $(DELPHI)\lib
    or a sub-folder.
 2. Install the TSdfDataSet and TFixedFormatDataSet components by choosing the
    Component | Install Component menu option.
 3. Select the "Into exisiting package" page of the Install Components dialogue.
 4. Browse to the folder where you saved this file and select it.
 5. Ensure that the "Package file name" edit box contains $(DELPHI)\DCLUSR??.DPK
    or the one you prefer for DB related objects.
 6. Accept that the package will be rebuilt.
}
//-----------------------------------------------------------------------------
interface
uses
  DB, Classes, SysUtils, DBConst;

const  //MAX number of characters required to store a value in a text.
  SDFMaxIntLength       = 11;
  SDFMaxInt64Length     = 20;
  SDFMaxCurrencyLength  = 21;
  SDFMaxExtendedLength  = 50; //random chosen number.
  SDFMaxBooleanLength   = 4;
  SDFMaxInt16Length     = 6;
  SDFMaxInt8Length      = 4;
  SDFMaxDateLength      = 10;
  SDFMaxTimeLength      = 12;
  SDFMaxTimeStampLength = 30; //random chosen number.
  SDFMaxDateTimeLength  = 24;
  SDFMaxGUIDLength      = 38;

type
//-----------------------------------------------------------------------------
// TSDFStringList
  TSDFStringList = Class(TStringList)
  private
  protected
    procedure SetTextStr(const Value: string); override;
  public
    constructor Create;
  end;
//-----------------------------------------------------------------------------
// TRecInfo
  PRecInfo = ^TRecInfo;
  TRecInfo = packed record
    RecordNumber: PtrInt;
    BookmarkFlag: TBookmarkFlag;
  end;
//-----------------------------------------------------------------------------
// TBaseTextDataSet
  TFixedFormatDataSet = class(TDataSet)
  private
    FSchema             :TStringList;
    FFileName           :TFileName;
    FFilterBuffer       :TRecordBuffer;
    FFileMustExist      :Boolean;
    FReadOnly           :Boolean;
    FLoadfromStream     :Boolean;
    FTrimSpace          :Boolean;
    procedure SetSchema(const Value: TStringList);
    procedure SetFileName(Value : TFileName);
    procedure SetFileMustExist(Value : Boolean);
    procedure SetTrimSpace(Value : Boolean);
    procedure SetReadOnly(Value : Boolean);
    procedure RemoveWhiteLines(List : TStrings; IsFileRecord : Boolean);
    procedure LoadFieldScheme(List : TStrings; MaxSize : Integer);
    function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
    procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
  protected
    FData               : TSDFStringList;
    FCurRec             : Integer;
    FRecBufSize         : Integer;
    FRecordSize         : Integer;
    FLastBookmark       : PtrInt;
    FRecInfoOfs         : Integer;
    FBookmarkOfs        : Integer;
    FSaveChanges        : Boolean;
    FDefaultRecordLength: Cardinal;
    FDataOffset         : Integer;
  protected
    function AllocRecordBuffer: TRecordBuffer; override;
    procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(ABookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: TRecordBuffer); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalEdit; override;
    procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
    function IsCursorOpen: Boolean; override;
    procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;

    procedure SetFieldData(Field: TField; Buffer: Pointer); override;

    procedure ClearCalcFields(Buffer: TRecordBuffer); override;
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    function GetCanModify: boolean; override;
    function TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
    function RecordFilter(RecBuf: Pointer; ARecNo: Integer): Boolean;
    function BufToStore(Buffer: TRecordBuffer): String; virtual;
    function StoreToBuf(Source: String): String; virtual;
  public
    property DefaultRecordLength: Cardinal read FDefaultRecordLength
      write FDefaultRecordLength default 250;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function  GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    procedure RemoveBlankRecords; dynamic;
    procedure RemoveExtraColumns; dynamic;
    procedure SaveFileAs(strFileName : String); dynamic;
    property  CanModify;
    procedure LoadFromStream(Stream :TStream);
    procedure SavetoStream(Stream :TStream);
  published
    property FileMustExist: Boolean read FFileMustExist write SetFileMustExist;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
    property FileName : TFileName read FFileName write SetFileName;
    property Schema: TStringList read FSchema write SetSchema;
    property TrimSpace: Boolean read FTrimSpace write SetTrimSpace default True;
    property FieldDefs;
    property Active;
    property AutoCalcFields;
    property Filtered;
    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 BeforeRefresh;
//    property AfterRefresh;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  end;

//-----------------------------------------------------------------------------
// TSdfDataSet
  TSdfDataSet = class(TFixedFormatDataSet)
  private
    FAlwaysDeQuote: Boolean;
    FDelimiter          : Char;
    FFieldQuote         : Char;
    FFirstLineAsSchema  : Boolean;
    FFMultiLine         : Boolean;
    FTrimLeadingSpaces  : Boolean;
    procedure SetAlwaysDeQuote(AValue: Boolean);
    procedure SetFieldQuote(AValue: Char);
    procedure SetMultiLine(const Value: Boolean);
    procedure SetFirstLineAsSchema(Value : Boolean);
    procedure SetDelimiter(Value : Char);
    procedure SetTrimLeadingSpaces(AValue: Boolean);
    procedure SetTrimSpace(AValue: Boolean);
  protected
    procedure InternalInitFieldDefs; override;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
             : TGetResult; override;
    function BufToStore(Buffer: TRecordBuffer): String; override;
    function StoreToBuf(Source: String): String; override;
    function GetRecordCount: Integer; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default False; //Whether or not to allow fields containing CR and/or LF
    property Delimiter: Char read FDelimiter write SetDelimiter;
    property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
    property FieldQuote : Char read FFieldQuote write SetFieldQuote default #34;
    property TrimLeadingSpaces  : Boolean read FTrimLeadingSpaces write SetTrimLeadingSpaces default False;
    property TrimTrailingSpaces : Boolean read FTrimSpace write SetTrimSpace default False;
    property AlwaysDeQuote      : Boolean read FAlwaysDeQuote write SetAlwaysDeQuote default False;
  end;
procedure Register;

implementation
//{$R *.Res}

{ TSDFStringList }
const
  DefaultFieldQuote : Char = '"';
  WhiteSpace = [#0..#31];

function InternalTrim(const S: string; TrimLeadSpace,TrimTrailSpace:boolean): string;
var Ofs, Len: integer;
    WhiteChars : set of Char;
begin
  len := Length(S);
  if TrimTrailSpace then WhiteChars:=WhiteSpace+[#32] else WhiteChars := WhiteSpace;
  while (Len>0) and (S[Len] in WhiteChars) do
   dec(Len);
  Ofs := 1;
  if TrimLeadSpace then WhiteChars:=WhiteSpace+[#32] else WhiteChars := WhiteSpace;
  while (Ofs<=Len) and (S[Ofs] in WhiteSpace) do
   Inc(Ofs);
  Result := Copy(S, Ofs, 1 + Len - Ofs);
end ;
procedure TSDFStringList.SetTextStr(const Value: string);
  //JKOZ ENH_1 15/9/2012 5:10:44  copied here from stringl.inc I have no desire to reinvent the wheel.
  Function GetNextLine (Const Value : String; Var S : String; Var P : Integer; aQuoteChar:Char=#0) : Boolean;
  Var
    PS : PChar;
    IP,L : Integer;
    InQuote:Boolean;
  begin
    L:=Length(Value);
    S:='';
    Result:=False;
    If ((L-P)<0) then
      exit;
    if ((L-P)=0) and (not (value[P] in [#10,#13])) Then
      Begin
        S:=Value[P];
        Inc(P);
        Exit(True);
      End;
    PS:=PChar(Value)+P-1;
    IP:=P;
    InQuote := False;
    While ((L-P)>=0) and ((not (PS^ in [#10,#13])) or InQuote ) do
      begin
      if (aQuoteChar <> #0) and (PS^ = aQuoteChar) then InQuote := not InQuote; //JKOZ ENH_1 Inquote check.
      P:=P+1;
      Inc(PS);
      end;
    SetLength (S,P-IP);
    System.Move (Value[IP],Pointer(S)^,P-IP);
    If (P<=L) and (Value[P]=#13) then
      Inc(P);
    If (P<=L) and (Value[P]=#10) then
      Inc(P); // Point to character after #10(#13)
    Result:=True;
  end;
Var
  S : String;
  P : Integer;
begin
  Try
    BeginUpdate;
    Clear;
    P:=1;
    While GetNextLine (Value,S,P, QuoteChar) do
      Add(S);
  finally
    EndUpdate;
  end;
end;

constructor TSDFStringList.Create;
begin
  inherited Create;
  QuoteChar := #0;
end;

function FieldDefSize(aFieldDef:TFieldDef; DefaultSize:Integer):integer;inline;
begin
  case aFieldDef.DataType of
    ftFixedChar,
    ftFixedWideChar,
    ftWideString,
    ftMemo,
    ftWideMemo,
    ftFmtMemo,
    ftString      : Result := aFieldDef.Size;
    ftInteger     : result := SDFMaxIntLength;
    ftCurrency    : Result := SDFMaxCurrencyLength;
    ftBoolean     : Result := SDFMaxBooleanLength; //yes/no/true/false
    ftLargeint,
    ftAutoInc     : Result := SDFMaxInt64Length;
    ftWord,                        //65535
    ftSmallint    : result := SDFMaxInt16Length;  //-32768..32767
    ftDate        : Result := SDFMaxDateLength; //YYYY/MM/DD
    ftDateTime    : result := SDFMaxDateTimeLength; //YYYY/MM/DD HH:MM:SS:nnn
    ftTime        : Result := SDFMaxTimeLength; //HH:MM:SS:nnn
    ftTimeStamp   : Result := SDFMaxTimeStampLength; //random number needs to be verified.
    ftBlob,
    ftOraBlob,
    ftOraClob     : Result := aFieldDef.Size*2;//u64 encoding requires 2 chars per byte.
    ftBCD,
    ftFloat,
    ftFMTBcd      : Result := SDFMaxExtendedLength; //random number.
    ftGuid        : Result := SDFMaxGUIDLength;
  else
    Result := DefaultSize;
  end;
end;
//-----------------------------------------------------------------------------
// TFixedFormatDataSet
//-----------------------------------------------------------------------------
constructor TFixedFormatDataSet.Create(AOwner : TComponent);
begin
  FDefaultRecordLength := 250;
  FFileMustExist       := TRUE;
  FLoadfromStream      := False;//?????
  FRecordSize          := 0;
  FTrimSpace           := TRUE;
  FSchema              := TStringList.Create;
  FData                := TSDFStringList.Create;  // Load the textfile into a stringlist
  inherited Create(AOwner);
end;

destructor TFixedFormatDataSet.Destroy;
begin
  inherited Destroy;
  FData.Free;
  FSchema.Free;
end;

procedure TFixedFormatDataSet.SetSchema(const Value: TStringList);
begin
  CheckInactive;
  FSchema.Assign(Value);
end;

procedure TFixedFormatDataSet.SetFileMustExist(Value : Boolean);
begin
  CheckInactive;
  FFileMustExist := Value;
end;

procedure TFixedFormatDataSet.SetTrimSpace(Value : Boolean);
begin
  CheckInactive;
  FTrimSpace := Value;
end;

procedure TFixedFormatDataSet.SetReadOnly(Value : Boolean);
begin
  CheckInactive;
  FReadOnly := Value;
end;

procedure TFixedFormatDataSet.SetFileName(Value : TFileName);
begin
  CheckInactive;
  FFileName := Value;
end;

procedure TFixedFormatDataSet.InternalInitFieldDefs;
var
  i, len, Maxlen :Integer;
  LstFields      :TStrings;
begin
  if not Assigned(FData) then
    exit;
  FRecordSize := 0;
  Maxlen := 0;
  //FieldDefs.Clear; //JKOZ : use fieldDefs to allow for design time schema definition.
  for i := FData.Count - 1 downto 0 do  // Find out the longest record
  begin
    len := Length(FData[i]);
    if len > Maxlen then
      Maxlen := len;
    FData.Objects[i] := TObject(Pointer(i+1));   // Fabricate Bookmarks
  end;
  if (Maxlen = 0) or (FData.Count < 2) then
    Maxlen := FDefaultRecordLength;
  LstFields := TStringList.Create;
  try
    LoadFieldScheme(LstFields, Maxlen);
    FieldDefs.Clear; //JKOZ : Both datasets depend on the Field.size property to allocate memory.
                     //       This is a patch it converts everything to string loosing
                     //       all forms of validation.
    for i := 0 to LstFields.Count -1 do  // Add fields
    begin
      len := StrToIntDef(LstFields.Values[LstFields.Names[i]], Maxlen);
      FieldDefs.Add(Trim(LstFields.Names[i]), ftString, len, False);
      Inc(FRecordSize, len);
    end;
  finally
    LstFields.Free;
  end;
end;

procedure TFixedFormatDataSet.InternalOpen;
var
  Stream : TStream;
begin
  FCurRec := -1;
  FSaveChanges := FALSE;
  if not Assigned(FData) then
    FData := TSDFStringList.Create;
  if (not FileMustExist) and (not FileExists(FileName)) then
  begin
    Stream := TFileStream.Create(FileName, fmCreate);
    Stream.Free;
  end;
  if not FLoadfromStream then
    FData.LoadFromFile(FileName);
  FRecordSize := FDefaultRecordLength;
  InternalInitFieldDefs;
  if DefaultFields then
    CreateFields;
  BindFields(TRUE);
  if FRecordSize = 0 then
    FRecordSize := FDefaultRecordLength;
  BookmarkSize := SizeOf(PtrInt);
  FRecInfoOfs := FRecordSize + CalcFieldsSize; // Initialize the offset for TRecInfo in the buffer
  FBookmarkOfs := FRecInfoOfs + SizeOf(TRecInfo);
  FRecBufSize := FBookmarkOfs + BookmarkSize;
  FLastBookmark := FData.Count;
end;

procedure TFixedFormatDataSet.InternalClose;
begin
  if (not FReadOnly) and (FSaveChanges) then  // Write any edits to disk
    FData.SaveToFile(FileName);
  FLoadfromStream := False;
  FData.Clear;
  BindFields(FALSE);
  if DefaultFields then // Destroy the TField
    DestroyFields;
  FCurRec := -1;        // Reset these internal flags
  FLastBookmark := 0;
  FRecordSize := 0;
end;

function TFixedFormatDataSet.IsCursorOpen: Boolean;
begin
  Result := Assigned(FData) and (FRecordSize > 0);
end;

procedure TFixedFormatDataSet.InternalHandleException;
begin
{$ifndef fpc}
   Application.HandleException(Self);
{$else}
  inherited;
{$endif}
end;

// Loads Data from a stream.
procedure TFixedFormatDataSet.LoadFromStream(Stream: TStream);
begin
  if assigned(stream) then
  begin
    Active          := False; //Make sure the Dataset is Closed.
    Stream.Position := 0;     //Make sure you are at the top of the Stream. //JKOZ raise exception.Create('stream is not a file can't move to start');
    FLoadfromStream := True;
    if not Assigned(FData) then
     raise Exception.Create('Data buffer unassigned');
    FData.LoadFromStream(Stream);
    Active := True;
  end
  else
    raise exception.Create('Invalid Stream Assigned (Load From Stream');
end;

// Saves Data as text to a stream.
procedure TFixedFormatDataSet.SavetoStream(Stream: TStream);
begin
  if assigned(stream) then
    FData.SaveToStream(Stream)
  else
    raise exception.Create('Invalid Stream Assigned (Save To Stream'); //
end;

// Record Functions
function TFixedFormatDataSet.AllocRecordBuffer: TRecordBuffer;
begin
  if FRecBufSize > 0 then
    Result := AllocMem(FRecBufSize)
  else
    Result := nil;
end;

procedure TFixedFormatDataSet.FreeRecordBuffer(var Buffer: TRecordBuffer);
begin
  if Buffer <> nil then
    FreeMem(Buffer);
end;

procedure TFixedFormatDataSet.InternalInitRecord(Buffer: TRecordBuffer);
begin
  FillChar(Buffer[0], FRecordSize, 0);
end;

procedure TFixedFormatDataSet.ClearCalcFields(Buffer: TRecordBuffer);
begin
  FillChar(Buffer[RecordSize], CalcFieldsSize, 0);
end;

function TFixedFormatDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
begin
  if (FData.Count < (1+FDataOffset)) then
    Result := grEOF
  else
    Result := TxtGetRecord(Buffer, GetMode);
  if Result = grOK then
  begin
    if (CalcFieldsSize > 0) then
      GetCalcFields(Buffer);
    with PRecInfo(Buffer + FRecInfoOfs)^ do
    begin
      BookmarkFlag := bfCurrent;
      RecordNumber := PtrInt(FData.Objects[FCurRec]);
    end;
  end
  else
    if (Result = grError) and DoCheck then
      DatabaseError('No Records');
end;

function TFixedFormatDataSet.GetRecordCount: Integer;
begin
  Result := FData.Count;
end;

function TFixedFormatDataSet.GetRecNo: Integer;
var
  BufPtr: TRecordBuffer;
begin
  Result := -1;
  if GetActiveRecBuf(BufPtr) then
    Result := PRecInfo(BufPtr + FRecInfoOfs)^.RecordNumber;
end;

procedure TFixedFormatDataSet.SetRecNo(Value: Integer);
begin
  CheckBrowseMode;
  if (Value >= 0) and (Value < FData.Count) and (Value <> RecNo) then
  begin
    DoBeforeScroll;
    FCurRec := Value - 1;
    Resync([]);
    DoAfterScroll;
  end;
end;

function TFixedFormatDataSet.GetRecordSize: Word;
begin
  Result := FRecordSize;
end;

function TFixedFormatDataSet.GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
begin
  case State of
    dsBrowse: if IsEmpty then RecBuf := nil else RecBuf := ActiveBuffer;
    dsEdit, dsInsert: RecBuf := ActiveBuffer;
    dsCalcFields: RecBuf := CalcBuffer;
    dsFilter: RecBuf := FFilterBuffer;
  else
    RecBuf := nil;
  end;
  Result := RecBuf <> nil;
end;

function TFixedFormatDataSet.TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
var
  Accepted : Boolean;
  Temp     : string;
begin
  Result := grOK;
  repeat
    Accepted := TRUE;
    case GetMode of
      gmNext:
        if FCurRec >= FData.Count{RecordCount} - 1  then
          Result := grEOF
        else
          Inc(FCurRec);
      gmPrior:
        if FCurRec <= FDataOffset then
          Result := grBOF
        else
          Dec(FCurRec);
      gmCurrent:
        if (FCurRec < FDataOffset) or (FCurRec >= FData.Count{RecordCount}) then
          Result := grError;
    end;
    if (Result = grOk) then
    begin
      Temp:=StoreToBuf(FData[FCurRec]);
      Move(Temp[1], Buffer[0], FRecordSize);
      if Filtered then
      begin
        Accepted := RecordFilter(Buffer, FCurRec +1);
        if not Accepted and (GetMode = gmCurrent) then
          Inc(FCurRec);
      end;
    end;
  until Accepted;
end;

function TFixedFormatDataSet.RecordFilter(RecBuf: Pointer; ARecNo: Integer): Boolean;
var
  Accept: Boolean;
  SaveState: TDataSetState;
begin                          // Returns true if accepted in the filter
  SaveState := SetTempState(dsFilter);
  FFilterBuffer := RecBuf;
  PRecInfo(FFilterBuffer + FRecInfoOfs)^.RecordNumber := ARecNo;
  Accept := TRUE;
  if Accept and Assigned(OnFilterRecord) then
    OnFilterRecord(Self, Accept);
  RestoreState(SaveState);
  Result := Accept;
end;

function TFixedFormatDataSet.GetCanModify: boolean;
begin
  Result := not FReadOnly;
end;

// Field Related
procedure TFixedFormatDataSet.LoadFieldScheme(List : TStrings; MaxSize : Integer);
var
  tmpFieldName : string;
  tmpSchema : TStrings;
  i : Integer;
begin
  tmpSchema := TStringList.Create;
  try       // Load Schema Structure
    if (Schema.Count > 0) then
    begin
      tmpSchema.Assign(Schema);
      RemoveWhiteLines(tmpSchema, FALSE);
    end
    else begin//jkoz : use existing fieldDefs to create a Schema.
      if FieldDefs.Count > 0 then begin
        for i := 0 to FieldDefs.Count -1 do begin
          tmpFieldName := Format('%s=%d', [FieldDefs[i].Name, FieldDefSize(FieldDefs[i],MaxSize)]);
          tmpSchema.Add(tmpFieldName);
        end;
      end else tmpSchema.Add('Line');
    end;
    for i := 0 to tmpSchema.Count -1 do // Interpret Schema
    begin
      tmpFieldName := tmpSchema.Names[i];
      if (tmpFieldName = '') then
        tmpFieldName := Format('%s=%d', [tmpSchema[i], MaxSize])
      else
        tmpFieldName := tmpSchema[i];
      List.Add(tmpFieldName);
    end;
  finally
    tmpSchema.Free;
  end;
end;

function TFixedFormatDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  TempPos, recbuf : PChar;
  WhiteSpace : set of char = [#1..#31];
begin
  Result := GetActiveRecBuf(TRecordBuffer(RecBuf));
  if Result then
  begin
    if Field.FieldNo > 0 then
    begin
      TempPos := RecBuf;
      SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
      Result := (RecBuf < StrEnd(TempPos));
    end
    else
      if (State in [dsBrowse, dsEdit, dsInsert, dsCalcFields]) then
      begin
        Inc(RecBuf, FRecordSize + Field.Offset);
        Result := Boolean(Byte(RecBuf[0]));
      end;
  end;
  if Result and (Buffer <> nil) then
  begin
    StrLCopy(Buffer, RecBuf, Field.Size);
    if FTrimSpace then WhiteSpace:=WhiteSpace+[#32];
    TempPos := StrEnd(Buffer);
    repeat
      Dec(TempPos);
      if (TempPos[0] in WhiteSpace) then
        TempPos[0]:= #0
      else
        break;
    until (TempPos = Buffer);
  end;
end;

procedure TFixedFormatDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var
  RecBuf: PChar;
  BufEnd: PChar;
  p : Integer;
begin
  if not (State in dsWriteModes) then
    DatabaseError(SNotEditing, Self);
  GetActiveRecBuf(TRecordBuffer(RecBuf));
  if Field.FieldNo > 0 then
  begin
    if State = dsCalcFields then
      DatabaseError('Dataset not in edit or insert mode', Self);
    if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
      DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
    if State in [dsEdit, dsInsert, dsNewValue] then
      Field.Validate(Buffer);
    if Field.FieldKind <> fkInternalCalc then
    begin
      SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
      BufEnd := StrEnd(pansichar(ActiveBuffer));  // Fill with blanks when necessary
      if BufEnd > RecBuf then
        BufEnd := RecBuf;
      FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), #1);
      p := StrLen(Buffer);
      if p > Field.Size then
        p := Field.Size;
      Move(Buffer^, RecBuf[0], p);
    end;
  end
  else // fkCalculated, fkLookup
  begin
    Inc(RecBuf, FRecordSize + Field.Offset);
    Move(Buffer^, RecBuf[0], Field.Size);
  end;
  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
    DataEvent(deFieldChange, Ptrint(Field));
end;

procedure TFixedFormatDataSet.SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
var
  i : Integer;
begin
  i := 1;
  while (i < FieldNo) and (i < FieldDefs.Count) do
  begin
    Inc(Buffer, FieldDefs.Items[i-1].Size);
    Inc(i);
  end;
end;

// Navigation / Editing
procedure TFixedFormatDataSet.InternalFirst;
begin
  FCurRec := -1;
end;

procedure TFixedFormatDataSet.InternalLast;
begin
  FCurRec := FData.Count;
end;

procedure TFixedFormatDataSet.InternalPost;
begin
  FSaveChanges := TRUE;
  inherited UpdateRecord;
  if (State = dsEdit) then // just update the data in the string list
  begin
    FData[FCurRec] := BufToStore(ActiveBuffer);
  end
  else
    InternalAddRecord(ActiveBuffer, FALSE);
end;

procedure TFixedFormatDataSet.InternalEdit;
begin

end;

procedure TFixedFormatDataSet.InternalDelete;
begin
  FSaveChanges := TRUE;
  FData.Delete(FCurRec);
  if FCurRec >= FData.Count then
    Dec(FCurRec);
end;

procedure TFixedFormatDataSet.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
begin
  FSaveChanges := TRUE;
  Inc(FLastBookmark);
  if DoAppend then
    InternalLast;
  if (FCurRec >=0) then
    FData.InsertObject(FCurRec, BufToStore(Buffer), TObject(Pointer(FLastBookmark)))
  else
    FData.AddObject(BufToStore(Buffer), TObject(Pointer(FLastBookmark)));
end;

procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
var
  Index: Integer;
begin
  Index := FData.IndexOfObject(TObject(PPtrInt(ABookmark)^));
  if Index <> -1 then
    FCurRec := Index
  else
    DatabaseError('Bookmark not found');
end;

procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
begin
  if (State <> dsInsert) then
    InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs)^.RecordNumber);
end;

function TFixedFormatDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
  Result := PRecInfo(Buffer + FRecInfoOfs)^.BookmarkFlag;
end;

procedure TFixedFormatDataSet.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
  PRecInfo(Buffer + FRecInfoOfs)^.BookmarkFlag := Value;
end;

procedure TFixedFormatDataSet.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
  Move(Buffer[FRecInfoOfs], Data^, BookmarkSize);
end;

procedure TFixedFormatDataSet.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
  Move(Data^, Buffer[FRecInfoOfs], BookmarkSize);
end;

procedure TFixedFormatDataSet.RemoveWhiteLines(List : TStrings; IsFileRecord : Boolean);
var
  i : integer;
begin
  for i := List.Count -1 downto 0 do
  begin
    if (Trim(List[i]) = '' ) then
      if IsFileRecord then
      begin
        FCurRec := i;
        InternalDelete;
      end
      else
        List.Delete(i);
  end;
end;

procedure TFixedFormatDataSet.RemoveBlankRecords;
begin
  RemoveWhiteLines(FData, TRUE);
end;

procedure TFixedFormatDataSet.RemoveExtraColumns;
var
  i : Integer;
begin
  for i := FData.Count -1 downto 0 do
    FData[i] := BufToStore(trecordbuffer(StoreToBuf(FData[i])));
  FData.SaveToFile(FileName);
end;

procedure TFixedFormatDataSet.SaveFileAs(strFileName : String);
begin
  FData.SaveToFile(strFileName);
  FFileName := strFileName;
  FSaveChanges := FALSE;
end;

function TFixedFormatDataSet.StoreToBuf(Source: String): String;
begin
  Result := Source;
end;

function TFixedFormatDataSet.BufToStore(Buffer: TRecordBuffer): String;
begin
  Result := Copy(pansichar(Buffer), 1, FRecordSize);
end;

//-----------------------------------------------------------------------------
// TSdfDataSet
//-----------------------------------------------------------------------------
constructor TSdfDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDelimiter := ',';
  FFirstLineAsSchema := FALSE;
  FFieldQuote        := #34; //"
  FData.QuoteChar    := FFieldQuote;
  FTrimLeadingSpaces := False;
  FTrimSpace         := False;
  FAlwaysDeQuote     := False;
end;

procedure TSdfDataSet.InternalInitFieldDefs;
var
  pStart, pEnd, len : Integer;
begin
  if not IsCursorOpen then
    exit;
  if (FData.Count = 0) and (Schema.Count > 0) and FirstLineAsSchema then
  begin
    Schema.Delimiter := Delimiter;
    FData.Append(Schema.DelimitedText);
  end
  else if (FData.Count = 0) or (Trim(FData[0]) = '') then
    begin
    FirstLineAsSchema := FALSE;
    FDataOffset:=0;
    end
  else if (Schema.Count = 0) or (FirstLineAsSchema) then
  begin
    Schema.Clear;
    len := Length(FData[0]);
    pEnd := 1;
    repeat
      while (pEnd <= len) and (FData[0][pEnd] in [#1..' ']) do
        Inc(pEnd);

      if (pEnd > len) then
        break;

      pStart := pEnd;

      if (FData[0][pStart] = '"') then
       begin
        repeat
          Inc(pEnd);
        until (pEnd > len)  or (FData[0][pEnd] = '"');

        if (FData[0][pEnd] = '"') then
          Inc(pStart);
       end
      else
       while (pEnd <= len) and (FData[0][pEnd]  <> Delimiter) do
        Inc(pEnd);

      if (FirstLineAsSchema) then
       Schema.Add(Copy(FData[0], pStart, pEnd - pStart))
      else
       Schema.Add(Format('Field%d', [Schema.Count + 1]));

      if (FData[0][pEnd] = '"') then
        while (pEnd <= len) and (FData[0][pEnd] <> Delimiter) do
          Inc(pEnd);

      if (FData[0][pEnd] = Delimiter) then
          Inc(pEnd);

    until (pEnd > len);
  end;
  inherited InternalInitFieldDefs;
end;

function TSdfDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
begin
  if FirstLineAsSchema then
  begin
    if (FData.Count < 2) then
      begin
      if GetMode=gmPrior then
       Result := grBOF
      else
       Result := grEOF
      end
    else
      begin
      If (FCurRec=-1) and (GetMode=gmNext) then
        inc(FCurRec);
      Result := inherited GetRecord(Buffer, GetMode, DoCheck);
      end;
  end
  else
    Result := inherited GetRecord(Buffer, GetMode, DoCheck);
end;

function TSdfDataSet.StoreToBuf(Source: String): String;

const
 CR :char = #13;
 LF :char = #10;
var
  IsQuoted   // Whether or not field starts with a quote
                  : Boolean;
  FieldMaxSize, // Maximum fields size as defined in FieldDefs
  i,         // Field counter (0..)
  p          // Length of string in field
                  : Integer;
  pDeQuoted, // Temporary buffer for dedoubling quotes
  pRet,      // Pointer to insertion point in return value
  pStr,      // Beginning of field
  pStrEnd    // End of field
                  : PChar;
  Ret             : String;
  WhiteSpaceChars : set of Char;
  Cntr            : Integer;
  InQuote         : Boolean = False;

  IgnoreQuoteStatus : Boolean = False;
  S                 : string;

  function Buildchar(const size:integer;achar:char):string;
  begin
    result := '';
    SetLength(Result,size);
    FillChar(Result[1],size,achar);
  end;

  function Dequote:string;
  var
    InQ : boolean;
    PI  : PChar;
    Cn  : integer;
  begin
    Result:='';
    if pStr = pStrEnd then Exit;
    PI := pStr;
    InQ := False;
    repeat
      if InQ and (PI[0] = FFieldQuote) then begin
        Cn := 0;
        while (PI[0] = FFieldQuote) and (PI[0] <> PStrEnd) do begin inc(PI);INC(Cn);end;
        InQ:= (Cn mod 2)<>1;
        if Cn>1 then Result := Result+Buildchar(Cn div 2, FFieldQuote);
        Dec(PI);
      end else
        if PI[0] = FFieldQuote then InQ:= not InQ
      else Result := Result + PI[0];
      Inc(PI);
    until (PI = pStrEnd) or (PI[0] =#0);
    if not (PI[0] in [FFieldQuote,#0, FDelimiter]) then Result := Result+PI[0];// else Result := Result + ' ';
  end;

  procedure ParseToQuoteEnd;
  var
    quotecount : Integer=0;
    Back       : PChar;
  begin
    Back:= pStrEnd;
    repeat
      inc(pStrEnd);
      if pStrEnd^ = FFieldQuote then begin
        quotecount:=0;
        repeat
          inc(quotecount);
          inc(pStrEnd);
        until pStrEnd^ <> FFieldQuote;
        InQuote:= (quotecount mod 2) = 0;
        if not InQuote then Dec(pStrEnd);
      end;
    until (pStrEnd[0] in [#0,FFieldQuote]) or (not FFMultiLine and (pStrEnd[0] in[#10,#13]));
    //in case we have reached the end of string and we are still inquote then
    //reparse the field value ignoring quotes.
    if InQuote and (pStrEnd[0] <> FFieldQuote) then begin
      pStrEnd := Back;
      Inc(pStrEnd);
      IgnoreQuoteStatus:=True;
      IsQuoted:=False;
    end else begin
      IsQuoted:=True;
      Inc(pStrEnd);
    end;
  end;

  procedure ParseFieldValue;
  begin
    repeat
      if (pStrEnd[0] = '"') and (not IgnoreQuoteStatus) then InQuote := not InQuote;
      if InQuote then ParseToQuoteEnd
      else Inc(pStrEnd);
    until pStrEnd[0] in [#0, Delimiter,#13,#10];
  end;

  procedure SkipWhiteSpace;
  begin
    while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in WhiteSpaceChars) do
      Inc(pStrEnd);
  end;
  function CharReplace(var InStr:String;const OldChar,NewChar:Char):Integer;
  var
    Cntr : Integer;
  begin
    Result := 0;
    for Cntr := 1 to Length(InStr) do
      if InStr[Cntr] = oldChar then begin InStr[cntr]:=NewChar;inc(Result); end;
  end;
begin
  SetLength(Ret, FRecordSize);
  FillChar(Ret[1], FRecordSize, #1);

  PStrEnd := PChar(Source);
  pRet := PChar(Ret);

  WhiteSpaceChars := WhiteSpace;
  if FTrimLeadingSpaces then WhiteSpaceChars:=WhiteSpaceChars + [#32];

  for i := 0 to FieldDefs.Count - 1 do
  begin
    FieldMaxSize := FieldDefs[i].Size;
    IgnoreQuoteStatus := False;
    IsQuoted:=False;

    SkipWhiteSpace;
    if not Boolean(Byte(pStrEnd[0])) then
     break;    //end of string #0 has been reached.

    pStr := pStrEnd;  //field data start

    ParseFieldValue;

    p := pStrEnd - pStr; // do not include the last char be it delimeter or not
    if IsQuoted and ((pStr^ = FFieldQuote) or AlwaysDeQuote) then begin
      S:=Dequote;
      p:=Length(S);
    end else begin
      S:='';
      SetLength(S,p);
      Move(pStr[0],S[1],p);
    end;
    if (p > FieldMaxSize) then
      p := FieldMaxSize;
    Move(S[1], pRet[0], p);

    Inc(pRet, FieldMaxSize);

    if (pStrEnd[0] = Delimiter) then
     Inc(pStrEnd);

   end;

  Result := Ret;
end;

function TSdfDataSet.GetRecordCount: Integer;
begin
  Result:=inherited GetRecordCount;
  //JKOZ: it reports the schema line as a record too.
  if FFirstLineAsSchema then Dec(Result);
end;

function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
var
  Str     : String;
  p, i    : Integer;
  QuoteMe : boolean;
  iSize   : Integer;
begin
  Result := '';
  p := 1;
  for i := 0 to FieldDefs.Count - 1 do
  begin
    QuoteMe:=false;
    //Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size)); //JKOZ:New Code for size.
    iSize := FieldDefSize(FieldDefs[i], FDefaultRecordLength);
    Str := InternalTrim(Copy(PAnsiChar(Buffer), p, iSize), FTrimLeadingSpaces, FTrimSpace);
    //Inc(p, FieldDefs[i].Size); //JKOZ:New Code for size.
    Inc(p, iSize);
    if FFMultiLine then
      begin
       // If multiline enabled, quote whenever we find carriage return or linefeed
       if (not QuoteMe) and (StrScan(PChar(Str), #10) <> nil) then QuoteMe:=true;
       if (not QuoteMe) and (StrScan(PChar(Str), #13) <> nil) then QuoteMe:=true;
      end
    else
      begin
       // If we don't allow multiline, remove all CR and LF because they mess with the record ends:
       Str := StringReplace(Str, #10, '', [rfReplaceAll]);
       Str := StringReplace(Str, #13, '', [rfReplaceAll]);
      end;
    // Check for any delimiters or quotes occurring in field text  
    if (not QuoteMe) then
	  if (StrScan(PChar(Str), FDelimiter) <> nil) or
	     (StrScan(PChar(Str), FFieldQuote) <> nil) or
             (StrScan(PChar(Str), #9) <> nil) then QuoteMe:=true;
    if (QuoteMe) then
      begin
        Str := AnsiQuotedStr(Str, FFieldQuote); //JKOZ : use system procs as much as possible it will be easier to convert to newer versions.
        //Str := Stringreplace(Str, FFieldQuote, FFieldQuote+FieldQuote, [rfReplaceAll]);
        //Str := FFieldQuote + Str + FFieldQuote;
      end;
    Result := Result + Str + FDelimiter;
  end;
  p := Length(Result);
   //should we? How do you define empty fields? the last delimiter must be deleted based on the RFC
   // but the rest why?
  if Result[p] = FDelimiter then SetLength(Result,p-1);
{  while (p > 0) and (Result[p] = FDelimiter) do
  begin
    System.Delete(Result, p, 1);
    Dec(p);
  end;}
end;

procedure TSdfDataSet.SetDelimiter(Value : Char);
begin
  CheckInactive;
  FDelimiter := Value;
end;

procedure TSdfDataSet.SetTrimLeadingSpaces(AValue: Boolean);
begin
  if FTrimLeadingSpaces=AValue then Exit;
  FTrimLeadingSpaces:=AValue;
end;

procedure TSdfDataSet.SetTrimSpace(AValue: Boolean);
begin
  if FTrimSpace=AValue then Exit;
  FTrimSpace:=AValue;
end;


procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
begin
  CheckInactive;
  FFirstLineAsSchema := Value;
  FDataOffset:=Ord(FFirstLineAsSchema);
end;

procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
begin
  FFMultiLine:=Value;
end;

procedure TSdfDataSet.SetFieldQuote(AValue: Char);
begin
  if FFieldQuote=AValue then Exit;
  FFieldQuote:=AValue;
  FData.QuoteChar:=FFieldQuote;
end;

procedure TSdfDataSet.SetAlwaysDeQuote(AValue: Boolean);
begin
  if FAlwaysDeQuote=AValue then Exit;
  FAlwaysDeQuote:=AValue;
end;


//-----------------------------------------------------------------------------
// This procedure is used to register this component on the component palette
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('Data Access', [TFixedFormatDataSet]);
  RegisterComponents('Data Access', [TSdfDataSet]);
end;

end.
sdfdata.pp (47,258 bytes)   

Reinier Olislagers

2012-09-26 05:54

developer   ~0062632

Last edited: 2012-09-26 06:26

Hi John,
I assume you're aiming to support the RFC4180 CSV format - see this post on the mailing list:
http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg30087.html

It would be good to mention that in sdfdataset.pp
The files may be limited (SDF)
=>
The files may be delimited (CSV according to RFC4180)

Attached patch sdfdata_mention_csv.diff does that (to be applied after first patch)

Thanks,
Reinier

2012-09-26 06:26

 

sdfdata_mention_csv.diff (29,225 bytes)   
Index: packages/fcl-db/src/sdf/sdfdata.pp
===================================================================
--- packages/fcl-db/src/sdf/sdfdata.pp	(revision 22455)
+++ packages/fcl-db/src/sdf/sdfdata.pp	(working copy)
@@ -2,21 +2,60 @@
 
 {$mode objfpc}
 {$h+}
-
 //-----------------------------------------------------------------------------
 { Unit Name  : SdfData  Application : TSdfDataSet TFixedFormatDataSet Components
   Version    : 2.05
   Author     : Orlando Arrocha           email: oarrocha@hotmail.com
-  Purpose    : This components are designed to access directly text files as
-               database tables. The files may be limited (SDF) or fixed size
-               columns.
+  Purpose    : These components are designed to access directly text files as
+               database tables. The files may be delimited (CSV according to
+			   RFC4180) or fixed size columns.
 ---------------
 Modifications
 ---------------
-7/Jun/12 BigChimp:
+24/SEP/2012 JKOZ :
+      Added Property AlwaysDeQuote when true the quotes inside a field's
+      data will always be removed regardless of there position when false they
+      will be removed only if the first character of the data is the FFieldQuote
+      character, default behavior is false.
+22/SEP/2012 JKOZ :
+      Rewrote the Field Parser in the StoreToBuf method to allow it to recognise
+      the quoted data in a fields value better. As of now when a FFieldQuote
+      character is found in  the Field's value the parser will try to dermine the
+      end of the quoted value if for any reason the parser reaches the end of the record
+      while inside a quoted value it will assume that the character that started the
+      quoted value parser was not quote and will revert to non quoted values
+      until the end of the field's data parsing, stoping in the first delimiter
+      character or crlf or the end of record only. This meens that certain parts
+      of a field's data will be double parsed.
+      When a quoted value has found inside a field's data value the dequoter is now
+      removing only the quotes from the quoted portion of the data preserving the
+      extra data outside the quotes as proper data.
+      Added TrimLeadingSpaces and TrimTrailingspaces properties to allow the user
+      to decide what to do with those spaces.
+      Changed the internal representation of empty space in a record from #32 to #1
+      this gave me the ability to distinguise between spaces the user entered and
+      must be kept and empty record space which is always trimed.
+
+19/Sep/2012 JKOZ :
+      Changed the behavior of schema line now if the schema is empty and the
+        fieldDefs collection has items, those items are used to create a schema.
+      The logic of field size calculation has been changed to a Datatype depended method
+        to allow us to keep the fielddefs and not lose the data type information
+        and the validation that comes with it (to be implemented).
+      RecordCount behavior changed, now it does not count the schema line in the records.
+
+15/Sep/2012 JKOZ :
+      Default Value declaration of a property and the value assigned to
+      that property's field in the constructor must be the same. This
+      solves a bug where AllowMultiLine could only be set from code.
+      Subclass TStringList and make it aware of quotes and quoted text;
+      Override SetTextStr and change the parser to walk through quoted fields.
+      Change FData type From TstringList to TSDFStringList.
+      Read support for multiline fields.
+7/Jun/12 Reinier Olislagers aka BigChimp:
       Quote fields with delimiters or quotes to match Delphi SDF definition
       (see e.g. help on TStrings.CommaText)
-14/Jul/11 BigChimp:
+14/Jul/11 Reinier Olislagers aka BigChimp:
       Added AllowMultiLine property so user can use fields that have line endings
       (Carriage Return and/or Line Feed) embedded in their fields (fields need to be
       quoted). For now: output only (reading these fields does not work yet)
@@ -128,12 +167,34 @@
 }
 //-----------------------------------------------------------------------------
 interface
-
 uses
   DB, Classes, SysUtils, DBConst;
 
+const  //MAX number of characters required to store a value in a text.
+  SDFMaxIntLength       = 11;
+  SDFMaxInt64Length     = 20;
+  SDFMaxCurrencyLength  = 21;
+  SDFMaxExtendedLength  = 50; //random chosen number.
+  SDFMaxBooleanLength   = 4;
+  SDFMaxInt16Length     = 6;
+  SDFMaxInt8Length      = 4;
+  SDFMaxDateLength      = 10;
+  SDFMaxTimeLength      = 12;
+  SDFMaxTimeStampLength = 30; //random chosen number.
+  SDFMaxDateTimeLength  = 24;
+  SDFMaxGUIDLength      = 38;
+
 type
 //-----------------------------------------------------------------------------
+// TSDFStringList
+  TSDFStringList = Class(TStringList)
+  private
+  protected
+    procedure SetTextStr(const Value: string); override;
+  public
+    constructor Create;
+  end;
+//-----------------------------------------------------------------------------
 // TRecInfo
   PRecInfo = ^TRecInfo;
   TRecInfo = packed record
@@ -161,15 +222,15 @@
     function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
     procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
   protected
-    FData               :TStringlist;
-    FCurRec             :Integer;
-    FRecBufSize         :Integer;
-    FRecordSize         :Integer;
-    FLastBookmark       :PtrInt;
-    FRecInfoOfs         :Integer;
-    FBookmarkOfs        :Integer;
-    FSaveChanges        :Boolean;
-    FDefaultRecordLength:Cardinal;
+    FData               : TSDFStringList;
+    FCurRec             : Integer;
+    FRecBufSize         : Integer;
+    FRecordSize         : Integer;
+    FLastBookmark       : PtrInt;
+    FRecInfoOfs         : Integer;
+    FBookmarkOfs        : Integer;
+    FSaveChanges        : Boolean;
+    FDefaultRecordLength: Cardinal;
     FDataOffset         : Integer;
   protected
     function AllocRecordBuffer: TRecordBuffer; override;
@@ -194,7 +255,9 @@
     function GetRecordSize: Word; override;
     procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
     procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
+
     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+
     procedure ClearCalcFields(Buffer: TRecordBuffer); override;
     function GetRecordCount: Integer; override;
     function GetRecNo: Integer; override;
@@ -256,42 +319,162 @@
 // TSdfDataSet
   TSdfDataSet = class(TFixedFormatDataSet)
   private
-    FDelimiter : Char;
-    FFirstLineAsSchema : Boolean;
-    FFMultiLine         :Boolean;
+    FAlwaysDeQuote: Boolean;
+    FDelimiter          : Char;
+    FFieldQuote         : Char;
+    FFirstLineAsSchema  : Boolean;
+    FFMultiLine         : Boolean;
+    FTrimLeadingSpaces  : Boolean;
+    procedure SetAlwaysDeQuote(AValue: Boolean);
+    procedure SetFieldQuote(AValue: Char);
     procedure SetMultiLine(const Value: Boolean);
     procedure SetFirstLineAsSchema(Value : Boolean);
     procedure SetDelimiter(Value : Char);
+    procedure SetTrimLeadingSpaces(AValue: Boolean);
+    procedure SetTrimSpace(AValue: Boolean);
   protected
     procedure InternalInitFieldDefs; override;
     function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
              : TGetResult; override;
     function BufToStore(Buffer: TRecordBuffer): String; override;
     function StoreToBuf(Source: String): String; override;
+    function GetRecordCount: Integer; override;
   public
     constructor Create(AOwner: TComponent); override;
   published
-    property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default True; //Whether or not to allow fields containing CR and/or LF
+    property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default False; //Whether or not to allow fields containing CR and/or LF
     property Delimiter: Char read FDelimiter write SetDelimiter;
     property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
+    property FieldQuote : Char read FFieldQuote write SetFieldQuote default #34;
+    property TrimLeadingSpaces  : Boolean read FTrimLeadingSpaces write SetTrimLeadingSpaces default False;
+    property TrimTrailingSpaces : Boolean read FTrimSpace write SetTrimSpace default False;
+    property AlwaysDeQuote      : Boolean read FAlwaysDeQuote write SetAlwaysDeQuote default False;
   end;
 procedure Register;
 
 implementation
 //{$R *.Res}
 
+{ TSDFStringList }
+const
+  DefaultFieldQuote : Char = '"';
+  WhiteSpace = [#0..#31];
+
+function InternalTrim(const S: string; TrimLeadSpace,TrimTrailSpace:boolean): string;
+var Ofs, Len: integer;
+    WhiteChars : set of Char;
+begin
+  len := Length(S);
+  if TrimTrailSpace then WhiteChars:=WhiteSpace+[#32] else WhiteChars := WhiteSpace;
+  while (Len>0) and (S[Len] in WhiteChars) do
+   dec(Len);
+  Ofs := 1;
+  if TrimLeadSpace then WhiteChars:=WhiteSpace+[#32] else WhiteChars := WhiteSpace;
+  while (Ofs<=Len) and (S[Ofs] in WhiteSpace) do
+   Inc(Ofs);
+  Result := Copy(S, Ofs, 1 + Len - Ofs);
+end ;
+procedure TSDFStringList.SetTextStr(const Value: string);
+  //JKOZ ENH_1 15/9/2012 5:10:44  copied here from stringl.inc I have no desire to reinvent the wheel.
+  Function GetNextLine (Const Value : String; Var S : String; Var P : Integer; aQuoteChar:Char=#0) : Boolean;
+  Var
+    PS : PChar;
+    IP,L : Integer;
+    InQuote:Boolean;
+  begin
+    L:=Length(Value);
+    S:='';
+    Result:=False;
+    If ((L-P)<0) then
+      exit;
+    if ((L-P)=0) and (not (value[P] in [#10,#13])) Then
+      Begin
+        S:=Value[P];
+        Inc(P);
+        Exit(True);
+      End;
+    PS:=PChar(Value)+P-1;
+    IP:=P;
+    InQuote := False;
+    While ((L-P)>=0) and ((not (PS^ in [#10,#13])) or InQuote ) do
+      begin
+      if (aQuoteChar <> #0) and (PS^ = aQuoteChar) then InQuote := not InQuote; //JKOZ ENH_1 Inquote check.
+      P:=P+1;
+      Inc(PS);
+      end;
+    SetLength (S,P-IP);
+    System.Move (Value[IP],Pointer(S)^,P-IP);
+    If (P<=L) and (Value[P]=#13) then
+      Inc(P);
+    If (P<=L) and (Value[P]=#10) then
+      Inc(P); // Point to character after #10(#13)
+    Result:=True;
+  end;
+Var
+  S : String;
+  P : Integer;
+begin
+  Try
+    BeginUpdate;
+    Clear;
+    P:=1;
+    While GetNextLine (Value,S,P, QuoteChar) do
+      Add(S);
+  finally
+    EndUpdate;
+  end;
+end;
+
+constructor TSDFStringList.Create;
+begin
+  inherited Create;
+  QuoteChar := #0;
+end;
+
+function FieldDefSize(aFieldDef:TFieldDef; DefaultSize:Integer):integer;inline;
+begin
+  case aFieldDef.DataType of
+    ftFixedChar,
+    ftFixedWideChar,
+    ftWideString,
+    ftMemo,
+    ftWideMemo,
+    ftFmtMemo,
+    ftString      : Result := aFieldDef.Size;
+    ftInteger     : result := SDFMaxIntLength;
+    ftCurrency    : Result := SDFMaxCurrencyLength;
+    ftBoolean     : Result := SDFMaxBooleanLength; //yes/no/true/false
+    ftLargeint,
+    ftAutoInc     : Result := SDFMaxInt64Length;
+    ftWord,                        //65535
+    ftSmallint    : result := SDFMaxInt16Length;  //-32768..32767
+    ftDate        : Result := SDFMaxDateLength; //YYYY/MM/DD
+    ftDateTime    : result := SDFMaxDateTimeLength; //YYYY/MM/DD HH:MM:SS:nnn
+    ftTime        : Result := SDFMaxTimeLength; //HH:MM:SS:nnn
+    ftTimeStamp   : Result := SDFMaxTimeStampLength; //random number needs to be verified.
+    ftBlob,
+    ftOraBlob,
+    ftOraClob     : Result := aFieldDef.Size*2;//u64 encoding requires 2 chars per byte.
+    ftBCD,
+    ftFloat,
+    ftFMTBcd      : Result := SDFMaxExtendedLength; //random number.
+    ftGuid        : Result := SDFMaxGUIDLength;
+  else
+    Result := DefaultSize;
+  end;
+end;
 //-----------------------------------------------------------------------------
 // TFixedFormatDataSet
 //-----------------------------------------------------------------------------
 constructor TFixedFormatDataSet.Create(AOwner : TComponent);
 begin
   FDefaultRecordLength := 250;
-  FFileMustExist  := TRUE;
-  FLoadfromStream := False;
-  FRecordSize   := 0;
-  FTrimSpace     := TRUE;
-  FSchema       := TStringList.Create;
-  FData         := TStringList.Create;  // Load the textfile into a stringlist
+  FFileMustExist       := TRUE;
+  FLoadfromStream      := False;//?????
+  FRecordSize          := 0;
+  FTrimSpace           := TRUE;
+  FSchema              := TStringList.Create;
+  FData                := TSDFStringList.Create;  // Load the textfile into a stringlist
   inherited Create(AOwner);
 end;
 
@@ -341,7 +524,7 @@
     exit;
   FRecordSize := 0;
   Maxlen := 0;
-  FieldDefs.Clear;
+  //FieldDefs.Clear; //JKOZ : use fieldDefs to allow for design time schema definition.
   for i := FData.Count - 1 downto 0 do  // Find out the longest record
   begin
     len := Length(FData[i]);
@@ -349,11 +532,14 @@
       Maxlen := len;
     FData.Objects[i] := TObject(Pointer(i+1));   // Fabricate Bookmarks
   end;
-  if (Maxlen = 0) then
+  if (Maxlen = 0) or (FData.Count < 2) then
     Maxlen := FDefaultRecordLength;
   LstFields := TStringList.Create;
   try
     LoadFieldScheme(LstFields, Maxlen);
+    FieldDefs.Clear; //JKOZ : Both datasets depend on the Field.size property to allocate memory.
+                     //       This is a patch it converts everything to string loosing
+                     //       all forms of validation.
     for i := 0 to LstFields.Count -1 do  // Add fields
     begin
       len := StrToIntDef(LstFields.Values[LstFields.Names[i]], Maxlen);
@@ -372,7 +558,7 @@
   FCurRec := -1;
   FSaveChanges := FALSE;
   if not Assigned(FData) then
-    FData := TStringList.Create;
+    FData := TSDFStringList.Create;
   if (not FileMustExist) and (not FileExists(FileName)) then
   begin
     Stream := TFileStream.Create(FileName, fmCreate);
@@ -428,7 +614,7 @@
   if assigned(stream) then
   begin
     Active          := False; //Make sure the Dataset is Closed.
-    Stream.Position := 0;     //Make sure you are at the top of the Stream.
+    Stream.Position := 0;     //Make sure you are at the top of the Stream. //JKOZ raise exception.Create('stream is not a file can't move to start');
     FLoadfromStream := True;
     if not Assigned(FData) then
      raise Exception.Create('Data buffer unassigned');
@@ -445,7 +631,7 @@
   if assigned(stream) then
     FData.SaveToStream(Stream)
   else
-    raise exception.Create('Invalid Stream Assigned (Save To Stream');
+    raise exception.Create('Invalid Stream Assigned (Save To Stream'); //
 end;
 
 // Record Functions
@@ -495,12 +681,12 @@
       DatabaseError('No Records');
 end;
 
-function TFixedFormatDataSet.GetRecordCount: Longint;
+function TFixedFormatDataSet.GetRecordCount: Integer;
 begin
   Result := FData.Count;
 end;
 
-function TFixedFormatDataSet.GetRecNo: Longint;
+function TFixedFormatDataSet.GetRecNo: Integer;
 var
   BufPtr: TRecordBuffer;
 begin
@@ -542,13 +728,14 @@
 function TFixedFormatDataSet.TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
 var
   Accepted : Boolean;
+  Temp     : string;
 begin
   Result := grOK;
   repeat
     Accepted := TRUE;
     case GetMode of
       gmNext:
-        if FCurRec >= RecordCount - 1  then
+        if FCurRec >= FData.Count{RecordCount} - 1  then
           Result := grEOF
         else
           Inc(FCurRec);
@@ -558,12 +745,13 @@
         else
           Dec(FCurRec);
       gmCurrent:
-        if (FCurRec < FDataOffset) or (FCurRec >= RecordCount) then
+        if (FCurRec < FDataOffset) or (FCurRec >= FData.Count{RecordCount}) then
           Result := grError;
     end;
     if (Result = grOk) then
     begin
-      Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
+      Temp:=StoreToBuf(FData[FCurRec]);
+      Move(Temp[1], Buffer[0], FRecordSize);
       if Filtered then
       begin
         Accepted := RecordFilter(Buffer, FCurRec +1);
@@ -608,8 +796,14 @@
       tmpSchema.Assign(Schema);
       RemoveWhiteLines(tmpSchema, FALSE);
     end
-    else
-      tmpSchema.Add('Line');
+    else begin//jkoz : use existing fieldDefs to create a Schema.
+      if FieldDefs.Count > 0 then begin
+        for i := 0 to FieldDefs.Count -1 do begin
+          tmpFieldName := Format('%s=%d', [FieldDefs[i].Name, FieldDefSize(FieldDefs[i],MaxSize)]);
+          tmpSchema.Add(tmpFieldName);
+        end;
+      end else tmpSchema.Add('Line');
+    end;
     for i := 0 to tmpSchema.Count -1 do // Interpret Schema
     begin
       tmpFieldName := tmpSchema.Names[i];
@@ -627,6 +821,7 @@
 function TFixedFormatDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 var
   TempPos, recbuf : PChar;
+  WhiteSpace : set of char = [#1..#31];
 begin
   Result := GetActiveRecBuf(TRecordBuffer(RecBuf));
   if Result then
@@ -647,17 +842,15 @@
   if Result and (Buffer <> nil) then
   begin
     StrLCopy(Buffer, RecBuf, Field.Size);
-    if FTrimSpace then
-    begin
-      TempPos := StrEnd(Buffer);
-      repeat
-        Dec(TempPos);
-        if (TempPos[0] = ' ') then
-          TempPos[0]:= #0
-        else
-          break;
-      until (TempPos = Buffer);
-    end;
+    if FTrimSpace then WhiteSpace:=WhiteSpace+[#32];
+    TempPos := StrEnd(Buffer);
+    repeat
+      Dec(TempPos);
+      if (TempPos[0] in WhiteSpace) then
+        TempPos[0]:= #0
+      else
+        break;
+    until (TempPos = Buffer);
   end;
 end;
 
@@ -684,7 +877,7 @@
       BufEnd := StrEnd(pansichar(ActiveBuffer));  // Fill with blanks when necessary
       if BufEnd > RecBuf then
         BufEnd := RecBuf;
-      FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), Ord(' '));
+      FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), #1);
       p := StrLen(Buffer);
       if p > Field.Size then
         p := Field.Size;
@@ -853,7 +1046,11 @@
   inherited Create(AOwner);
   FDelimiter := ',';
   FFirstLineAsSchema := FALSE;
-  FFMultiLine :=False;
+  FFieldQuote        := #34; //"
+  FData.QuoteChar    := FFieldQuote;
+  FTrimLeadingSpaces := False;
+  FTrimSpace         := False;
+  FAlwaysDeQuote     := False;
 end;
 
 procedure TSdfDataSet.InternalInitFieldDefs;
@@ -913,7 +1110,7 @@
 
     until (pEnd > len);
   end;
-  inherited;
+  inherited InternalInitFieldDefs;
 end;
 
 function TSdfDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
@@ -930,8 +1127,8 @@
       end
     else
       begin
-      If (FCurrec=-1) and (GetMode=gmNext) then
-        inc(FCurrec);
+      If (FCurRec=-1) and (GetMode=gmNext) then
+        inc(FCurRec);
       Result := inherited GetRecord(Buffer, GetMode, DoCheck);
       end;
   end
@@ -940,135 +1137,186 @@
 end;
 
 function TSdfDataSet.StoreToBuf(Source: String): String;
+
 const
- CR    :char = #13;
- LF    :char = #10;
- Quote :char = #34; // Character that encloses field if quoted. Hard-coded to "
+ CR :char = #13;
+ LF :char = #10;
 var
   IsQuoted   // Whether or not field starts with a quote
-                :Boolean;
+                  : Boolean;
   FieldMaxSize, // Maximum fields size as defined in FieldDefs
   i,         // Field counter (0..)
   p          // Length of string in field
-                :Integer;
+                  : Integer;
   pDeQuoted, // Temporary buffer for dedoubling quotes
   pRet,      // Pointer to insertion point in return value
   pStr,      // Beginning of field
   pStrEnd    // End of field
-                :PChar;
-  Ret           :String;
+                  : PChar;
+  Ret             : String;
+  WhiteSpaceChars : set of Char;
+  Cntr            : Integer;
+  InQuote         : Boolean = False;
+
+  IgnoreQuoteStatus : Boolean = False;
+  S                 : string;
+
+  function Buildchar(const size:integer;achar:char):string;
+  begin
+    result := '';
+    SetLength(Result,size);
+    FillChar(Result[1],size,achar);
+  end;
+
+  function Dequote:string;
+  var
+    InQ : boolean;
+    PI  : PChar;
+    Cn  : integer;
+  begin
+    Result:='';
+    if pStr = pStrEnd then Exit;
+    PI := pStr;
+    InQ := False;
+    repeat
+      if InQ and (PI[0] = FFieldQuote) then begin
+        Cn := 0;
+        while (PI[0] = FFieldQuote) and (PI[0] <> PStrEnd) do begin inc(PI);INC(Cn);end;
+        InQ:= (Cn mod 2)<>1;
+        if Cn>1 then Result := Result+Buildchar(Cn div 2, FFieldQuote);
+        Dec(PI);
+      end else
+        if PI[0] = FFieldQuote then InQ:= not InQ
+      else Result := Result + PI[0];
+      Inc(PI);
+    until (PI = pStrEnd) or (PI[0] =#0);
+    if not (PI[0] in [FFieldQuote,#0, FDelimiter]) then Result := Result+PI[0];// else Result := Result + ' ';
+  end;
+
+  procedure ParseToQuoteEnd;
+  var
+    quotecount : Integer=0;
+    Back       : PChar;
+  begin
+    Back:= pStrEnd;
+    repeat
+      inc(pStrEnd);
+      if pStrEnd^ = FFieldQuote then begin
+        quotecount:=0;
+        repeat
+          inc(quotecount);
+          inc(pStrEnd);
+        until pStrEnd^ <> FFieldQuote;
+        InQuote:= (quotecount mod 2) = 0;
+        if not InQuote then Dec(pStrEnd);
+      end;
+    until (pStrEnd[0] in [#0,FFieldQuote]) or (not FFMultiLine and (pStrEnd[0] in[#10,#13]));
+    //in case we have reached the end of string and we are still inquote then
+    //reparse the field value ignoring quotes.
+    if InQuote and (pStrEnd[0] <> FFieldQuote) then begin
+      pStrEnd := Back;
+      Inc(pStrEnd);
+      IgnoreQuoteStatus:=True;
+      IsQuoted:=False;
+    end else begin
+      IsQuoted:=True;
+      Inc(pStrEnd);
+    end;
+  end;
+
+  procedure ParseFieldValue;
+  begin
+    repeat
+      if (pStrEnd[0] = '"') and (not IgnoreQuoteStatus) then InQuote := not InQuote;
+      if InQuote then ParseToQuoteEnd
+      else Inc(pStrEnd);
+    until pStrEnd[0] in [#0, Delimiter,#13,#10];
+  end;
+
+  procedure SkipWhiteSpace;
+  begin
+    while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in WhiteSpaceChars) do
+      Inc(pStrEnd);
+  end;
+  function CharReplace(var InStr:String;const OldChar,NewChar:Char):Integer;
+  var
+    Cntr : Integer;
+  begin
+    Result := 0;
+    for Cntr := 1 to Length(InStr) do
+      if InStr[Cntr] = oldChar then begin InStr[cntr]:=NewChar;inc(Result); end;
+  end;
 begin
   SetLength(Ret, FRecordSize);
-  FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
+  FillChar(Ret[1], FRecordSize, #1);
 
   PStrEnd := PChar(Source);
   pRet := PChar(Ret);
 
+  WhiteSpaceChars := WhiteSpace;
+  if FTrimLeadingSpaces then WhiteSpaceChars:=WhiteSpaceChars + [#32];
+
   for i := 0 to FieldDefs.Count - 1 do
-   begin
+  begin
     FieldMaxSize := FieldDefs[i].Size;
-    IsQuoted := false;
-    while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
-    begin
-     if FFMultiLine then
-      begin
-       if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
-        begin
-         //view this as text, not control characters, so do nothing
-         //todo: check if this is really necessary, probably revert
-         //to original code as quoted case is handled below
-        end;
-      end
-     else
-      begin
-       Inc(pStrEnd);
-      end;
-    end;
+    IgnoreQuoteStatus := False;
+    IsQuoted:=False;
 
+    SkipWhiteSpace;
     if not Boolean(Byte(pStrEnd[0])) then
-     break;
+     break;    //end of string #0 has been reached.
 
-    pStr := pStrEnd;
+    pStr := pStrEnd;  //field data start
 
-    if (pStr[0] = Quote) then
-     begin
-      IsQuoted := true; // See below: accept end of string without explicit quote
-      if FFMultiLine then
-       begin
-        repeat
-         Inc(pStrEnd);
-        until not Boolean(Byte(pStrEnd[0])) or
-         ((pStrEnd[0] = Quote) and ((pStrEnd + 1)[0] in [Delimiter,#0]));
-       end
-      else
-       begin
-        // No multiline, so treat cr/lf as end of record
-         repeat
-          Inc(pStrEnd);
-         until not Boolean(Byte(pStrEnd[0])) or
-          ((pStrEnd[0] = Quote) and ((pStrEnd + 1)[0] in [Delimiter,CR,LF,#0]));
-       end;
+    ParseFieldValue;
 
-      if (pStrEnd[0] = Quote) then
-       Inc(pStr); //Skip final quote
-     end
-    else
-      while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
-        Inc(pStrEnd);
-
-    // Copy over entire field (or at least up to field length):
-    p := pStrEnd - pStr;
-    if IsQuoted then
-    begin
-     pDeQuoted := pRet; //Needed to avoid changing insertion point
-     // Copy entire field but not more than maximum field length:
-     // (We can mess with pStr now; the next loop will reset it after
-     // pStrEnd):
-     while (pstr < pStrEnd) and (pDeQuoted-pRet <= FieldMaxSize) do
-     begin
-      if pStr^ = Quote then inc(pStr);// skip first quote
-      pDeQuoted^ := pStr^;
-      inc(pStr);
-      inc(pDeQuoted);
-     end;
-    end
-    else
-    begin
-     if (p > FieldMaxSize) then
-       p := FieldMaxSize;
-     Move(pStr[0], pRet[0], p);
+    p := pStrEnd - pStr; // do not include the last char be it delimeter or not
+    if IsQuoted and ((pStr^ = FFieldQuote) or AlwaysDeQuote) then begin
+      S:=Dequote;
+      p:=Length(S);
+    end else begin
+      S:='';
+      SetLength(S,p);
+      Move(pStr[0],S[1],p);
     end;
+    if (p > FieldMaxSize) then
+      p := FieldMaxSize;
+    Move(S[1], pRet[0], p);
 
     Inc(pRet, FieldMaxSize);
 
-    // Move the end of field position past quotes and delimiters
-    // ready for processing the next field
-    if (pStrEnd[0] = Quote) then
-      while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
-        Inc(pStrEnd);
-
     if (pStrEnd[0] = Delimiter) then
      Inc(pStrEnd);
+
    end;
 
-  Result := ret;
+  Result := Ret;
 end;
 
+function TSdfDataSet.GetRecordCount: Integer;
+begin
+  Result:=inherited GetRecordCount;
+  //JKOZ: it reports the schema line as a record too.
+  if FFirstLineAsSchema then Dec(Result);
+end;
+
 function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
-const
- QuoteDelimiter='"';
 var
-  Str : String;
-  p, i : Integer;
-  QuoteMe: boolean;
+  Str     : String;
+  p, i    : Integer;
+  QuoteMe : boolean;
+  iSize   : Integer;
 begin
   Result := '';
   p := 1;
   for i := 0 to FieldDefs.Count - 1 do
   begin
     QuoteMe:=false;
-    Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
-    Inc(p, FieldDefs[i].Size);
+    //Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size)); //JKOZ:New Code for size.
+    iSize := FieldDefSize(FieldDefs[i], FDefaultRecordLength);
+    Str := InternalTrim(Copy(PAnsiChar(Buffer), p, iSize), FTrimLeadingSpaces, FTrimSpace);
+    //Inc(p, FieldDefs[i].Size); //JKOZ:New Code for size.
+    Inc(p, iSize);
     if FFMultiLine then
       begin
        // If multiline enabled, quote whenever we find carriage return or linefeed
@@ -1084,20 +1332,25 @@
     // Check for any delimiters or quotes occurring in field text  
     if (not QuoteMe) then
 	  if (StrScan(PChar(Str), FDelimiter) <> nil) or
-	    (StrScan(PChar(Str), QuoteDelimiter) <> nil) then QuoteMe:=true;
+	     (StrScan(PChar(Str), FFieldQuote) <> nil) or
+             (StrScan(PChar(Str), #9) <> nil) then QuoteMe:=true;
     if (QuoteMe) then
       begin
-      Str := Stringreplace(Str, QuoteDelimiter, QuoteDelimiter+QuoteDelimiter, [rfReplaceAll]);
-      Str := QuoteDelimiter + Str + QuoteDelimiter;
+        Str := AnsiQuotedStr(Str, FFieldQuote); //JKOZ : use system procs as much as possible it will be easier to convert to newer versions.
+        //Str := Stringreplace(Str, FFieldQuote, FFieldQuote+FieldQuote, [rfReplaceAll]);
+        //Str := FFieldQuote + Str + FFieldQuote;
       end;
     Result := Result + Str + FDelimiter;
   end;
   p := Length(Result);
-  while (p > 0) and (Result[p] = FDelimiter) do
+   //should we? How do you define empty fields? the last delimiter must be deleted based on the RFC
+   // but the rest why?
+  if Result[p] = FDelimiter then SetLength(Result,p-1);
+{  while (p > 0) and (Result[p] = FDelimiter) do
   begin
     System.Delete(Result, p, 1);
     Dec(p);
-  end;
+  end;}
 end;
 
 procedure TSdfDataSet.SetDelimiter(Value : Char);
@@ -1106,6 +1359,19 @@
   FDelimiter := Value;
 end;
 
+procedure TSdfDataSet.SetTrimLeadingSpaces(AValue: Boolean);
+begin
+  if FTrimLeadingSpaces=AValue then Exit;
+  FTrimLeadingSpaces:=AValue;
+end;
+
+procedure TSdfDataSet.SetTrimSpace(AValue: Boolean);
+begin
+  if FTrimSpace=AValue then Exit;
+  FTrimSpace:=AValue;
+end;
+
+
 procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
 begin
   CheckInactive;
@@ -1118,7 +1384,20 @@
   FFMultiLine:=Value;
 end;
 
+procedure TSdfDataSet.SetFieldQuote(AValue: Char);
+begin
+  if FFieldQuote=AValue then Exit;
+  FFieldQuote:=AValue;
+  FData.QuoteChar:=FFieldQuote;
+end;
 
+procedure TSdfDataSet.SetAlwaysDeQuote(AValue: Boolean);
+begin
+  if FAlwaysDeQuote=AValue then Exit;
+  FAlwaysDeQuote:=AValue;
+end;
+
+
 //-----------------------------------------------------------------------------
 // This procedure is used to register this component on the component palette
 //-----------------------------------------------------------------------------
sdfdata_mention_csv.diff (29,225 bytes)   

John Kozikopoulos

2012-09-27 10:59

reporter   ~0062673

RFC4180 is fully supported, added some flexibility on reading and removed some nasty code.

I thought on adding some flexibility on the writing process too, then I found out that the current implementation sees everything as a string so it was useless to even try it to identify the data and quote as needed eg floats,date/time,strings etc.
So I opted to gear the implementation in preserving as much information as possible from the file giving the choice to the end user how to react on various conditions and preserve the RFC quoting guide lines when writing.

I thought on changing a few more things but there are other components to fill in the gap like TCSVDocument. I figured that the use of TSDFDataset is limited and better to leave it like that to avoid data integrity and other problems.

John Kozikopoulos

2012-10-02 18:52

reporter   ~0062834

This patch solves issues 0022894, 0022882 as well.

Reinier Olislagers

2012-11-16 10:35

developer   ~0063857

I'd be happy to look into getting this patch applied if the accompanying test set in fpc\packages\fcl-db\tests\tcsdfdata.pp is updated to reflect RFC4180/csv format behaviour instead of the current sdf format tests

Reinier Olislagers

2013-09-26 13:31

developer   ~0070352

No tests have been supplied. Rather than applying this patch I suggest rewriting sdfdataset to use csvdocument (requires patch in 24739: [Patch] FCL-base: add csvdocument)

Michael Van Canneyt

2016-06-05 08:50

administrator   ~0093036

Meanwhile, TCSVDataset exists, which contains all this and more.
TSDFDataset already supports multiline fields through another patch. (see related issues)

Issue History

Date Modified Username Field Change
2012-09-25 20:58 John Kozikopoulos New Issue
2012-09-25 20:58 John Kozikopoulos Status new => assigned
2012-09-25 20:58 John Kozikopoulos Assigned To => Joost van der Sluis
2012-09-25 20:58 John Kozikopoulos File Added: sdfdata.pp.patch
2012-09-25 20:58 John Kozikopoulos File Added: sdfdata.pp
2012-09-26 05:54 Reinier Olislagers Note Added: 0062632
2012-09-26 06:26 Reinier Olislagers File Added: sdfdata_mention_csv.diff
2012-09-26 06:26 Reinier Olislagers Note Edited: 0062632
2012-09-27 10:59 John Kozikopoulos Note Added: 0062673
2012-10-02 18:52 John Kozikopoulos Note Added: 0062834
2012-10-23 08:00 Reinier Olislagers Relationship added related to 0022894
2012-10-23 08:01 Reinier Olislagers Relationship added related to 0022882
2012-11-16 10:35 Reinier Olislagers Note Added: 0063857
2013-09-26 13:31 Reinier Olislagers Note Added: 0070352
2013-09-26 13:31 Reinier Olislagers Relationship added related to 0024739
2016-06-05 08:49 Michael Van Canneyt Assigned To Joost van der Sluis => Michael Van Canneyt
2016-06-05 08:50 Michael Van Canneyt Note Added: 0093036
2016-06-05 08:50 Michael Van Canneyt Status assigned => resolved
2016-06-05 08:50 Michael Van Canneyt Resolution open => no change required