|
@@ -137,7 +137,7 @@ type
|
|
// TRecInfo
|
|
// TRecInfo
|
|
PRecInfo = ^TRecInfo;
|
|
PRecInfo = ^TRecInfo;
|
|
TRecInfo = packed record
|
|
TRecInfo = packed record
|
|
- RecordNumber: PtrInt;
|
|
|
|
|
|
+ Bookmark: PtrInt;
|
|
BookmarkFlag: TBookmarkFlag;
|
|
BookmarkFlag: TBookmarkFlag;
|
|
end;
|
|
end;
|
|
//-----------------------------------------------------------------------------
|
|
//-----------------------------------------------------------------------------
|
|
@@ -162,15 +162,14 @@ type
|
|
procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
|
|
procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
|
|
protected
|
|
protected
|
|
FData :TStringlist;
|
|
FData :TStringlist;
|
|
|
|
+ FDataOffset :Integer;
|
|
FCurRec :Integer;
|
|
FCurRec :Integer;
|
|
- FRecBufSize :Integer;
|
|
|
|
FRecordSize :Integer;
|
|
FRecordSize :Integer;
|
|
- FLastBookmark :PtrInt;
|
|
|
|
|
|
+ FRecBufSize :Integer;
|
|
FRecInfoOfs :Integer;
|
|
FRecInfoOfs :Integer;
|
|
- FBookmarkOfs :Integer;
|
|
|
|
|
|
+ FLastBookmark :PtrInt;
|
|
FSaveChanges :Boolean;
|
|
FSaveChanges :Boolean;
|
|
FDefaultRecordLength:Cardinal;
|
|
FDefaultRecordLength:Cardinal;
|
|
- FDataOffset : Integer;
|
|
|
|
protected
|
|
protected
|
|
function AllocRecordBuffer: TRecordBuffer; override;
|
|
function AllocRecordBuffer: TRecordBuffer; override;
|
|
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
|
|
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
|
|
@@ -200,8 +199,7 @@ type
|
|
function GetRecNo: Integer; override;
|
|
function GetRecNo: Integer; override;
|
|
procedure SetRecNo(Value: Integer); override;
|
|
procedure SetRecNo(Value: Integer); override;
|
|
function GetCanModify: boolean; override;
|
|
function GetCanModify: boolean; override;
|
|
- function TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
|
|
|
|
- function RecordFilter(RecBuf: Pointer; ARecNo: Integer): Boolean;
|
|
|
|
|
|
+ function RecordFilter(RecBuf: TRecordBuffer): Boolean;
|
|
function BufToStore(Buffer: TRecordBuffer): String; virtual;
|
|
function BufToStore(Buffer: TRecordBuffer): String; virtual;
|
|
function StoreToBuf(Source: String): String; virtual;
|
|
function StoreToBuf(Source: String): String; virtual;
|
|
public
|
|
public
|
|
@@ -209,6 +207,7 @@ type
|
|
write FDefaultRecordLength default 250;
|
|
write FDefaultRecordLength default 250;
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
destructor Destroy; override;
|
|
|
|
+ function BookmarkValid(ABookmark: TBookmark): Boolean; override;
|
|
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
|
|
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
|
|
procedure RemoveBlankRecords; dynamic;
|
|
procedure RemoveBlankRecords; dynamic;
|
|
procedure RemoveExtraColumns; dynamic;
|
|
procedure RemoveExtraColumns; dynamic;
|
|
@@ -258,23 +257,21 @@ type
|
|
private
|
|
private
|
|
FDelimiter : Char;
|
|
FDelimiter : Char;
|
|
FFirstLineAsSchema : Boolean;
|
|
FFirstLineAsSchema : Boolean;
|
|
- FFMultiLine : Boolean;
|
|
|
|
|
|
+ FMultiLine : Boolean;
|
|
FStripTrailingDelimiters : Boolean;
|
|
FStripTrailingDelimiters : Boolean;
|
|
- procedure DoStripTrailingDelimiters(var S: String; All : Boolean);
|
|
|
|
|
|
+ procedure DoStripTrailingDelimiters(var S: String);
|
|
procedure SetMultiLine(const Value: Boolean);
|
|
procedure SetMultiLine(const Value: Boolean);
|
|
procedure SetFirstLineAsSchema(Value : Boolean);
|
|
procedure SetFirstLineAsSchema(Value : Boolean);
|
|
procedure SetDelimiter(Value : Char);
|
|
procedure SetDelimiter(Value : Char);
|
|
protected
|
|
protected
|
|
- function GetRecordCount: Integer; override;
|
|
|
|
procedure InternalInitFieldDefs; override;
|
|
procedure InternalInitFieldDefs; override;
|
|
- function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
|
|
|
|
- : TGetResult; override;
|
|
|
|
function BufToStore(Buffer: TRecordBuffer): String; override;
|
|
function BufToStore(Buffer: TRecordBuffer): String; override;
|
|
function StoreToBuf(Source: String): String; override;
|
|
function StoreToBuf(Source: String): String; override;
|
|
public
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
published
|
|
- property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default True; //Whether or not to allow fields containing CR and/or LF
|
|
|
|
|
|
+ // Whether or not to allow fields containing CR and/or LF (on write only)
|
|
|
|
+ property AllowMultiLine: Boolean read FMultiLine write SetMultiLine;
|
|
property Delimiter: Char read FDelimiter write SetDelimiter;
|
|
property Delimiter: Char read FDelimiter write SetDelimiter;
|
|
property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
|
|
property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
|
|
// Set this to True if you want to strip all last delimiters
|
|
// Set this to True if you want to strip all last delimiters
|
|
@@ -294,7 +291,7 @@ begin
|
|
FFileMustExist := TRUE;
|
|
FFileMustExist := TRUE;
|
|
FLoadfromStream := False;
|
|
FLoadfromStream := False;
|
|
FRecordSize := 0;
|
|
FRecordSize := 0;
|
|
- FTrimSpace := TRUE;
|
|
|
|
|
|
+ FTrimSpace := TRUE;
|
|
FSchema := TStringList.Create;
|
|
FSchema := TStringList.Create;
|
|
FData := TStringList.Create; // Load the textfile into a stringlist
|
|
FData := TStringList.Create; // Load the textfile into a stringlist
|
|
inherited Create(AOwner);
|
|
inherited Create(AOwner);
|
|
@@ -374,7 +371,6 @@ procedure TFixedFormatDataSet.InternalOpen;
|
|
var
|
|
var
|
|
Stream : TStream;
|
|
Stream : TStream;
|
|
begin
|
|
begin
|
|
- FCurRec := -1;
|
|
|
|
FSaveChanges := FALSE;
|
|
FSaveChanges := FALSE;
|
|
if not Assigned(FData) then
|
|
if not Assigned(FData) then
|
|
FData := TStringList.Create;
|
|
FData := TStringList.Create;
|
|
@@ -387,16 +383,16 @@ begin
|
|
FData.LoadFromFile(FileName);
|
|
FData.LoadFromFile(FileName);
|
|
FRecordSize := FDefaultRecordLength;
|
|
FRecordSize := FDefaultRecordLength;
|
|
InternalInitFieldDefs;
|
|
InternalInitFieldDefs;
|
|
|
|
+ if FRecordSize = 0 then
|
|
|
|
+ FRecordSize := FDefaultRecordLength;
|
|
if DefaultFields then
|
|
if DefaultFields then
|
|
CreateFields;
|
|
CreateFields;
|
|
BindFields(TRUE);
|
|
BindFields(TRUE);
|
|
- if FRecordSize = 0 then
|
|
|
|
- FRecordSize := FDefaultRecordLength;
|
|
|
|
BookmarkSize := SizeOf(PtrInt);
|
|
BookmarkSize := SizeOf(PtrInt);
|
|
FRecInfoOfs := FRecordSize + CalcFieldsSize; // Initialize the offset for TRecInfo in the buffer
|
|
FRecInfoOfs := FRecordSize + CalcFieldsSize; // Initialize the offset for TRecInfo in the buffer
|
|
- FBookmarkOfs := FRecInfoOfs + SizeOf(TRecInfo);
|
|
|
|
- FRecBufSize := FBookmarkOfs + BookmarkSize;
|
|
|
|
|
|
+ FRecBufSize := FRecInfoOfs + SizeOf(TRecInfo);
|
|
FLastBookmark := FData.Count;
|
|
FLastBookmark := FData.Count;
|
|
|
|
+ FCurRec := FDataOffset - 1;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFixedFormatDataSet.InternalClose;
|
|
procedure TFixedFormatDataSet.InternalClose;
|
|
@@ -404,7 +400,7 @@ begin
|
|
if (not FReadOnly) and (FSaveChanges) then // Write any edits to disk
|
|
if (not FReadOnly) and (FSaveChanges) then // Write any edits to disk
|
|
FData.SaveToFile(FileName);
|
|
FData.SaveToFile(FileName);
|
|
FLoadfromStream := False;
|
|
FLoadfromStream := False;
|
|
- FData.Clear;
|
|
|
|
|
|
+ FData.Clear; // Clear data
|
|
BindFields(FALSE);
|
|
BindFields(FALSE);
|
|
if DefaultFields then // Destroy the TField
|
|
if DefaultFields then // Destroy the TField
|
|
DestroyFields;
|
|
DestroyFields;
|
|
@@ -480,47 +476,80 @@ end;
|
|
|
|
|
|
function TFixedFormatDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
|
|
function TFixedFormatDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
|
|
DoCheck: Boolean): TGetResult;
|
|
DoCheck: Boolean): TGetResult;
|
|
|
|
+var
|
|
|
|
+ Accepted : Boolean;
|
|
begin
|
|
begin
|
|
- if (FData.Count < (1+FDataOffset)) then
|
|
|
|
|
|
+ if (FData.Count <= FDataOffset) then
|
|
Result := grEOF
|
|
Result := grEOF
|
|
else
|
|
else
|
|
- Result := TxtGetRecord(Buffer, GetMode);
|
|
|
|
- if Result = grOK then
|
|
|
|
begin
|
|
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');
|
|
|
|
|
|
+ Result := grOK;
|
|
|
|
+ repeat
|
|
|
|
+ Accepted := TRUE;
|
|
|
|
+ case GetMode of
|
|
|
|
+ gmNext:
|
|
|
|
+ if FCurRec >= FData.Count - 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) then
|
|
|
|
+ Result := grError;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ if Result = grOk then
|
|
|
|
+ begin
|
|
|
|
+ Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
|
|
|
|
+ with PRecInfo(Buffer + FRecInfoOfs)^ do
|
|
|
|
+ begin
|
|
|
|
+ Bookmark := PtrInt(FData.Objects[FCurRec]);
|
|
|
|
+ BookmarkFlag := bfCurrent;
|
|
|
|
+ end;
|
|
|
|
+ if CalcFieldsSize > 0 then GetCalcFields(Buffer);
|
|
|
|
+
|
|
|
|
+ if Filtered then
|
|
|
|
+ begin
|
|
|
|
+ Accepted := RecordFilter(Buffer);
|
|
|
|
+ if not Accepted and (GetMode = gmCurrent) then
|
|
|
|
+ Inc(FCurRec);
|
|
|
|
+ end;
|
|
|
|
+ end
|
|
|
|
+ else if (Result = grError) and DoCheck then
|
|
|
|
+ DatabaseError('No Records');
|
|
|
|
+ until (Result <> grOK) or Accepted;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFixedFormatDataSet.GetRecordCount: Longint;
|
|
function TFixedFormatDataSet.GetRecordCount: Longint;
|
|
begin
|
|
begin
|
|
- Result := FData.Count;
|
|
|
|
|
|
+ Result := FData.Count - FDataOffset;
|
|
|
|
+ if Result < 0 then Result := 0; // closed dataset
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFixedFormatDataSet.GetRecNo: Longint;
|
|
function TFixedFormatDataSet.GetRecNo: Longint;
|
|
var
|
|
var
|
|
- BufPtr: TRecordBuffer;
|
|
|
|
|
|
+ RecBuf: TRecordBuffer;
|
|
begin
|
|
begin
|
|
- Result := -1;
|
|
|
|
- if GetActiveRecBuf(BufPtr) then
|
|
|
|
- Result := PRecInfo(BufPtr + FRecInfoOfs)^.RecordNumber;
|
|
|
|
|
|
+ Result := 0;
|
|
|
|
+ if GetActiveRecBuf(RecBuf) and (State <> dsInsert) then
|
|
|
|
+ begin
|
|
|
|
+ InternalSetToRecord(RecBuf);
|
|
|
|
+ Result := FCurRec + 1 - FDataOffset;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFixedFormatDataSet.SetRecNo(Value: Integer);
|
|
procedure TFixedFormatDataSet.SetRecNo(Value: Integer);
|
|
begin
|
|
begin
|
|
CheckBrowseMode;
|
|
CheckBrowseMode;
|
|
- if (Value >= 0) and (Value < FData.Count) and (Value <> RecNo) then
|
|
|
|
|
|
+ if (Value >= 0) and (Value <= RecordCount) and (Value <> RecNo) then
|
|
begin
|
|
begin
|
|
DoBeforeScroll;
|
|
DoBeforeScroll;
|
|
- FCurRec := Value - 1;
|
|
|
|
|
|
+ FCurRec := Value - 1 + FDataOffset;
|
|
Resync([]);
|
|
Resync([]);
|
|
DoAfterScroll;
|
|
DoAfterScroll;
|
|
end;
|
|
end;
|
|
@@ -544,54 +573,16 @@ begin
|
|
Result := RecBuf <> nil;
|
|
Result := RecBuf <> nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
-function TFixedFormatDataSet.TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
|
|
|
|
-var
|
|
|
|
- Accepted : Boolean;
|
|
|
|
-begin
|
|
|
|
- Result := grOK;
|
|
|
|
- repeat
|
|
|
|
- Accepted := TRUE;
|
|
|
|
- case GetMode of
|
|
|
|
- gmNext:
|
|
|
|
- if FCurRec >= RecordCount - 1 then
|
|
|
|
- Result := grEOF
|
|
|
|
- else
|
|
|
|
- Inc(FCurRec);
|
|
|
|
- gmPrior:
|
|
|
|
- if FCurRec <= FDataOffset then
|
|
|
|
- Result := grBOF
|
|
|
|
- else
|
|
|
|
- Dec(FCurRec);
|
|
|
|
- gmCurrent:
|
|
|
|
- if (FCurRec < FDataOffset) or (FCurRec >= RecordCount) then
|
|
|
|
- Result := grError;
|
|
|
|
- end;
|
|
|
|
- if (Result = grOk) then
|
|
|
|
- begin
|
|
|
|
- Move(PChar(StoreToBuf(FData[FCurRec]))^, 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;
|
|
|
|
|
|
+function TFixedFormatDataSet.RecordFilter(RecBuf: TRecordBuffer): Boolean;
|
|
var
|
|
var
|
|
- Accept: Boolean;
|
|
|
|
SaveState: TDataSetState;
|
|
SaveState: TDataSetState;
|
|
begin // Returns true if accepted in the filter
|
|
begin // Returns true if accepted in the filter
|
|
SaveState := SetTempState(dsFilter);
|
|
SaveState := SetTempState(dsFilter);
|
|
FFilterBuffer := RecBuf;
|
|
FFilterBuffer := RecBuf;
|
|
- PRecInfo(FFilterBuffer + FRecInfoOfs)^.RecordNumber := ARecNo;
|
|
|
|
- Accept := TRUE;
|
|
|
|
- if Accept and Assigned(OnFilterRecord) then
|
|
|
|
- OnFilterRecord(Self, Accept);
|
|
|
|
|
|
+ Result := TRUE;
|
|
|
|
+ if Result and Assigned(OnFilterRecord) then
|
|
|
|
+ OnFilterRecord(Self, Result);
|
|
RestoreState(SaveState);
|
|
RestoreState(SaveState);
|
|
- Result := Accept;
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFixedFormatDataSet.GetCanModify: boolean;
|
|
function TFixedFormatDataSet.GetCanModify: boolean;
|
|
@@ -641,27 +632,28 @@ begin
|
|
TempPos := RecBuf;
|
|
TempPos := RecBuf;
|
|
SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
|
|
SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
|
|
Result := (RecBuf < StrEnd(TempPos));
|
|
Result := (RecBuf < StrEnd(TempPos));
|
|
- end
|
|
|
|
- else
|
|
|
|
- if (State in [dsBrowse, dsEdit, dsInsert, dsCalcFields]) then
|
|
|
|
|
|
+ if Result and Assigned(Buffer) then
|
|
begin
|
|
begin
|
|
- Inc(RecBuf, FRecordSize + Field.Offset);
|
|
|
|
- Result := Boolean(Byte(RecBuf[0]));
|
|
|
|
|
|
+ StrLCopy(Buffer, RecBuf, Field.Size);
|
|
|
|
+ if FTrimSpace then // trim trailing spaces
|
|
|
|
+ begin
|
|
|
|
+ TempPos := StrEnd(Buffer);
|
|
|
|
+ repeat
|
|
|
|
+ Dec(TempPos);
|
|
|
|
+ if (TempPos[0] = ' ') then
|
|
|
|
+ TempPos[0]:= #0
|
|
|
|
+ else
|
|
|
|
+ break;
|
|
|
|
+ until (TempPos = Buffer);
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
- end;
|
|
|
|
- if Result and (Buffer <> nil) then
|
|
|
|
- begin
|
|
|
|
- StrLCopy(Buffer, RecBuf, Field.Size);
|
|
|
|
- if FTrimSpace then
|
|
|
|
|
|
+ end
|
|
|
|
+ else // fkCalculated, fkLookup
|
|
begin
|
|
begin
|
|
- TempPos := StrEnd(Buffer);
|
|
|
|
- repeat
|
|
|
|
- Dec(TempPos);
|
|
|
|
- if (TempPos[0] = ' ') then
|
|
|
|
- TempPos[0]:= #0
|
|
|
|
- else
|
|
|
|
- break;
|
|
|
|
- until (TempPos = Buffer);
|
|
|
|
|
|
+ Inc(RecBuf, FRecordSize + Field.Offset); // Offset is calculated using DataSize not Size
|
|
|
|
+ Result := Boolean(RecBuf[0]);
|
|
|
|
+ if Result and Assigned(Buffer) then
|
|
|
|
+ Move(RecBuf[1], Buffer^, Field.DataSize);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
@@ -683,7 +675,7 @@ begin
|
|
DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
|
|
DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
|
|
if State in [dsEdit, dsInsert, dsNewValue] then
|
|
if State in [dsEdit, dsInsert, dsNewValue] then
|
|
Field.Validate(Buffer);
|
|
Field.Validate(Buffer);
|
|
- if Field.FieldKind <> fkInternalCalc then
|
|
|
|
|
|
+ if Assigned(Buffer) and (Field.FieldKind <> fkInternalCalc) then
|
|
begin
|
|
begin
|
|
SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
|
|
SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
|
|
BufEnd := StrEnd(pansichar(ActiveBuffer)); // Fill with blanks when necessary
|
|
BufEnd := StrEnd(pansichar(ActiveBuffer)); // Fill with blanks when necessary
|
|
@@ -699,7 +691,9 @@ begin
|
|
else // fkCalculated, fkLookup
|
|
else // fkCalculated, fkLookup
|
|
begin
|
|
begin
|
|
Inc(RecBuf, FRecordSize + Field.Offset);
|
|
Inc(RecBuf, FRecordSize + Field.Offset);
|
|
- Move(Buffer^, RecBuf[0], Field.Size);
|
|
|
|
|
|
+ Boolean(RecBuf[0]) := Assigned(Buffer);
|
|
|
|
+ if Assigned(Buffer) then
|
|
|
|
+ Move(Buffer^, RecBuf[1], Field.DataSize);
|
|
end;
|
|
end;
|
|
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
|
|
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
|
|
DataEvent(deFieldChange, Ptrint(Field));
|
|
DataEvent(deFieldChange, Ptrint(Field));
|
|
@@ -720,7 +714,7 @@ end;
|
|
// Navigation / Editing
|
|
// Navigation / Editing
|
|
procedure TFixedFormatDataSet.InternalFirst;
|
|
procedure TFixedFormatDataSet.InternalFirst;
|
|
begin
|
|
begin
|
|
- FCurRec := -1;
|
|
|
|
|
|
+ FCurRec := FDataOffset - 1;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFixedFormatDataSet.InternalLast;
|
|
procedure TFixedFormatDataSet.InternalLast;
|
|
@@ -730,14 +724,12 @@ end;
|
|
|
|
|
|
procedure TFixedFormatDataSet.InternalPost;
|
|
procedure TFixedFormatDataSet.InternalPost;
|
|
begin
|
|
begin
|
|
|
|
+ inherited InternalPost;
|
|
FSaveChanges := TRUE;
|
|
FSaveChanges := TRUE;
|
|
- inherited UpdateRecord;
|
|
|
|
if (State = dsEdit) then // just update the data in the string list
|
|
if (State = dsEdit) then // just update the data in the string list
|
|
- begin
|
|
|
|
- FData[FCurRec] := BufToStore(ActiveBuffer);
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
- InternalAddRecord(ActiveBuffer, FALSE);
|
|
|
|
|
|
+ FData[FCurRec] := BufToStore(ActiveBuffer)
|
|
|
|
+ else // append or insert
|
|
|
|
+ InternalAddRecord(ActiveBuffer, GetBookmarkFlag(ActiveBuffer)=bfEOF);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFixedFormatDataSet.InternalEdit;
|
|
procedure TFixedFormatDataSet.InternalEdit;
|
|
@@ -759,12 +751,17 @@ begin
|
|
Inc(FLastBookmark);
|
|
Inc(FLastBookmark);
|
|
if DoAppend then
|
|
if DoAppend then
|
|
InternalLast;
|
|
InternalLast;
|
|
- if (FCurRec >=0) then
|
|
|
|
|
|
+ if (FCurRec >= FDataOffset) then
|
|
FData.InsertObject(FCurRec, BufToStore(Buffer), TObject(Pointer(FLastBookmark)))
|
|
FData.InsertObject(FCurRec, BufToStore(Buffer), TObject(Pointer(FLastBookmark)))
|
|
else
|
|
else
|
|
FData.AddObject(BufToStore(Buffer), TObject(Pointer(FLastBookmark)));
|
|
FData.AddObject(BufToStore(Buffer), TObject(Pointer(FLastBookmark)));
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+function TFixedFormatDataSet.BookmarkValid(ABookmark: TBookmark): Boolean;
|
|
|
|
+begin
|
|
|
|
+ Result := Assigned(ABookmark) and (FData.IndexOfObject(TObject(PPtrInt(ABookmark)^)) <> -1);
|
|
|
|
+end;
|
|
|
|
+
|
|
procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
|
|
procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
|
|
var
|
|
var
|
|
Index: Integer;
|
|
Index: Integer;
|
|
@@ -779,7 +776,7 @@ end;
|
|
procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
|
|
procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
|
|
begin
|
|
begin
|
|
if (State <> dsInsert) then
|
|
if (State <> dsInsert) then
|
|
- InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs)^.RecordNumber);
|
|
|
|
|
|
+ InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs)^.Bookmark);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFixedFormatDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
|
|
function TFixedFormatDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
|
|
@@ -858,13 +855,13 @@ begin
|
|
inherited Create(AOwner);
|
|
inherited Create(AOwner);
|
|
FDelimiter := ',';
|
|
FDelimiter := ',';
|
|
FFirstLineAsSchema := FALSE;
|
|
FFirstLineAsSchema := FALSE;
|
|
- FFMultiLine :=False;
|
|
|
|
|
|
+ FMultiLine := False;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TSdfDataSet.InternalInitFieldDefs;
|
|
procedure TSdfDataSet.InternalInitFieldDefs;
|
|
var
|
|
var
|
|
pStart, pEnd, len : Integer;
|
|
pStart, pEnd, len : Integer;
|
|
- SL,Fn : String;
|
|
|
|
|
|
+ SchemaLine, FN : String;
|
|
|
|
|
|
begin
|
|
begin
|
|
if not IsCursorOpen then
|
|
if not IsCursorOpen then
|
|
@@ -875,79 +872,63 @@ begin
|
|
FData.Append(Schema.DelimitedText);
|
|
FData.Append(Schema.DelimitedText);
|
|
end
|
|
end
|
|
else if (FData.Count = 0) or (Trim(FData[0]) = '') then
|
|
else if (FData.Count = 0) or (Trim(FData[0]) = '') then
|
|
- begin
|
|
|
|
|
|
+ begin
|
|
FirstLineAsSchema := FALSE;
|
|
FirstLineAsSchema := FALSE;
|
|
- FDataOffset:=0;
|
|
|
|
- end
|
|
|
|
- else if (Schema.Count = 0) or (FirstLineAsSchema) then
|
|
|
|
|
|
+ end
|
|
|
|
+ else if (Schema.Count = 0) or FirstLineAsSchema then
|
|
begin
|
|
begin
|
|
Schema.Clear;
|
|
Schema.Clear;
|
|
- SL:=FData[0];
|
|
|
|
|
|
+ SchemaLine:=FData[0];
|
|
if StripTrailingDelimiters then
|
|
if StripTrailingDelimiters then
|
|
- DoStripTrailingDelimiters(SL,True);
|
|
|
|
- len := Length(SL);
|
|
|
|
|
|
+ DoStripTrailingDelimiters(SchemaLine);
|
|
|
|
+ len := Length(SchemaLine);
|
|
pEnd := 1;
|
|
pEnd := 1;
|
|
repeat
|
|
repeat
|
|
- while (pEnd<=len) and (SL[pEnd] in [#1..' ']) do
|
|
|
|
|
|
+ // skip leading white-spaces
|
|
|
|
+ while (pEnd<=len) and (SchemaLine[pEnd] in [#1..' ']) do
|
|
Inc(pEnd);
|
|
Inc(pEnd);
|
|
|
|
+
|
|
if (pEnd > len) then
|
|
if (pEnd > len) then
|
|
break;
|
|
break;
|
|
|
|
+
|
|
pStart := pEnd;
|
|
pStart := pEnd;
|
|
- if (SL[pStart] = '"') then
|
|
|
|
|
|
+ if (SchemaLine[pStart] = '"') then
|
|
|
|
+ // quoted field name
|
|
begin
|
|
begin
|
|
repeat
|
|
repeat
|
|
Inc(pEnd);
|
|
Inc(pEnd);
|
|
- until (pEnd > len) or (SL[pEnd] = '"');
|
|
|
|
- if (SL[pEnd] = '"') then
|
|
|
|
|
|
+ until (pEnd > len) or (SchemaLine[pEnd] = '"');
|
|
|
|
+ if (SchemaLine[pEnd] = '"') then
|
|
Inc(pStart);
|
|
Inc(pStart);
|
|
end
|
|
end
|
|
else
|
|
else
|
|
- while (pEnd<=len) and (SL[pEnd]<>Delimiter) do
|
|
|
|
|
|
+ // unquoted field name
|
|
|
|
+ while (pEnd<=len) and (SchemaLine[pEnd]<>Delimiter) do
|
|
Inc(pEnd);
|
|
Inc(pEnd);
|
|
- if (FirstLineAsSchema) then
|
|
|
|
- FN:=Copy(SL,pStart,pEnd - pStart)
|
|
|
|
|
|
+
|
|
|
|
+ if FirstLineAsSchema then
|
|
|
|
+ FN:=Copy(SchemaLine, pStart, pEnd - pStart)
|
|
else
|
|
else
|
|
FN:='';
|
|
FN:='';
|
|
- if (FN='') then // Pend-PStart=0 is possible: a,b,,c
|
|
|
|
|
|
+ if FN='' then // pEnd-pStart=0 is possible: a,b,,c
|
|
FN:=Format('Field%d', [Schema.Count + 1]);
|
|
FN:=Format('Field%d', [Schema.Count + 1]);
|
|
Schema.Add(FN);
|
|
Schema.Add(FN);
|
|
- if (Pend<=Len) and (SL[pEnd] = '"') then
|
|
|
|
- while (pEnd <= len) and (SL[pEnd] <> Delimiter) do
|
|
|
|
|
|
+
|
|
|
|
+ // 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);
|
|
-// if (SL[pEnd]=Delimiter) then
|
|
|
|
- Inc(pEnd);
|
|
|
|
|
|
+
|
|
|
|
+ Inc(pEnd);
|
|
until (pEnd > len);
|
|
until (pEnd > len);
|
|
|
|
+
|
|
// Special case: f1,f2, is 3 fields, last unnamed.
|
|
// Special case: f1,f2, is 3 fields, last unnamed.
|
|
- if (Len>0) and (SL[Len]=Delimiter) then
|
|
|
|
|
|
+ if (Len>0) and (SchemaLine[Len]=Delimiter) then
|
|
Schema.Add(Format('Field%d', [Schema.Count + 1]));
|
|
Schema.Add(Format('Field%d', [Schema.Count + 1]));
|
|
-
|
|
|
|
end;
|
|
end;
|
|
inherited;
|
|
inherited;
|
|
end;
|
|
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;
|
|
function TSdfDataSet.StoreToBuf(Source: String): String;
|
|
const
|
|
const
|
|
CR :char = #13;
|
|
CR :char = #13;
|
|
@@ -979,7 +960,7 @@ begin
|
|
IsQuoted := false;
|
|
IsQuoted := false;
|
|
while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
|
|
while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
|
|
begin
|
|
begin
|
|
- if FFMultiLine then
|
|
|
|
|
|
+ if FMultiLine then
|
|
begin
|
|
begin
|
|
if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
|
|
if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
|
|
begin
|
|
begin
|
|
@@ -1002,7 +983,7 @@ begin
|
|
if (pStr[0] = Quote) then
|
|
if (pStr[0] = Quote) then
|
|
begin
|
|
begin
|
|
IsQuoted := true; // See below: accept end of string without explicit quote
|
|
IsQuoted := true; // See below: accept end of string without explicit quote
|
|
- if FFMultiLine then
|
|
|
|
|
|
+ if FMultiLine then
|
|
begin
|
|
begin
|
|
repeat
|
|
repeat
|
|
Inc(pStrEnd);
|
|
Inc(pStrEnd);
|
|
@@ -1078,7 +1059,7 @@ begin
|
|
QuoteMe:=false;
|
|
QuoteMe:=false;
|
|
Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
|
|
Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
|
|
Inc(p, FieldDefs[i].Size);
|
|
Inc(p, FieldDefs[i].Size);
|
|
- if FFMultiLine then
|
|
|
|
|
|
+ if FMultiLine then
|
|
begin
|
|
begin
|
|
// If multiline enabled, quote whenever we find carriage return or linefeed
|
|
// 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), #10) <> nil) then QuoteMe:=true;
|
|
@@ -1101,10 +1082,10 @@ begin
|
|
end;
|
|
end;
|
|
Result := Result + Str + FDelimiter;
|
|
Result := Result + Str + FDelimiter;
|
|
end;
|
|
end;
|
|
- DoStripTrailingDelimiters(Result,StripTrailingDelimiters)
|
|
|
|
|
|
+ DoStripTrailingDelimiters(Result)
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String; All: Boolean);
|
|
|
|
|
|
+procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String);
|
|
|
|
|
|
var
|
|
var
|
|
L,P : integer;
|
|
L,P : integer;
|
|
@@ -1112,8 +1093,8 @@ begin
|
|
// Write('S "',S,'" -> "');
|
|
// Write('S "',S,'" -> "');
|
|
L:=Length(S);
|
|
L:=Length(S);
|
|
P:=L;
|
|
P:=L;
|
|
- while (p>0) and (S[p]=FDelimiter) and (All or (P=L)) do
|
|
|
|
- Dec(p);
|
|
|
|
|
|
+ while (P>0) and (S[P]=FDelimiter) and ((P=L) or StripTrailingDelimiters) do
|
|
|
|
+ Dec(P);
|
|
if P<L then
|
|
if P<L then
|
|
S:=Copy(S,1,P);
|
|
S:=Copy(S,1,P);
|
|
// Writeln(s,'"');
|
|
// Writeln(s,'"');
|
|
@@ -1125,13 +1106,6 @@ begin
|
|
FDelimiter := Value;
|
|
FDelimiter := Value;
|
|
end;
|
|
end;
|
|
|
|
|
|
-function TSdfDataSet.GetRecordCount: Integer;
|
|
|
|
-begin
|
|
|
|
- Result:=Inherited GetRecordCount;
|
|
|
|
- If Result>0 then
|
|
|
|
- Result:=Result-Ord(FirstLineAsSchema);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
|
|
procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
|
|
begin
|
|
begin
|
|
CheckInactive;
|
|
CheckInactive;
|
|
@@ -1141,7 +1115,7 @@ end;
|
|
|
|
|
|
procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
|
|
procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
|
|
begin
|
|
begin
|
|
- FFMultiLine:=Value;
|
|
|
|
|
|
+ FMultiLine:=Value;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|