mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 22:10:19 +02:00
fcl-db: sdfdataset: improved handling of space padded values according to RFC4180:"Spaces are considered part of a field and should not be ignored".
Now fields in internal record buffer are always null terminated (also for TFixedFormatDataset) + tests git-svn-id: trunk@30882 -
This commit is contained in:
lacak
parent
5c9d5cf896
commit
8215c485f2
@ -158,7 +158,7 @@ type
|
||||
procedure SetReadOnly(Value : Boolean);
|
||||
procedure RemoveWhiteLines(List : TStrings; IsFileRecord : Boolean);
|
||||
procedure LoadFieldScheme(List : TStrings; MaxSize : Integer);
|
||||
function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
|
||||
function GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
|
||||
procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
|
||||
protected
|
||||
FData :TStringlist;
|
||||
@ -267,6 +267,7 @@ type
|
||||
procedure InternalInitFieldDefs; override;
|
||||
function BufToStore(Buffer: TRecordBuffer): String; override;
|
||||
function StoreToBuf(Source: String): String; override;
|
||||
function ExtractDelimited(const S: String; var Pos: integer): string;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
@ -277,6 +278,7 @@ type
|
||||
// Set this to True if you want to strip all last delimiters
|
||||
Property StripTrailingDelimiters : Boolean Read FStripTrailingDelimiters Write FStripTrailingDelimiters;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
@ -293,7 +295,7 @@ begin
|
||||
FRecordSize := 0;
|
||||
FTrimSpace := TRUE;
|
||||
FSchema := TStringList.Create;
|
||||
FData := TStringList.Create; // Load the textfile into a stringlist
|
||||
FData := TStringList.Create; // Load the textfile into a StringList
|
||||
inherited Create(AOwner);
|
||||
end;
|
||||
|
||||
@ -336,31 +338,33 @@ end;
|
||||
|
||||
procedure TFixedFormatDataSet.InternalInitFieldDefs;
|
||||
var
|
||||
i, len, Maxlen :Integer;
|
||||
i, Len, MaxLen :Integer;
|
||||
LstFields :TStrings;
|
||||
begin
|
||||
if not Assigned(FData) then
|
||||
exit;
|
||||
FRecordSize := 0;
|
||||
Maxlen := 0;
|
||||
|
||||
MaxLen := 0;
|
||||
FieldDefs.Clear;
|
||||
for i := FData.Count - 1 downto 0 do // Find out the longest record
|
||||
begin
|
||||
len := Length(FData[i]);
|
||||
if len > Maxlen then
|
||||
Maxlen := len;
|
||||
Len := Length(FData[i]);
|
||||
if Len > MaxLen then
|
||||
MaxLen := Len;
|
||||
FData.Objects[i] := TObject(Pointer(i+1)); // Fabricate Bookmarks
|
||||
end;
|
||||
if (Maxlen = 0) then
|
||||
Maxlen := FDefaultRecordLength;
|
||||
if (MaxLen = 0) then
|
||||
MaxLen := FDefaultRecordLength;
|
||||
|
||||
FRecordSize := 0;
|
||||
LstFields := TStringList.Create;
|
||||
try
|
||||
LoadFieldScheme(LstFields, Maxlen);
|
||||
LoadFieldScheme(LstFields, MaxLen);
|
||||
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);
|
||||
Len := StrToIntDef(LstFields.Values[LstFields.Names[i]], MaxLen);
|
||||
FieldDefs.Add(Trim(LstFields.Names[i]), ftString, Len, False);
|
||||
Inc(FRecordSize, Len+1);
|
||||
end;
|
||||
finally
|
||||
LstFields.Free;
|
||||
@ -504,7 +508,7 @@ begin
|
||||
|
||||
if Result = grOk then
|
||||
begin
|
||||
Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
|
||||
Move(StoreToBuf(FData[FCurRec])[1], Buffer[0], FRecordSize);
|
||||
with PRecInfo(Buffer + FRecInfoOfs)^ do
|
||||
begin
|
||||
Bookmark := PtrInt(FData.Objects[FCurRec]);
|
||||
@ -560,7 +564,7 @@ begin
|
||||
Result := FRecordSize;
|
||||
end;
|
||||
|
||||
function TFixedFormatDataSet.GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
|
||||
function TFixedFormatDataSet.GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
|
||||
begin
|
||||
case State of
|
||||
dsCalcFields: RecBuf := CalcBuffer;
|
||||
@ -619,29 +623,29 @@ end;
|
||||
|
||||
function TFixedFormatDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
|
||||
var
|
||||
TempPos, RecBuf : PChar;
|
||||
RecBuf,
|
||||
BufEnd: PChar;
|
||||
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));
|
||||
Result := RecBuf < StrEnd(RecBuf); // just ''=Null
|
||||
if Result and Assigned(Buffer) then
|
||||
begin
|
||||
StrLCopy(Buffer, RecBuf, Field.Size);
|
||||
if FTrimSpace then // trim trailing spaces
|
||||
begin
|
||||
TempPos := StrEnd(Buffer);
|
||||
BufEnd := StrEnd(Buffer);
|
||||
repeat
|
||||
Dec(TempPos);
|
||||
if (TempPos[0] = ' ') then
|
||||
TempPos[0]:= #0
|
||||
Dec(BufEnd);
|
||||
if (BufEnd^ = ' ') then
|
||||
BufEnd^ := #0
|
||||
else
|
||||
break;
|
||||
until (TempPos = Buffer);
|
||||
until (BufEnd = Buffer);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
@ -658,8 +662,6 @@ end;
|
||||
procedure TFixedFormatDataSet.SetFieldData(Field: TField; Buffer: Pointer);
|
||||
var
|
||||
RecBuf: PChar;
|
||||
BufEnd: PChar;
|
||||
p : Integer;
|
||||
begin
|
||||
if not (State in dsWriteModes) then
|
||||
DatabaseErrorFmt(SNotEditing, [Name], Self);
|
||||
@ -675,14 +677,7 @@ begin
|
||||
if Assigned(Buffer) and (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), Ord(' '));
|
||||
p := StrLen(Buffer);
|
||||
if p > Field.Size then
|
||||
p := Field.Size;
|
||||
Move(Buffer^, RecBuf[0], p);
|
||||
Move(Buffer^, RecBuf[0], Field.DataSize);
|
||||
end;
|
||||
end
|
||||
else // fkCalculated, fkLookup
|
||||
@ -693,7 +688,7 @@ begin
|
||||
Move(Buffer^, RecBuf[1], Field.DataSize);
|
||||
end;
|
||||
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
|
||||
DataEvent(deFieldChange, Ptrint(Field));
|
||||
DataEvent(deFieldChange, PtrInt(Field));
|
||||
end;
|
||||
|
||||
procedure TFixedFormatDataSet.SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
|
||||
@ -703,7 +698,7 @@ begin
|
||||
i := 1;
|
||||
while (i < FieldNo) and (i < FieldDefs.Count) do
|
||||
begin
|
||||
Inc(Buffer, FieldDefs.Items[i-1].Size);
|
||||
Inc(Buffer, FieldDefs.Items[i-1].Size+1);
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
@ -823,7 +818,7 @@ var
|
||||
i : Integer;
|
||||
begin
|
||||
for i := FData.Count -1 downto 0 do
|
||||
FData[i] := BufToStore(trecordbuffer(StoreToBuf(FData[i])));
|
||||
FData[i] := BufToStore(TRecordBuffer(StoreToBuf(FData[i])));
|
||||
FData.SaveToFile(FileName);
|
||||
end;
|
||||
|
||||
@ -835,13 +830,46 @@ begin
|
||||
end;
|
||||
|
||||
function TFixedFormatDataSet.StoreToBuf(Source: String): String;
|
||||
var i, Len: integer;
|
||||
Src, Dest: PChar;
|
||||
begin
|
||||
Result := Source;
|
||||
// moves fixed length fields from Source to record buffer and null-terminates each field
|
||||
SetLength(Result, FRecordSize);
|
||||
Src := PChar(Source);
|
||||
Dest := PChar(Result);
|
||||
for i := 0 to FieldDefs.Count - 1 do
|
||||
begin
|
||||
Len := FieldDefs[i].Size;
|
||||
Move(Src^, Dest^, Len);
|
||||
Inc(Src, Len);
|
||||
Inc(Dest, Len);
|
||||
Dest^ := #0;
|
||||
Inc(Dest);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFixedFormatDataSet.BufToStore(Buffer: TRecordBuffer): String;
|
||||
var i, Len, SrcLen: integer;
|
||||
Src, Dest: PChar;
|
||||
begin
|
||||
Result := Copy(pansichar(Buffer), 1, FRecordSize);
|
||||
// calculate fixed length record size
|
||||
Len := 0;
|
||||
for i := 0 to FieldDefs.Count - 1 do
|
||||
Inc(Len, FieldDefs[i].Size);
|
||||
SetLength(Result, Len);
|
||||
|
||||
Src := PChar(Buffer);
|
||||
Dest := PChar(Result);
|
||||
for i := 0 to FieldDefs.Count - 1 do
|
||||
begin
|
||||
Len := FieldDefs[i].Size;
|
||||
Move(Src^, Dest^, Len);
|
||||
// fields in record buffer are null-terminated, but pad them with spaces to fixed length
|
||||
SrcLen := StrLen(Src);
|
||||
FillChar(Dest[SrcLen], Len-SrcLen, ' ');
|
||||
Inc(Src, Len+1);
|
||||
Inc(Dest, Len);
|
||||
end;
|
||||
end;
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
@ -855,10 +883,78 @@ begin
|
||||
FMultiLine := False;
|
||||
end;
|
||||
|
||||
function TSdfDataSet.ExtractDelimited(const S: String; var Pos: integer): string;
|
||||
const
|
||||
CR: char = #13;
|
||||
LF: char = #10;
|
||||
DQ: char = '"';
|
||||
var
|
||||
Len, P1: integer;
|
||||
pSrc, pDest: PChar;
|
||||
begin
|
||||
Len := Length(S);
|
||||
P1 := Pos;
|
||||
|
||||
// RFC 4180:
|
||||
// Spaces are considered part of a field and should not be ignored
|
||||
//
|
||||
// If double-quotes are used to enclose fields, then a double-quote
|
||||
// appearing inside a field must be escaped by preceding it with
|
||||
// another double quote
|
||||
|
||||
if (S[Pos] = DQ) then
|
||||
// quoted field
|
||||
begin
|
||||
// skip leading quote
|
||||
Inc(Pos);
|
||||
// allocate output buffer
|
||||
SetLength(Result, Len-P1+1);
|
||||
pSrc := @S[Pos];
|
||||
pDest := @Result[1];
|
||||
while (Pos <= Len) do
|
||||
begin
|
||||
if (pSrc[0] = DQ) then
|
||||
begin
|
||||
if (pSrc[1] = DQ) then // doubled DQ
|
||||
begin
|
||||
Inc(pSrc);
|
||||
Inc(Pos);
|
||||
end
|
||||
else if (pSrc[1] in [Delimiter,' ',CR,LF,#0]) then // DQ followed by delimiter or end of record
|
||||
break;
|
||||
end
|
||||
else if not FMultiLine and (pSrc[0] in [CR,LF,#0]) then // end of record while multiline disabled
|
||||
break;
|
||||
pDest^ := pSrc^;
|
||||
Inc(pSrc);
|
||||
Inc(pDest);
|
||||
Inc(Pos);
|
||||
end;
|
||||
SetLength(Result, pDest-@Result[1]);
|
||||
// skip trailing DQ and white spaces after DQ
|
||||
while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
|
||||
Inc(Pos);
|
||||
end
|
||||
else
|
||||
// unquoted field name
|
||||
begin
|
||||
while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
|
||||
Inc(Pos);
|
||||
Result := Copy(S, P1, Pos-P1);
|
||||
end;
|
||||
|
||||
// skip final field delimiter
|
||||
if (Pos <= Len) and (S[Pos] = Delimiter) then
|
||||
Inc(Pos);
|
||||
// skip end of record, line break CRLF
|
||||
while (Pos <= Len) and (S[Pos] in [CR,LF]) do
|
||||
Inc(Pos);
|
||||
end;
|
||||
|
||||
procedure TSdfDataSet.InternalInitFieldDefs;
|
||||
var
|
||||
pStart, pEnd, len : Integer;
|
||||
SchemaLine, FN : String;
|
||||
Len, Pos : Integer;
|
||||
SchemaLine, S, FN : String;
|
||||
|
||||
begin
|
||||
if not IsCursorOpen then
|
||||
@ -876,50 +972,24 @@ begin
|
||||
begin
|
||||
Schema.Clear;
|
||||
SchemaLine:=FData[0];
|
||||
|
||||
if StripTrailingDelimiters then
|
||||
DoStripTrailingDelimiters(SchemaLine);
|
||||
len := Length(SchemaLine);
|
||||
pEnd := 1;
|
||||
repeat
|
||||
// skip leading white-spaces
|
||||
while (pEnd<=len) and (SchemaLine[pEnd] in [#1..' ']) do
|
||||
Inc(pEnd);
|
||||
|
||||
if (pEnd > len) then
|
||||
break;
|
||||
|
||||
pStart := pEnd;
|
||||
if (SchemaLine[pStart] = '"') then
|
||||
// quoted field name
|
||||
begin
|
||||
repeat
|
||||
Inc(pEnd);
|
||||
until (pEnd > len) or (SchemaLine[pEnd] = '"');
|
||||
if (SchemaLine[pEnd] = '"') then
|
||||
Inc(pStart);
|
||||
end
|
||||
else
|
||||
// unquoted field name
|
||||
while (pEnd<=len) and (SchemaLine[pEnd]<>Delimiter) do
|
||||
Inc(pEnd);
|
||||
|
||||
Len := Length(SchemaLine);
|
||||
Pos := 1;
|
||||
while Pos <= Len do
|
||||
begin
|
||||
S := ExtractDelimited(SchemaLine, Pos);
|
||||
if FirstLineAsSchema then
|
||||
FN:=Copy(SchemaLine, pStart, pEnd - pStart)
|
||||
FN := S
|
||||
else
|
||||
FN:='';
|
||||
if FN='' then // pEnd-pStart=0 is possible: a,b,,c
|
||||
FN:=Format('Field%d', [Schema.Count + 1]);
|
||||
FN := '';
|
||||
if FN = '' then // Special case: "a,b,,c"
|
||||
FN := Format('Field%d', [Schema.Count + 1]);
|
||||
Schema.Add(FN);
|
||||
|
||||
// skip all after trailing quote until next Delimiter
|
||||
if (pEnd<=Len) and (SchemaLine[pEnd] = '"') then
|
||||
while (pEnd <= len) and (SchemaLine[pEnd] <> Delimiter) do
|
||||
Inc(pEnd);
|
||||
|
||||
Inc(pEnd);
|
||||
until (pEnd > len);
|
||||
|
||||
// Special case: f1,f2, is 3 fields, last unnamed.
|
||||
end;
|
||||
// Special case: "f1,f2," are 3 fields, last unnamed.
|
||||
if (Len>0) and (SchemaLine[Len]=Delimiter) then
|
||||
Schema.Add(Format('Field%d', [Schema.Count + 1]));
|
||||
end;
|
||||
@ -927,174 +997,95 @@ begin
|
||||
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 "
|
||||
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;
|
||||
MaxLen, // Maximum field length as defined in FieldDefs + null terminator
|
||||
i,
|
||||
Pos,
|
||||
Len : Integer; // Actual length of field
|
||||
S : String;
|
||||
Dest : PChar;
|
||||
begin
|
||||
SetLength(Ret, FRecordSize);
|
||||
FillChar(PChar(Ret)^, FRecordSize, Ord(' '));
|
||||
SetLength(Result, FRecordSize);
|
||||
FillChar(Result[1], FRecordSize, Ord(' '));
|
||||
|
||||
PStrEnd := PChar(Source);
|
||||
pRet := PChar(Ret);
|
||||
Pos := 1;
|
||||
Dest := PChar(Result);
|
||||
|
||||
for i := 0 to FieldDefs.Count - 1 do
|
||||
begin
|
||||
FieldMaxSize := FieldDefs[i].Size;
|
||||
IsQuoted := false;
|
||||
while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
|
||||
begin
|
||||
if FMultiLine 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;
|
||||
begin
|
||||
MaxLen := FieldDefs[i].Size;
|
||||
S := ExtractDelimited(Source, Pos);
|
||||
Len := Length(S);
|
||||
|
||||
if not Boolean(Byte(pStrEnd[0])) then
|
||||
break;
|
||||
if Len > MaxLen then
|
||||
Len := MaxLen;
|
||||
|
||||
pStr := pStrEnd;
|
||||
|
||||
if (pStr[0] = Quote) then
|
||||
begin
|
||||
IsQuoted := true; // See below: accept end of string without explicit quote
|
||||
if FMultiLine 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;
|
||||
|
||||
if (pStrEnd[0] = Quote) then
|
||||
Inc(pStr); //Skip final quote
|
||||
end
|
||||
if Len = 0 then // bug in StrPLCopy
|
||||
Dest^ := #0
|
||||
else
|
||||
while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] <> Delimiter) do
|
||||
Inc(pStrEnd);
|
||||
StrPLCopy(Dest, S, Len); // null-terminate
|
||||
|
||||
// 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);
|
||||
end;
|
||||
|
||||
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);
|
||||
Inc(Dest, MaxLen+1);
|
||||
end;
|
||||
|
||||
Result := ret;
|
||||
end;
|
||||
|
||||
function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
|
||||
const
|
||||
QuoteDelimiter='"';
|
||||
CR: char = #13;
|
||||
LF: char = #10;
|
||||
DQ: char = '"';
|
||||
var
|
||||
Str : String;
|
||||
p, i : Integer;
|
||||
Src: PChar;
|
||||
S : String;
|
||||
i, MaxLen, Len : Integer;
|
||||
QuoteMe: boolean;
|
||||
begin
|
||||
Result := '';
|
||||
p := 1;
|
||||
Src := PChar(Buffer);
|
||||
for i := 0 to FieldDefs.Count - 1 do
|
||||
begin
|
||||
MaxLen := FieldDefs[i].Size;
|
||||
Len := StrLen(Src); // field values are null-terminated in record buffer
|
||||
if Len > MaxLen then
|
||||
Len := MaxLen;
|
||||
SetString(S, Src, Len);
|
||||
Inc(Src, MaxLen+1);
|
||||
|
||||
QuoteMe:=false;
|
||||
Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
|
||||
Inc(p, FieldDefs[i].Size);
|
||||
if FMultiLine 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;
|
||||
// If multiline enabled, quote whenever we find carriage return or linefeed
|
||||
if (not QuoteMe) and ((Pos(CR, S) > 0) or (Pos(LF, S) > 0)) 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]);
|
||||
// If we don't allow multiline, remove all CR and LF because they mess with the record ends:
|
||||
S := StringReplace(S, CR, '', [rfReplaceAll]);
|
||||
S := StringReplace(S, LF, '', [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), QuoteDelimiter) <> nil) then QuoteMe:=true;
|
||||
if (QuoteMe) then
|
||||
begin
|
||||
Str := Stringreplace(Str, QuoteDelimiter, QuoteDelimiter+QuoteDelimiter, [rfReplaceAll]);
|
||||
Str := QuoteDelimiter + Str + QuoteDelimiter;
|
||||
end;
|
||||
Result := Result + Str + FDelimiter;
|
||||
|
||||
// Check for any delimiters or quotes occurring in field text
|
||||
if not QuoteMe then
|
||||
QuoteMe := (Pos(FDelimiter, S) > 0) or (Pos(DQ, S) > 0);
|
||||
|
||||
if QuoteMe then
|
||||
S := AnsiQuotedStr(S, DQ);
|
||||
|
||||
Result := Result + S + FDelimiter;
|
||||
end;
|
||||
DoStripTrailingDelimiters(Result)
|
||||
end;
|
||||
|
||||
procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String);
|
||||
|
||||
var
|
||||
L,P : integer;
|
||||
begin
|
||||
// Write('S "',S,'" -> "');
|
||||
L:=Length(S);
|
||||
P:=L;
|
||||
while (P>0) and (S[P]=FDelimiter) and ((P=L) or StripTrailingDelimiters) do
|
||||
Dec(P);
|
||||
if P<L then
|
||||
S:=Copy(S,1,P);
|
||||
// Writeln(s,'"');
|
||||
end;
|
||||
|
||||
procedure TSdfDataSet.SetDelimiter(Value : Char);
|
||||
|
||||
@ -88,7 +88,7 @@ begin
|
||||
ForceDirectories(dbname);
|
||||
DeleteFile(FileName);
|
||||
FileMustExist:=False;
|
||||
|
||||
|
||||
SetFieldDatasetSchema(Schema);
|
||||
|
||||
Open;
|
||||
@ -133,6 +133,7 @@ begin
|
||||
begin
|
||||
FileName := dbname+PathDelim+'fpdev_field.dat';
|
||||
SetFieldDatasetSchema(Schema);
|
||||
TrimSpace := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -27,12 +27,6 @@ type
|
||||
procedure TestSingleLineHeader;
|
||||
procedure TestSingleLineNoHeader;
|
||||
procedure TestOutput;
|
||||
{
|
||||
November 2012: this test tests again sdf;
|
||||
however sdfdataset should comply with RFC4180 CSV, see issue #22980
|
||||
todo: rewrite test to RFC4180
|
||||
procedure TestInputOurFormat;
|
||||
}
|
||||
procedure TestDelimitedTextOutput;
|
||||
procedure TestEmptyFieldHeader;
|
||||
Procedure TestEmptyFieldNoHeader;
|
||||
@ -166,38 +160,43 @@ end;
|
||||
procedure Ttestsdfspecific.TestOutput;
|
||||
// Basic assignment test: assign some difficult data to records and
|
||||
// see if the RecordCount is correct.
|
||||
const
|
||||
NAME: array[1..4] of string = (
|
||||
'J"T"', // Data with quotes
|
||||
'Hello, goodbye', // Data with delimiter
|
||||
' Just a line with spaces ', // Regular data
|
||||
'Delimiter,"and";quote' // Data with delimiter and quote
|
||||
);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
// with Schema, with Header line
|
||||
TestDataset.Schema[1] := 'NAME=30';
|
||||
TestDataset.FileName := TestFileName('output.csv');
|
||||
TestDataset.Open;
|
||||
|
||||
// Fill test data
|
||||
TestDataset.Append;
|
||||
TestDataset.FieldByName('ID').AsInteger := 1;
|
||||
// Data with quotes
|
||||
TestDataset.FieldByName('NAME').AsString := 'J"T"';
|
||||
TestDataset.FieldByName('NAME').AsString := NAME[1];
|
||||
TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
|
||||
TestDataset.Post;
|
||||
|
||||
TestDataset.Append;
|
||||
TestDataset.FieldByName('ID').AsInteger := 2;
|
||||
// Data with delimiter
|
||||
TestDataset.FieldByName('NAME').AsString := 'Hello'+TestDataset.Delimiter+' goodbye';
|
||||
TestDataset.FieldByName('NAME').AsString := NAME[2];
|
||||
TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
|
||||
TestDataset.Post;
|
||||
|
||||
TestDataset.Append;
|
||||
TestDataset.FieldByName('ID').AsInteger := 4;
|
||||
//Data with delimiter and quote (to test 19376)
|
||||
TestDataset.FieldByName('NAME').AsString := 'Delimiter,"and";quote';
|
||||
TestDataset.FieldByName('NAME').AsString := NAME[4];
|
||||
TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
|
||||
TestDataset.Post;
|
||||
|
||||
TestDataset.Insert;
|
||||
TestDataset.FieldByName('ID').AsInteger := 3;
|
||||
// Regular data
|
||||
TestDataset.FieldByName('NAME').AsString := 'Just a long line of text without anything special';
|
||||
TestDataset.FieldByName('NAME').AsString := NAME[3];
|
||||
TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
|
||||
TestDataset.Post;
|
||||
|
||||
@ -217,73 +216,15 @@ begin
|
||||
AssertEquals('RecordCount', 4, TestDataset.RecordCount);
|
||||
TestDataset.Close;
|
||||
AssertEquals('RecordCount after Close', 0, TestDataset.RecordCount);
|
||||
end;
|
||||
|
||||
{
|
||||
procedure Ttestsdfspecific.TestInputOurFormat;
|
||||
// Test if input works as expected: output is written according to specs and read in.
|
||||
// Mainly check if reading quotes is according to Delphi sdf specs and works.
|
||||
// See test results from bug 19610 for evidence that the strings below should work.
|
||||
// If this works, we can switch to this and be RFC 4180 compliant and Delphi compliant.
|
||||
const
|
||||
OutputFileName='input.csv';
|
||||
//Value1 is the on disk format; it should translate to Expected1
|
||||
Value1='"Delimiter,""and"";quote"';
|
||||
Expected1='Delimiter,"and";quote';
|
||||
Value2='"J""T"""';
|
||||
Expected2='J"T"';
|
||||
Value3='Just a long line';
|
||||
Expected3='Just a long line';
|
||||
//Note: Delphi can read this, see evidence in bug 19610 (the "quoted and space" value)
|
||||
Value4='"Just a quoted long line"';
|
||||
Expected4='Just a quoted long line';
|
||||
// Delphi can read multiline, see evidence in bug 19610 (the multiline entry)
|
||||
Value5='"quoted_multi'+#13+#10+'line"';
|
||||
Expected5='quoted_multi'+#13+#10+'line';
|
||||
Value6='"Delimiter,and;quoted"';
|
||||
Expected6='Delimiter,and;quoted';
|
||||
Value7='"A random""quote"';
|
||||
Expected7='A random"quote';
|
||||
var
|
||||
FileStrings: TStringList;
|
||||
begin
|
||||
TestDataset.Close;
|
||||
TestDataset.AllowMultiLine:=true;
|
||||
if FileExists(OutputFilename) then DeleteFile(OutputFileName);
|
||||
FileStrings:=TStringList.Create;
|
||||
try
|
||||
FileStrings.Add('ID,NAME,BIRTHDAY');
|
||||
FileStrings.Add('1,'+Value1+',31-12-1976');
|
||||
FileStrings.Add('2,'+Value2+',31-12-1976');
|
||||
FileStrings.Add('3,'+Value3+',31-12-1976');
|
||||
FileStrings.Add('4,'+Value4+',31-12-1976');
|
||||
FileStrings.Add('5,'+Value5+',31-12-1976');
|
||||
FileStrings.Add('6,'+Value6+',31-12-1976');
|
||||
FileStrings.Add('7,'+Value7+',31-12-1976');
|
||||
FileStrings.SaveToFile(OutputFileName);
|
||||
finally
|
||||
FileStrings.Free;
|
||||
end;
|
||||
|
||||
// Load our dataset
|
||||
TestDataset.FileName:=OutputFileName;
|
||||
// reopen, retest
|
||||
TestDataset.Open;
|
||||
TestDataset.First;
|
||||
AssertEquals(Expected1, TestDataSet.FieldByName('NAME').AsString);
|
||||
TestDataSet.Next;
|
||||
AssertEquals(Expected2, TestDataSet.FieldByName('NAME').AsString);
|
||||
TestDataSet.Next;
|
||||
AssertEquals(Expected3, TestDataSet.FieldByName('NAME').AsString);
|
||||
TestDataSet.Next;
|
||||
AssertEquals(Expected4, TestDataSet.FieldByName('NAME').AsString);
|
||||
TestDataSet.Next;
|
||||
AssertEquals(Expected5, TestDataSet.FieldByName('NAME').AsString);
|
||||
TestDataSet.Next;
|
||||
AssertEquals(Expected6, TestDataSet.FieldByName('NAME').AsString);
|
||||
TestDataSet.Next;
|
||||
AssertEquals(Expected7, TestDataSet.FieldByName('NAME').AsString);
|
||||
for i:=1 to 4 do begin
|
||||
AssertEquals(NAME[i], TestDataset.FieldByName('NAME').AsString);
|
||||
TestDataset.Next;
|
||||
end;
|
||||
AssertTrue('Eof', TestDataset.Eof);
|
||||
end;
|
||||
}
|
||||
|
||||
procedure Ttestsdfspecific.TestDelimitedTextOutput;
|
||||
// Test if saving and loading data keeps the original values.
|
||||
@ -314,16 +255,16 @@ begin
|
||||
Close(F);
|
||||
// Load our dataset
|
||||
TestDataset.Open;
|
||||
// AssertEquals('Field count',7,TEstDataset.Fielddefs.Count);
|
||||
// AssertEquals('Record count',1,TEstDataset.RecordCount);
|
||||
// AssertEquals('Field count',7,TestDataset.FieldDefs.Count);
|
||||
// AssertEquals('Record count',1,TestDataset.RecordCount);
|
||||
TestDataset.First;
|
||||
AssertEquals('Field1',Value1, TestDataSet.Fields[0].AsString);
|
||||
AssertEquals('Field2',Value2, TestDataSet.Fields[1].AsString);
|
||||
AssertEquals('Field3',Value3, TestDataSet.Fields[2].AsString);
|
||||
AssertEquals('Field4',Value4, TestDataSet.Fields[3].AsString);
|
||||
AssertEquals('Field5',Value5, TestDataSet.Fields[4].AsString);
|
||||
AssertEquals('Field6',Value6, TestDataSet.Fields[5].AsString);
|
||||
AssertEquals('Field7',Value7, TestDataSet.Fields[6].AsString);
|
||||
AssertEquals('Field1', Value1, TestDataSet.Fields[0].AsString);
|
||||
AssertEquals('Field2', Value2, TestDataSet.Fields[1].AsString);
|
||||
AssertEquals('Field3', Value3, TestDataSet.Fields[2].AsString);
|
||||
AssertEquals('Field4', Value4, TestDataSet.Fields[3].AsString);
|
||||
AssertEquals('Field5', Value5, TestDataSet.Fields[4].AsString);
|
||||
AssertEquals('Field6', Value6, TestDataSet.Fields[5].AsString);
|
||||
AssertEquals('Field7' ,Value7, TestDataSet.Fields[6].AsString);
|
||||
end;
|
||||
|
||||
procedure Ttestsdfspecific.TestEmptyFieldContents;
|
||||
@ -369,7 +310,7 @@ procedure Ttestsdfspecific.TestEmptyFieldNoHeader;
|
||||
|
||||
Var
|
||||
F : Text;
|
||||
S : String;
|
||||
S1,S2 : String;
|
||||
|
||||
begin
|
||||
// without Schema, without Header line
|
||||
@ -383,19 +324,30 @@ begin
|
||||
Writeln(F,'value1;value2;;;');
|
||||
Close(F);
|
||||
|
||||
TestDataset.Open;
|
||||
AssertEquals('FieldDefs.Count',5,TestDataset.FieldDefs.Count);
|
||||
AssertEquals('RecordCount', 1, TestDataset.RecordCount);
|
||||
TestDataset.Edit;
|
||||
TestDataset.Fields[0].AsString:='Value1';
|
||||
TestDataset.Post;
|
||||
TestDataset.Close;
|
||||
with TestDataset do begin
|
||||
Open;
|
||||
AssertEquals('FieldDefs.Count', 5, FieldDefs.Count);
|
||||
AssertEquals('RecordCount', 1, RecordCount);
|
||||
// #1 record
|
||||
Edit;
|
||||
Fields[0].AsString := 'Value1';
|
||||
Post;
|
||||
AssertEquals('Fields[4]', '', Fields[4].AsString);
|
||||
// #2 record
|
||||
Append;
|
||||
Fields[1].AsString := 'Value2';
|
||||
Fields[2].AsString := 'Value"'; // embedded double quote
|
||||
Post;
|
||||
Close;
|
||||
end;
|
||||
|
||||
Assign(F, TestDataset.FileName);
|
||||
Reset(F);
|
||||
ReadLn(F,S);
|
||||
ReadLn(F,S1);
|
||||
ReadLn(F,S2);
|
||||
Close(F);
|
||||
AssertEquals('No data lost','Value1;value2;;;',S);
|
||||
AssertEquals('Value1;value2;;;',S1);
|
||||
AssertEquals(';Value2;"Value""";;',S2);
|
||||
end;
|
||||
|
||||
procedure Ttestsdfspecific.TestEmptyFieldHeaderStripTrailingDelimiters;
|
||||
@ -473,6 +425,7 @@ begin
|
||||
TestDataset.Delimiter := ',';
|
||||
TestDataset.FileMustExist := False;
|
||||
TestDataset.FirstLineAsSchema := True;
|
||||
TestDataset.TrimSpace := False;
|
||||
TestDataset.AllowMultiLine := False;
|
||||
TestDataset.Schema.Add('ID');
|
||||
TestDataset.Schema.Add('NAME');
|
||||
@ -550,21 +503,30 @@ begin
|
||||
TestDataset.FileName := TestFileName();
|
||||
CreateTestFile;
|
||||
|
||||
TestDataset.Open;
|
||||
AssertEquals('FieldDefs.Count', 3, TestDataset.FieldDefs.Count);
|
||||
AssertEquals('1', TestDataset.Fields[0].AsString); // just after Open
|
||||
with TestDataset do begin
|
||||
Open;
|
||||
AssertEquals('FieldDefs.Count', 3, FieldDefs.Count);
|
||||
AssertEquals('1', Fields[0].AsString); // just after Open
|
||||
|
||||
TestDataset.Last;
|
||||
TestDataset.First;
|
||||
AssertEquals('RecNo', 1, TestDataset.RecNo);
|
||||
AssertEquals('RecordCount', 2, TestDataset.RecordCount);
|
||||
AssertEquals('1', TestDataset.Fields[0].AsString);
|
||||
AssertEquals('John', TestDataset.Fields[1].AsString);
|
||||
TestDataset.Next;
|
||||
AssertEquals('2', TestDataset.Fields[0].AsString);
|
||||
AssertEquals('Christiana', TestDataset.Fields[1].AsString);
|
||||
TestDataset.Close;
|
||||
AssertEquals('RecordCount after Close', 0, TestDataset.RecordCount);
|
||||
Last;
|
||||
First;
|
||||
AssertEquals('RecNo', 1, RecNo);
|
||||
AssertEquals('RecordCount', 2, RecordCount);
|
||||
AssertEquals('1', Fields[0].AsString);
|
||||
AssertEquals('John', Fields[1].AsString);
|
||||
Next;
|
||||
AssertEquals('2', Fields[0].AsString);
|
||||
AssertEquals('Christiana', Fields[1].AsString);
|
||||
Edit;
|
||||
Fields[1].AsString := 'Chris';
|
||||
Post;
|
||||
AssertEquals('Chris', Fields[1].AsString);
|
||||
Close; // save changes
|
||||
AssertEquals('RecordCount after Close', 0, RecordCount);
|
||||
Open;
|
||||
Next;
|
||||
AssertEquals('Chris', Fields[1].AsString);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestFixedFormatSpecific.TestNoTrimSpace;
|
||||
@ -572,13 +534,23 @@ begin
|
||||
TestDataset.FileName := TestFileName();
|
||||
CreateTestFile;
|
||||
|
||||
TestDataset.TrimSpace := False;
|
||||
TestDataset.Open;
|
||||
AssertEquals('1', TestDataset.Fields[0].AsString);
|
||||
AssertEquals('John ', TestDataset.Fields[1].AsString);
|
||||
TestDataset.Next;
|
||||
AssertEquals('2', TestDataset.Fields[0].AsString);
|
||||
AssertEquals('Christiana', TestDataset.Fields[1].AsString);
|
||||
with TestDataset do begin
|
||||
TrimSpace := False;
|
||||
Open;
|
||||
AssertEquals('1', Fields[0].AsString);
|
||||
AssertEquals('John ', Fields[1].AsString);
|
||||
Next;
|
||||
AssertEquals('2', Fields[0].AsString);
|
||||
AssertEquals('Christiana', Fields[1].AsString);
|
||||
Edit;
|
||||
Fields[1].AsString := 'Chris';
|
||||
Post;
|
||||
AssertEquals('Chris ', Fields[1].AsString);
|
||||
Close; // save changes
|
||||
Open;
|
||||
Next;
|
||||
AssertEquals('Chris ', Fields[1].AsString);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
Loading…
Reference in New Issue
Block a user