1 |
// Upgraded to Delphi 2009: Sebastian Zierer
|
2 |
|
3 |
(* ***** BEGIN LICENSE BLOCK *****
|
4 |
* Version: MPL 1.1
|
5 |
*
|
6 |
* The contents of this file are subject to the Mozilla Public License Version
|
7 |
* 1.1 (the "License"); you may not use this file except in compliance with
|
8 |
* the License. You may obtain a copy of the License at
|
9 |
* http://www.mozilla.org/MPL/
|
10 |
*
|
11 |
* Software distributed under the License is distributed on an "AS IS" basis,
|
12 |
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
13 |
* for the specific language governing rights and limitations under the
|
14 |
* License.
|
15 |
*
|
16 |
* The Original Code is TurboPower SysTools
|
17 |
*
|
18 |
* The Initial Developer of the Original Code is
|
19 |
* TurboPower Software
|
20 |
*
|
21 |
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
22 |
* the Initial Developer. All Rights Reserved.
|
23 |
*
|
24 |
* Contributor(s):
|
25 |
*
|
26 |
* ***** END LICENSE BLOCK ***** *)
|
27 |
|
28 |
{*********************************************************}
|
29 |
{* SysTools: StTxtDat.pas 4.04 *}
|
30 |
{*********************************************************}
|
31 |
{* SysTools: Formatted Text Data Handling *}
|
32 |
{*********************************************************}
|
33 |
|
34 |
{$include StDefine.inc}
|
35 |
|
36 |
unit StTxtDat;
|
37 |
|
38 |
interface
|
39 |
uses
|
40 |
SysUtils, Classes, TypInfo, StConst, StBase, StStrms, StStrL;
|
41 |
|
42 |
const
|
43 |
StDefaultDelim = ',';
|
44 |
StDefaultQuote = '"';
|
45 |
StDefaultComment = ';';
|
46 |
StDefaultFixedSep = ' '; {!!.01}
|
47 |
StDefaultLineTerm = #13#10;
|
48 |
St_WhiteSpace = #8#9#10#13' '; {page feed, tab, LF, CR, space} {!!.01}
|
49 |
|
50 |
type
|
51 |
TStSchemaLayoutType = (ltUnknown, ltFixed, ltVarying);
|
52 |
TStSchemaFieldType = (sftUnknown, sftChar, sftFloat, sftNumber, sftBool, sftLongInt, sftDate, sftTime, sftTimeStamp);
|
53 |
TStOnQuoteFieldEvent = procedure (Sender : TObject; var Field : String) of object;
|
54 |
|
55 |
{ Text Data Layout descriptors (Schemas)}
|
56 |
TStDataField = class
|
57 |
protected {private}
|
58 |
FFieldDecimals: Integer;
|
59 |
FFieldLen: Integer;
|
60 |
FFieldName: String;
|
61 |
FFieldOffset: Integer;
|
62 |
FFieldType: TStSchemaFieldType;
|
63 |
function GetAsString: String;
|
64 |
procedure SetFieldDecimals(const Value: Integer);
|
65 |
procedure SetFieldLen(const Value: Integer);
|
66 |
procedure SetFieldName(const Value: String);
|
67 |
procedure SetFieldOffset(const Value: Integer);
|
68 |
procedure SetFieldType(const Value: TStSchemaFieldType);
|
69 |
public
|
70 |
{ properties }
|
71 |
property AsString : String read GetAsString;
|
72 |
property FieldDecimals: Integer read FFieldDecimals write SetFieldDecimals;
|
73 |
property FieldLen: Integer read FFieldLen write SetFieldLen;
|
74 |
property FieldName : String read FFieldName write SetFieldName;
|
75 |
property FieldOffset: Integer read FFieldOffset write SetFieldOffset;
|
76 |
property FieldType: TStSchemaFieldType read FFieldType write SetFieldType;
|
77 |
end;
|
78 |
|
79 |
|
80 |
TStDataFieldList = class
|
81 |
private
|
82 |
FList : TStringList;
|
83 |
protected {private}
|
84 |
function GetCount: Integer;
|
85 |
function GetField(Index: Integer): TStDataField;
|
86 |
function GetFieldByName(const FieldName: String): TStDataField;
|
87 |
procedure SetField(Index: Integer; const Value: TStDataField);
|
88 |
procedure SetFieldByName(const FieldName: String;
|
89 |
const Value: TStDataField);
|
90 |
public
|
91 |
constructor Create;
|
92 |
destructor Destroy; override;
|
93 |
|
94 |
{ Access and Update Methods }
|
95 |
procedure AddField(const FieldName: String; FieldType: TStSchemaFieldType;
|
96 |
FieldLen, FieldDecimals, FieldOffset: Integer);
|
97 |
procedure AddFieldStr(const FieldDef : String);
|
98 |
procedure Clear;
|
99 |
procedure RemoveField(const FieldName: String);
|
100 |
|
101 |
{ properties }
|
102 |
property Count : Integer read GetCount;
|
103 |
property Fields[Index : Integer] : TStDataField
|
104 |
read GetField write SetField; default;
|
105 |
property FieldByName[const FieldName: String] : TStDataField
|
106 |
read GetFieldByName write SetFieldByName;
|
107 |
end;
|
108 |
|
109 |
TStTextDataSchema = class
|
110 |
private
|
111 |
FCommentDelimiter: Char;
|
112 |
FFieldDelimiter: Char;
|
113 |
FLayoutType: TStSchemaLayoutType;
|
114 |
FLineTermChar : Char;
|
115 |
FLineTerminator : TStLineTerminator;
|
116 |
FQuoteDelimiter: Char;
|
117 |
FFixedSeparator : Char; {!!.01}
|
118 |
FSchema: TStrings;
|
119 |
FSchemaName: String;
|
120 |
dsFieldList : TStDataFieldList;
|
121 |
protected {private}
|
122 |
function GetCaptions: TStrings;
|
123 |
function GetField(Index: Integer): TStDataField;
|
124 |
function GetFieldByName(const FieldName: String): TStDataField;
|
125 |
function GetFieldCount: Integer;
|
126 |
function GetSchema: TStrings;
|
127 |
procedure SetCommentDelimiter(const Value: Char);
|
128 |
procedure SetField(Index: Integer; const Value: TStDataField);
|
129 |
procedure SetFieldByName(const FieldName: String; const Value: TStDataField);
|
130 |
procedure SetFieldDelimiter(const Value: Char);
|
131 |
procedure SetLayoutType(const Value: TStSchemaLayoutType);
|
132 |
procedure SetQuoteDelimiter(const Value: Char);
|
133 |
procedure SetFixedSeparator(const Value: Char); {!!.01}
|
134 |
procedure SetSchema(const Value: TStrings);
|
135 |
procedure SetSchemaName(const Value: String);
|
136 |
public
|
137 |
constructor Create;
|
138 |
destructor Destroy; override;
|
139 |
procedure Assign(ASchema : TStTextDataSchema);
|
140 |
|
141 |
{ Access and Update Methods }
|
142 |
procedure AddField(const FieldName : String; FieldType : TStSchemaFieldType;
|
143 |
FieldLen, FieldDecimals : Integer);
|
144 |
function IndexOf(const FieldName : String) : Integer;
|
145 |
procedure RemoveField(const FieldName: String);
|
146 |
procedure Update(AList : TStrings); {!!.01}
|
147 |
procedure ClearFields; {!!.01}
|
148 |
procedure BuildSchema(AList: TStrings); {!!.01}
|
149 |
|
150 |
{ Persistence and streaming methods }
|
151 |
procedure LoadFromFile(const AFileName : TFileName);
|
152 |
procedure LoadFromStream(AStream : TStream);
|
153 |
procedure SaveToFile(const AFileName : TFileName);
|
154 |
procedure SaveToStream(AStream : TStream);
|
155 |
|
156 |
{ properties }
|
157 |
property Captions : TStrings
|
158 |
read GetCaptions;
|
159 |
property CommentDelimiter : Char
|
160 |
read FCommentDelimiter write SetCommentDelimiter default StDefaultComment;
|
161 |
property FieldByName[const FieldName: String] : TStDataField
|
162 |
read GetFieldByName write SetFieldByName;
|
163 |
property FieldCount : Integer
|
164 |
read GetFieldCount;
|
165 |
property FieldDelimiter : Char
|
166 |
read FFieldDelimiter write SetFieldDelimiter default StDefaultDelim;
|
167 |
property Fields[Index : Integer] : TStDataField
|
168 |
read GetField write SetField; default;
|
169 |
property LayoutType : TStSchemaLayoutType
|
170 |
read FLayoutType write SetLayoutType;
|
171 |
property LineTermChar : Char
|
172 |
read FLineTermChar write FLineTermChar default #0;
|
173 |
property LineTerminator : TStLineTerminator
|
174 |
read FLineTerminator write FLineTerminator default ltCRLF;
|
175 |
property QuoteDelimiter : Char
|
176 |
read FQuoteDelimiter write SetQuoteDelimiter default StDefaultQuote;
|
177 |
property FixedSeparator : Char {!!.01}
|
178 |
read FFixedSeparator write SetFixedSeparator default StDefaultFixedSep; {!!.01}
|
179 |
property Schema : TStrings
|
180 |
read GetSchema write SetSchema;
|
181 |
property SchemaName : String
|
182 |
read FSchemaName write SetSchemaName;
|
183 |
end;
|
184 |
|
185 |
{ Text Data Records and Data Sets }
|
186 |
TStTextDataRecord = class
|
187 |
private
|
188 |
FFieldList: TStrings;
|
189 |
FQuoteAlways: Boolean;
|
190 |
FQuoteIfSpaces: Boolean;
|
191 |
FSchema: TStTextDataSchema;
|
192 |
FValue : String;
|
193 |
FOnQuoteField : TStOnQuoteFieldEvent;
|
194 |
protected {private}
|
195 |
function GetField(Index: Integer): String;
|
196 |
function GetFieldCount: Integer;
|
197 |
function GetFieldByName(const FieldName: String): String;
|
198 |
function GetFieldList: TStrings;
|
199 |
function GetValues: TStrings;
|
200 |
procedure SetField(Index: Integer; const NewValue: String);
|
201 |
procedure SetFieldByName(const FieldName: String; const NewValue: String);
|
202 |
procedure SetQuoteAlways(const Value: Boolean);
|
203 |
procedure SetQuoteIfSpaces(const Value: Boolean);
|
204 |
procedure SetSchema(const Value: TStTextDataSchema);
|
205 |
public
|
206 |
constructor Create;
|
207 |
destructor Destroy; override;
|
208 |
|
209 |
{ Access and Update Methods }
|
210 |
procedure BuildRecord(Values: TStrings; var NewRecord: String); virtual;
|
211 |
function GetRecord : String; {!!.02}
|
212 |
procedure DoQuote(var Value: String); virtual;
|
213 |
procedure FillRecordFromArray(Values: array of const);
|
214 |
procedure FillRecordFromList(Items: TStrings);
|
215 |
procedure FillRecordFromValues(Values: TStrings);
|
216 |
procedure MakeEmpty; virtual;
|
217 |
|
218 |
{ properties }
|
219 |
property AsString : String {!!.02}
|
220 |
// read FValue {write SetValue}; {!!.02}
|
221 |
read GetRecord;
|
222 |
property FieldByName[const FieldName : String] : String
|
223 |
read GetFieldByName write SetFieldByName;
|
224 |
property FieldCount : Integer
|
225 |
read GetFieldCount;
|
226 |
property FieldList : TStrings
|
227 |
read GetFieldList;
|
228 |
property Fields[Index : Integer] : String
|
229 |
read GetField write SetField;
|
230 |
property QuoteAlways : Boolean
|
231 |
read FQuoteAlways write SetQuoteAlways default False;
|
232 |
property QuoteIfSpaces : Boolean
|
233 |
read FQuoteIfSpaces write SetQuoteIfSpaces default False;
|
234 |
property Schema : TStTextDataSchema
|
235 |
read FSchema write SetSchema;
|
236 |
property Values : TStrings
|
237 |
read GetValues;
|
238 |
|
239 |
{ events }
|
240 |
property OnQuoteField : TStOnQuoteFieldEvent
|
241 |
read FOnQuoteField write FOnQuoteField;
|
242 |
end;
|
243 |
|
244 |
TStTextDataRecordSet = class
|
245 |
private
|
246 |
FActive: Boolean;
|
247 |
FCurrentIndex : Integer;
|
248 |
FIsDirty: Boolean;
|
249 |
FRecords: TList;
|
250 |
FSchema: TStTextDataSchema;
|
251 |
FAtEndOfFile : Boolean; {!!.01}
|
252 |
FIgnoreStartingLines : Integer; {!!.02}
|
253 |
protected {private}
|
254 |
function GetCount: Integer;
|
255 |
function GetCurrentRecord: TStTextDataRecord;
|
256 |
function GetRecord(Index: Integer): TStTextDataRecord;
|
257 |
function GetSchema: TStTextDataSchema;
|
258 |
procedure SetActive(const Value: Boolean);
|
259 |
procedure SetCurrentRecord(const Value: TStTextDataRecord);
|
260 |
procedure SetRecord(Index: Integer; const Value: TStTextDataRecord);
|
261 |
procedure SetSchema(const Value: TStTextDataSchema);
|
262 |
|
263 |
public
|
264 |
constructor Create;
|
265 |
destructor Destroy; override;
|
266 |
|
267 |
{ Access and Update Methods }
|
268 |
procedure Append;
|
269 |
procedure AppendArray(Values : array of const);
|
270 |
procedure AppendList(Items : TStrings);
|
271 |
procedure AppendValues(Values : TStrings);
|
272 |
procedure Clear;
|
273 |
procedure Delete;
|
274 |
procedure Insert(Index : Integer);
|
275 |
procedure InsertArray(Index: Integer; Values : array of const);
|
276 |
procedure InsertList(Index : Integer; Items : TStrings);
|
277 |
procedure InsertValues(Index : Integer; Values : TStrings);
|
278 |
|
279 |
{ navigation methods }
|
280 |
function BOF : Boolean;
|
281 |
function EOF : Boolean;
|
282 |
procedure First;
|
283 |
procedure Last;
|
284 |
function Next : Boolean;
|
285 |
function Prior : Boolean;
|
286 |
|
287 |
{ Persistence and streaming methods }
|
288 |
procedure LoadFromFile(const AFile : TFileName);
|
289 |
procedure LoadFromStream(AStream : TStream);
|
290 |
procedure SaveToFile(const AFile : TFileName);
|
291 |
procedure SaveToStream(AStream : TStream);
|
292 |
|
293 |
{ properties }
|
294 |
property Active : Boolean
|
295 |
read FActive write SetActive;
|
296 |
property Count : Integer
|
297 |
read GetCount;
|
298 |
property CurrentRecord : TStTextDataRecord
|
299 |
read GetCurrentRecord write SetCurrentRecord;
|
300 |
property IsDirty : Boolean
|
301 |
read FIsDirty;
|
302 |
property Records[Index : Integer] : TStTextDataRecord
|
303 |
read GetRecord write SetRecord;
|
304 |
property Schema : TStTextDataSchema
|
305 |
read GetSchema write SetSchema;
|
306 |
property IgnoreStartingLines : Integer {!!.02}
|
307 |
read FIgnoreStartingLines write FIgnoreStartingLines default 0; {!!.02}
|
308 |
end;
|
309 |
|
310 |
procedure StParseLine(const Data : String; Schema : TStTextDataSchema; Result : TStrings);
|
311 |
function StFieldTypeToStr(FieldType : TStSchemaFieldType) : String;
|
312 |
function StStrToFieldType(const S : String) : TStSchemaFieldType;
|
313 |
function StDeEscape(const EscStr : String): Char;
|
314 |
function StDoEscape(Delim : Char): String;
|
315 |
function StTrimTrailingChars(const S : String; Trailer : Char) : String; {!!.01}
|
316 |
|
317 |
implementation
|
318 |
|
319 |
procedure StParseLine(const Data : String; Schema : TStTextDataSchema;
|
320 |
Result : TStrings);
|
321 |
{ split a line of delimited data according to provided schema into
|
322 |
<name>=<value> pairs into Result }
|
323 |
var
|
324 |
DataLine : TStTextDataRecord;
|
325 |
ownSchema : Boolean;
|
326 |
begin
|
327 |
{ need a valid TStrings to work with }
|
328 |
if not Assigned(Result) then Exit;
|
329 |
|
330 |
|
331 |
ownSchema := False;
|
332 |
{ if no Schema to use passed in, create a default schema }
|
333 |
if not Assigned(Schema) then begin
|
334 |
Schema := TStTextDataSchema.Create;
|
335 |
ownSchema := True; { we made it we, s have to free it }
|
336 |
end;
|
337 |
|
338 |
DataLine := TStTextDataRecord.Create;
|
339 |
try
|
340 |
DataLine.Schema := Schema;
|
341 |
DataLine.FValue := Data;
|
342 |
Result.Assign(DataLine.FieldList);
|
343 |
finally
|
344 |
DataLine.Free;
|
345 |
{ free the Schema if needed }
|
346 |
if ownSchema then
|
347 |
Schema.Free;
|
348 |
end;
|
349 |
end;
|
350 |
|
351 |
{ TStDataField }
|
352 |
|
353 |
function StFieldTypeToStr(FieldType : TStSchemaFieldType) : String;
|
354 |
{ convert TStSchemaFieldType enum into matching string for BDE schema }
|
355 |
begin
|
356 |
Result := '';
|
357 |
case FieldType of
|
358 |
sftChar : Result := 'CHAR';
|
359 |
sftFloat : Result := 'FLOAT';
|
360 |
sftNumber : Result := 'NUMBER';
|
361 |
sftBool : Result := 'BOOL';
|
362 |
sftLongInt : Result := 'LONGINT';
|
363 |
sftDate : Result := 'DATE';
|
364 |
sftTime : Result := 'TIME';
|
365 |
sftTimeStamp : Result := 'TIMESTAMP';
|
366 |
|
367 |
else
|
368 |
Result := '';
|
369 |
end;
|
370 |
end;
|
371 |
|
372 |
function StStrToFieldType(const S : String) : TStSchemaFieldType;
|
373 |
{ convert string to TStSchemaFieldType constant }
|
374 |
var
|
375 |
Value : Integer;
|
376 |
begin
|
377 |
Value := GetEnumValue(TypeInfo(TStSchemaFieldType), S);
|
378 |
if Value > -1 then
|
379 |
Result := TStSchemaFieldType(Value)
|
380 |
else
|
381 |
Result := sftUnknown;
|
382 |
end;
|
383 |
|
384 |
{!!.01 - Added}
|
385 |
function StTrimTrailingChars(const S : String; Trailer : Char) : String;
|
386 |
{
|
387 |
Return a string with specified trailing character removed,
|
388 |
useful for cleanup of fixed data records
|
389 |
}
|
390 |
var
|
391 |
Len : LongInt;
|
392 |
begin
|
393 |
Result := S;
|
394 |
Len := Length(S);
|
395 |
while (Len > 0) and (Result[Len] = Trailer) do
|
396 |
Dec(Len);
|
397 |
SetLength(Result, Len);
|
398 |
end;
|
399 |
{!!.01 - End Added}
|
400 |
|
401 |
function TStDataField.GetAsString: String;
|
402 |
{ build string representation of field to match BDE style }
|
403 |
{
|
404 |
Format :
|
405 |
<name>,<type>,<width>,<decimals>,<offset>
|
406 |
}
|
407 |
begin
|
408 |
Result := FFieldName + ',' + StFieldTypeToStr(FFieldType) + ',' +
|
409 |
{ zero pad width, decimals, and offset to at least two places
|
410 |
to match BDE Schema formatting }
|
411 |
Format('%.2d,%.2d,%.2d', [FFieldLen, FFieldDecimals, FFieldOffset]);
|
412 |
end;
|
413 |
|
414 |
procedure TStDataField.SetFieldDecimals(const Value: Integer);
|
415 |
begin
|
416 |
FFieldDecimals := Value;
|
417 |
end;
|
418 |
|
419 |
procedure TStDataField.SetFieldLen(const Value: Integer);
|
420 |
begin
|
421 |
FFieldLen := Value;
|
422 |
end;
|
423 |
|
424 |
procedure TStDataField.SetFieldName(const Value: String);
|
425 |
begin
|
426 |
FFieldName := Value;
|
427 |
end;
|
428 |
|
429 |
procedure TStDataField.SetFieldOffset(const Value: Integer);
|
430 |
begin
|
431 |
FFieldOffset := Value;
|
432 |
end;
|
433 |
|
434 |
procedure TStDataField.SetFieldType(const Value: TStSchemaFieldType);
|
435 |
begin
|
436 |
FFieldType := Value;
|
437 |
end;
|
438 |
|
439 |
|
440 |
{ TStDataFieldList }
|
441 |
|
442 |
function CharPosIdx(C: Char; const S : String; Idx: Integer): Integer;
|
443 |
{ Find leftmost occurrence of character C in string S past location Idx }
|
444 |
{
|
445 |
If C not found returns 0
|
446 |
}
|
447 |
var
|
448 |
Len : Integer;
|
449 |
begin
|
450 |
Len := Length(S);
|
451 |
if (Idx > Len) or (Idx < 1) then begin
|
452 |
Result := 0;
|
453 |
Exit;
|
454 |
end;
|
455 |
|
456 |
Result := Idx;
|
457 |
while (Result <= Len) and (S[Result] <> C) do
|
458 |
Inc(Result);
|
459 |
if Result > Len then
|
460 |
Result := 0;
|
461 |
end;
|
462 |
|
463 |
procedure SplitFieldStr(const Source: String; var Name: String;
|
464 |
var FieldType: TStSchemaFieldType; var ValLen, Decimals, Offset: Integer);
|
465 |
{ split field description string according to BDE Schema layout }
|
466 |
{
|
467 |
Format :
|
468 |
<name>,<type>,<width>,<decimals>,<offset>
|
469 |
}
|
470 |
var
|
471 |
CommaPos, LastPos : Cardinal;
|
472 |
TempS : String;
|
473 |
begin
|
474 |
CommaPos := 1;
|
475 |
LastPos := CommaPos;
|
476 |
CommaPos := CharPosIdx(',', Source, CommaPos);
|
477 |
if CommaPos = 0 then CommaPos := Length(Source) + 1;
|
478 |
Name := Copy(Source, LastPos, CommaPos - LastPos);
|
479 |
|
480 |
Inc(CommaPos);
|
481 |
LastPos := CommaPos;
|
482 |
CommaPos := CharPosIdx(',', Source, CommaPos);
|
483 |
if CommaPos = 0 then CommaPos := Length(Source) + 1;
|
484 |
TempS := Copy(Source, LastPos, CommaPos - LastPos);
|
485 |
FieldType := StStrToFieldType('sft' + TempS);
|
486 |
|
487 |
Inc(CommaPos);
|
488 |
LastPos := CommaPos;
|
489 |
CommaPos := CharPosIdx(',', Source, CommaPos);
|
490 |
if CommaPos = 0 then CommaPos := Length(Source) + 1;
|
491 |
ValLen := StrToInt(Copy(Source, LastPos, CommaPos - LastPos));
|
492 |
|
493 |
Inc(CommaPos);
|
494 |
LastPos := CommaPos;
|
495 |
CommaPos := CharPosIdx(',', Source, CommaPos);
|
496 |
if CommaPos = 0 then CommaPos := Length(Source) + 1;
|
497 |
Decimals := StrToInt(Copy(Source, LastPos, CommaPos - LastPos));
|
498 |
|
499 |
Inc(CommaPos);
|
500 |
LastPos := CommaPos;
|
501 |
CommaPos := CharPosIdx(',', Source, CommaPos);
|
502 |
if CommaPos = 0 then CommaPos := Length(Source) + 1;
|
503 |
Offset := StrToInt(Copy(Source, LastPos, CommaPos - LastPos));
|
504 |
end;
|
505 |
|
506 |
constructor TStDataFieldList.Create;
|
507 |
begin
|
508 |
inherited Create;
|
509 |
FList := TStringList.Create;
|
510 |
end;
|
511 |
|
512 |
destructor TStDataFieldList.Destroy;
|
513 |
begin
|
514 |
FList.Free;
|
515 |
inherited Destroy;
|
516 |
end;
|
517 |
|
518 |
procedure TStDataFieldList.AddField(const FieldName: String;
|
519 |
FieldType: TStSchemaFieldType; FieldLen, FieldDecimals, FieldOffset: Integer);
|
520 |
var
|
521 |
Item : TStDataField;
|
522 |
Idx : Integer;
|
523 |
begin
|
524 |
{ see if another field with the name exists }
|
525 |
Idx := FList.IndexOf(FieldName);
|
526 |
if (Idx > -1) then
|
527 |
raise EStException.CreateResTP(stscTxtDatUniqueNameRequired, 0);
|
528 |
|
529 |
{ build new item }
|
530 |
Item := TStDataField.Create;
|
531 |
try
|
532 |
Item.FieldName := FieldName;
|
533 |
Item.FieldType := FieldType;
|
534 |
Item.FieldLen := FieldLen;
|
535 |
Item.FieldDecimals := FieldDecimals;
|
536 |
Item.FieldOffset := FieldOffset;
|
537 |
|
538 |
{ add to list }
|
539 |
FList.AddObject(FieldName, Item);
|
540 |
except
|
541 |
Item.Free;
|
542 |
end;
|
543 |
end;
|
544 |
|
545 |
procedure TStDataFieldList.AddFieldStr(const FieldDef: String);
|
546 |
var
|
547 |
Name: String;
|
548 |
FieldType: TStSchemaFieldType;
|
549 |
ValLen, Decimals, Offset: Integer;
|
550 |
begin
|
551 |
SplitFieldStr(FieldDef, Name, FieldType, ValLen, Decimals, Offset);
|
552 |
AddField(Name, FieldType, ValLen, Decimals, Offset);
|
553 |
end;
|
554 |
|
555 |
procedure TStDataFieldList.Clear;
|
556 |
var
|
557 |
Idx : Integer;
|
558 |
begin
|
559 |
for Idx := Pred(FList.Count) downto 0 do begin
|
560 |
{ Free associated object and then delete the StringList entry }
|
561 |
FList.Objects[Idx].Free;
|
562 |
FList.Delete(Idx);
|
563 |
end;
|
564 |
end;
|
565 |
|
566 |
procedure TStDataFieldList.RemoveField(const FieldName: String);
|
567 |
var
|
568 |
Idx : Integer;
|
569 |
begin
|
570 |
{ locate field }
|
571 |
Idx := FList.IndexOf(FieldName);
|
572 |
|
573 |
{ if it exists }
|
574 |
if Idx > -1 then begin
|
575 |
{ Free associated object and then delete the StringList entry }
|
576 |
FList.Objects[Idx].Free;
|
577 |
FList.Delete(Idx);
|
578 |
end
|
579 |
else
|
580 |
{ no such field, complain... }
|
581 |
raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
|
582 |
end;
|
583 |
|
584 |
function TStDataFieldList.GetFieldByName(
|
585 |
const FieldName: String): TStDataField;
|
586 |
var
|
587 |
Idx : Integer;
|
588 |
begin
|
589 |
{ locate field }
|
590 |
Idx := FList.IndexOf(FieldName);
|
591 |
|
592 |
{ if it exists }
|
593 |
if Idx > -1 then begin
|
594 |
{ return associated object }
|
595 |
Result := TStDataField(FList.Objects[Idx]);
|
596 |
end
|
597 |
else
|
598 |
{ no such field, complain... }
|
599 |
raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
|
600 |
end;
|
601 |
|
602 |
function TStDataFieldList.GetField(Index: Integer): TStDataField;
|
603 |
{ return requested field if in range }
|
604 |
begin
|
605 |
if (Index > -1) and (Index < FList.Count) then
|
606 |
Result := TStDataField(FList.Objects[Index])
|
607 |
else
|
608 |
{ no such field, complain... }
|
609 |
raise EStException.CreateResTP(stscBadIndex, 0);
|
610 |
end;
|
611 |
|
612 |
procedure TStDataFieldList.SetFieldByName(const FieldName: String;
|
613 |
const Value: TStDataField);
|
614 |
var
|
615 |
Idx : Integer;
|
616 |
begin
|
617 |
{ see if another field with the name exists }
|
618 |
Idx := FList.IndexOf(FieldName);
|
619 |
|
620 |
{ delete field at that index replace with new field }
|
621 |
if (Idx > -1) then begin
|
622 |
FList.Objects[Idx].Free;
|
623 |
FList.Objects[Idx] := Value;
|
624 |
end
|
625 |
else
|
626 |
{ no such field, complain... }
|
627 |
raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
|
628 |
end;
|
629 |
|
630 |
procedure TStDataFieldList.SetField(Index: Integer;
|
631 |
const Value: TStDataField);
|
632 |
var
|
633 |
Idx : Integer;
|
634 |
begin
|
635 |
{ see if another field with the name exists }
|
636 |
Idx := FList.IndexOf(Value.FieldName);
|
637 |
if (Idx > -1) and (Idx <> Index) then
|
638 |
raise EStException.CreateResTP(stscTxtDatUniqueNameRequired, 0);
|
639 |
|
640 |
{ delete field at that index replace with new field }
|
641 |
if (Index > -1) and (Index < FList.Count) then begin
|
642 |
RemoveField(FList[Index]);
|
643 |
FList.InsertObject(Index, Value.FieldName, Value);
|
644 |
end else
|
645 |
{ no such field, complain... }
|
646 |
raise EStException.CreateResTP(stscBadIndex, 0);
|
647 |
end;
|
648 |
|
649 |
|
650 |
function TStDataFieldList.GetCount: Integer;
|
651 |
{ return count of maintained Field Items }
|
652 |
begin
|
653 |
Result := FList.Count;
|
654 |
end;
|
655 |
|
656 |
|
657 |
{ TStTextDataSchema }
|
658 |
|
659 |
constructor TStTextDataSchema.Create;
|
660 |
begin
|
661 |
inherited Create;
|
662 |
|
663 |
{ set default values }
|
664 |
FFieldDelimiter := StDefaultDelim;
|
665 |
FQuoteDelimiter := StDefaultQuote;
|
666 |
FCommentDelimiter := StDefaultComment;
|
667 |
FFixedSeparator := StDefaultFixedSep; {!!.01}
|
668 |
FLineTermChar := #0;
|
669 |
FLineTerminator := ltCRLF;
|
670 |
FLayoutType := ltUnknown;
|
671 |
|
672 |
{ create internal instances }
|
673 |
dsFieldList := TStDataFieldList.Create;
|
674 |
FSchema := TStringList.Create;
|
675 |
end;
|
676 |
|
677 |
destructor TStTextDataSchema.Destroy;
|
678 |
begin
|
679 |
{ clean up the fields list }
|
680 |
dsFieldList.Clear;
|
681 |
|
682 |
{ free internal instances }
|
683 |
dsFieldList.Free;
|
684 |
FSchema.Free;
|
685 |
|
686 |
inherited Destroy;
|
687 |
end;
|
688 |
|
689 |
procedure TStTextDataSchema.AddField(const FieldName : String;
|
690 |
FieldType : TStSchemaFieldType; FieldLen, FieldDecimals : Integer);
|
691 |
{ add new field with requested characteristics }
|
692 |
var
|
693 |
Offset : Integer;
|
694 |
LastField : TStDataField;
|
695 |
begin
|
696 |
{ calculate the offset based on the length and offset of previous fields }
|
697 |
if dsFieldList.Count > 0 then begin
|
698 |
LastField := dsFieldList.Fields[Pred(dsFieldList.Count)];
|
699 |
Offset := LastField.FieldOffset + LastField.FieldLen;
|
700 |
end
|
701 |
else
|
702 |
Offset := 0;
|
703 |
|
704 |
dsFieldList.AddField(FieldName, FieldType, FieldLen, FieldDecimals, Offset);
|
705 |
end;
|
706 |
|
707 |
procedure TStTextDataSchema.Assign(ASchema: TStTextDataSchema);
|
708 |
{ deep copy another schema }
|
709 |
var
|
710 |
i : Integer;
|
711 |
begin
|
712 |
if not Assigned(ASchema) then Exit;
|
713 |
|
714 |
{ copy properties }
|
715 |
FLayoutType := ASchema.LayoutType;
|
716 |
FFieldDelimiter := ASchema.FieldDelimiter;
|
717 |
FCommentDelimiter := ASchema.CommentDelimiter;
|
718 |
FQuoteDelimiter := ASchema.QuoteDelimiter;
|
719 |
FSchemaName := ASchema.SchemaName;
|
720 |
FLineTermChar := ASchema.LineTermChar;
|
721 |
FLineTerminator := ASchema.LineTerminator;
|
722 |
|
723 |
{ copy fields }
|
724 |
dsFieldList.Clear;
|
725 |
for i := 0 to Pred(ASchema.FieldCount) do
|
726 |
dsFieldList.AddFieldStr(ASchema.Fields[i].AsString);
|
727 |
end;
|
728 |
|
729 |
{!!.01 -- Added }
|
730 |
procedure TStTextDataSchema.BuildSchema(AList : TStrings);
|
731 |
var
|
732 |
i : Integer;
|
733 |
Field : TStDataField;
|
734 |
begin
|
735 |
{ put schema name in brackets }
|
736 |
AList.Add('[' + FSchemaName + ']');
|
737 |
|
738 |
{ layout type }
|
739 |
if FLayoutType = ltVarying then begin
|
740 |
AList.Add('FileType=VARYING');
|
741 |
AList.Add('Separator=' + StDoEscape(FFieldDelimiter));
|
742 |
end
|
743 |
else begin
|
744 |
AList.Add('FileType=FIXED');
|
745 |
AList.Add('Separator=' + StDoEscape(FFixedSeparator));
|
746 |
end;
|
747 |
|
748 |
{ other parameters }
|
749 |
AList.Add('Delimiter=' + StDoEscape(FQuoteDelimiter));
|
750 |
AList.Add('Comment=' + StDoEscape(FCommentDelimiter));
|
751 |
AList.Add('CharSet=ASCII');
|
752 |
|
753 |
{ write fields }
|
754 |
for i := 0 to Pred(dsFieldList.Count) do begin
|
755 |
Field := dsFieldList.Fields[i];
|
756 |
AList.Add('Field' + IntToStr(i + 1) + '=' + Field.AsString);
|
757 |
end;
|
758 |
end;
|
759 |
{!!.01 -- End Added }
|
760 |
|
761 |
{!!.01 -- Added }
|
762 |
procedure TStTextDataSchema.ClearFields;
|
763 |
{ remove field definitions from schema }
|
764 |
var
|
765 |
i : Integer;
|
766 |
begin
|
767 |
dsFieldList.Clear;
|
768 |
for i := Pred(FSchema.Count) downto 0 do
|
769 |
if Pos('Field', Trim(FSchema[i])) = 1 then
|
770 |
FSchema.Delete(i);
|
771 |
end;
|
772 |
{!!.01 -- End Added }
|
773 |
|
774 |
function TStTextDataSchema.GetCaptions: TStrings;
|
775 |
begin
|
776 |
Result := dsFieldList.FList;
|
777 |
end;
|
778 |
|
779 |
function TStTextDataSchema.GetFieldByName(const FieldName: String): TStDataField;
|
780 |
begin
|
781 |
Result := dsFieldList.FieldByName[FieldName];
|
782 |
end;
|
783 |
|
784 |
function TStTextDataSchema.GetFieldCount: Integer;
|
785 |
begin
|
786 |
Result := dsFieldList.Count;
|
787 |
end;
|
788 |
|
789 |
function TStTextDataSchema.GetField(Index: Integer): TStDataField;
|
790 |
begin
|
791 |
Result := dsFieldList.Fields[Index];
|
792 |
end;
|
793 |
|
794 |
{!!.01 -- Added }
|
795 |
function TStTextDataSchema.GetSchema: TStrings;
|
796 |
begin
|
797 |
FSchema.Clear;
|
798 |
BuildSchema(FSchema);
|
799 |
Result := FSchema;
|
800 |
end;
|
801 |
{!!.01 -- End Added }
|
802 |
|
803 |
function TStTextDataSchema.IndexOf(const FieldName : String): Integer;
|
804 |
{ return index of field with provided name, returns -1 if no such field is found }
|
805 |
begin
|
806 |
Result := 0;
|
807 |
while (Result < dsFieldList.Count) and
|
808 |
// (dsFieldList.Fields[Result].FieldName <> FieldName) do {!!.01}
|
809 |
(AnsiCompareText(dsFieldList.Fields[Result].FieldName, {!!.01}
|
810 |
FieldName) <> 0) {!!.01}
|
811 |
do {!!.01}
|
812 |
Inc(Result);
|
813 |
if Result >= dsFieldList.Count then
|
814 |
Result := -1; { not found }
|
815 |
end;
|
816 |
|
817 |
procedure TStTextDataSchema.LoadFromFile(const AFileName: TFileName);
|
818 |
var
|
819 |
FS : TFileStream;
|
820 |
begin
|
821 |
FS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
822 |
try
|
823 |
LoadFromStream(FS);
|
824 |
finally
|
825 |
FS.Free;
|
826 |
end;
|
827 |
end;
|
828 |
|
829 |
function StDoEscape(Delim : Char): String;
|
830 |
{
|
831 |
Escapes non-printable characters to Borlandish Pascal "#nnn" constants
|
832 |
}
|
833 |
begin
|
834 |
if Delim in [#33..#126, #128..#255] then
|
835 |
Result := Delim
|
836 |
else
|
837 |
Result := '#' + IntToStr(Ord(Delim));
|
838 |
end;
|
839 |
|
840 |
|
841 |
function StDeEscape(const EscStr : String): Char;
|
842 |
{
|
843 |
converts "escaped" strings of the forms:
|
844 |
"#nn" Borlandish Pascal numeric character constants
|
845 |
^l Borlandish Pascal control character constants
|
846 |
into equivalent characters, "##" is treated as the '#' character alone
|
847 |
|
848 |
if the string doesn't constitute such an escape sequence, the first
|
849 |
character is returned
|
850 |
}
|
851 |
var
|
852 |
S : String;
|
853 |
C : Char;
|
854 |
ChrVal : Byte;
|
855 |
begin
|
856 |
S := Trim(EscStr);
|
857 |
|
858 |
{ if string doesn't start with escape or it's only one character long
|
859 |
just return first character }
|
860 |
if (Length(S) = 1) or ((S[1] <> '#') and (S[1] <> '^')) then begin
|
861 |
Result := S[1];
|
862 |
Exit;
|
863 |
end;
|
864 |
|
865 |
{ treat '##' as escape for '#' and '^^' as escape for '^' }
|
866 |
if ((S[1] = '#') and (S[2] = '#')) or
|
867 |
((S[1] = '^') and (S[2] = '^')) then
|
868 |
begin
|
869 |
Result := '#';
|
870 |
Exit;
|
871 |
end;
|
872 |
|
873 |
{ otherwise try to handle escaped character }
|
874 |
case S[1] of
|
875 |
'#':begin
|
876 |
ChrVal := StrToIntDef(Copy(S, 2,Length(S)-1), Ord(StDefaultDelim));
|
877 |
if Chr(ChrVal) in [#1..#126] then
|
878 |
Result := Chr(ChrVal)
|
879 |
else
|
880 |
Result := StDefaultDelim;
|
881 |
end;
|
882 |
|
883 |
'^': begin { control character format }
|
884 |
C := Chr(Ord(S[2]) - $40);
|
885 |
if C in [^A..^_] then
|
886 |
Result := C
|
887 |
else
|
888 |
Result := StDefaultDelim;
|
889 |
end;
|
890 |
|
891 |
else
|
892 |
Result := S[1];
|
893 |
end; {case}
|
894 |
end;
|
895 |
|
896 |
procedure TStTextDataSchema.LoadFromStream(AStream: TStream);
|
897 |
var
|
898 |
TS : TStAnsiTextStream;
|
899 |
begin
|
900 |
TS := TStAnsiTextStream.Create(AStream);
|
901 |
try
|
902 |
FSchema.Clear; {!!.01}
|
903 |
while not TS.AtEndOfStream do
|
904 |
FSchema.Add(TS.ReadLine);
|
905 |
{ code to extract Schema properties moved to Update routine } {!!.01}
|
906 |
Update(FSchema); {!!.01}
|
907 |
|
908 |
finally
|
909 |
TS.Free;
|
910 |
end;
|
911 |
end;
|
912 |
|
913 |
procedure TStTextDataSchema.RemoveField(const FieldName: String);
|
914 |
begin
|
915 |
dsFieldList.RemoveField(FieldName);
|
916 |
end;
|
917 |
|
918 |
procedure TStTextDataSchema.SaveToFile(const AFileName: TFileName);
|
919 |
var
|
920 |
FS : TFileStream;
|
921 |
begin
|
922 |
if not FileExists(AFileName) then begin
|
923 |
FS := TFileStream.Create(AFileName, fmCreate);
|
924 |
FS.Free;
|
925 |
end;
|
926 |
|
927 |
if FSchemaName = '' then
|
928 |
FSchemaName := JustNameL(AFileName);
|
929 |
|
930 |
FS := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyNone);
|
931 |
|
932 |
try
|
933 |
SaveToStream(FS);
|
934 |
finally
|
935 |
FS.Free;
|
936 |
end;
|
937 |
end;
|
938 |
|
939 |
|
940 |
{
|
941 |
General format of a Schema file, based on BDE ASCII driver schema files:
|
942 |
|
943 |
; this is a comment
|
944 |
[NAME]
|
945 |
Filetype=<VARYING>|<FIXED>
|
946 |
Separator=char (default = ',' comma)
|
947 |
Delimiter=char (default = '"' double quote)
|
948 |
FieldN=<FieldName>,<FieldType>,<FieldWidth>,<FieldDecimals>,<FieldOffset>
|
949 |
; example fields:
|
950 |
Field1=Name,CHAR,20,00,00
|
951 |
Field2=Rating,CHAR,2,00,20
|
952 |
Field3=Date,DATE,10,00,22
|
953 |
Field4=Weight,Float,7,2,32
|
954 |
}
|
955 |
|
956 |
{!!.01 -- Rewritten}
|
957 |
procedure TStTextDataSchema.SaveToStream(AStream: TStream);
|
958 |
var
|
959 |
TS : TStAnsiTextStream;
|
960 |
i : Integer;
|
961 |
SL : TStringList;
|
962 |
begin
|
963 |
SL := nil;
|
964 |
TS := nil;
|
965 |
|
966 |
try
|
967 |
SL := TStringList.Create;
|
968 |
BuildSchema(SL);
|
969 |
|
970 |
TS := TStAnsiTextStream.Create(AStream);
|
971 |
for i := 0 to Pred(SL.Count) do
|
972 |
TS.WriteLine(SL[i]);
|
973 |
|
974 |
finally
|
975 |
TS.Free;
|
976 |
SL.Free;
|
977 |
end;
|
978 |
end;
|
979 |
{!!.01 -- End Rewritten}
|
980 |
|
981 |
procedure TStTextDataSchema.SetCommentDelimiter(const Value: Char);
|
982 |
begin
|
983 |
FCommentDelimiter := Value;
|
984 |
end;
|
985 |
|
986 |
procedure TStTextDataSchema.SetFieldByName(const FieldName: String;
|
987 |
const Value: TStDataField);
|
988 |
begin
|
989 |
dsFieldList.FieldByName[FieldName] := Value;
|
990 |
end;
|
991 |
|
992 |
procedure TStTextDataSchema.SetFieldDelimiter(const Value: Char);
|
993 |
begin
|
994 |
FFieldDelimiter := Value;
|
995 |
end;
|
996 |
|
997 |
procedure TStTextDataSchema.SetField(Index: Integer;
|
998 |
const Value: TStDataField);
|
999 |
begin
|
1000 |
dsFieldList.Fields[Index] := Value;
|
1001 |
end;
|
1002 |
|
1003 |
{!!.01 -- Added }
|
1004 |
procedure TStTextDataSchema.SetFixedSeparator(const Value: Char);
|
1005 |
begin
|
1006 |
FFixedSeparator := Value;
|
1007 |
end;
|
1008 |
{!!.01 -- End Added }
|
1009 |
|
1010 |
procedure TStTextDataSchema.SetLayoutType(const Value: TStSchemaLayoutType);
|
1011 |
begin
|
1012 |
FLayoutType := Value;
|
1013 |
end;
|
1014 |
|
1015 |
procedure TStTextDataSchema.SetQuoteDelimiter(const Value: Char);
|
1016 |
begin
|
1017 |
FQuoteDelimiter := Value;
|
1018 |
end;
|
1019 |
|
1020 |
procedure TStTextDataSchema.SetSchema(const Value: TStrings);
|
1021 |
begin
|
1022 |
FSchema.Assign(Value); {!!.01}
|
1023 |
Update(FSchema); {!!.01}
|
1024 |
end;
|
1025 |
|
1026 |
procedure TStTextDataSchema.SetSchemaName(const Value: String);
|
1027 |
begin
|
1028 |
FSchemaName := Value;
|
1029 |
end;
|
1030 |
|
1031 |
{!!.01 -- Added }
|
1032 |
procedure TStTextDataSchema.Update(AList : TStrings);
|
1033 |
var
|
1034 |
ValStr : String;
|
1035 |
Idx : Integer;
|
1036 |
begin
|
1037 |
for Idx := 0 to Pred(AList.Count) do begin
|
1038 |
ValStr := AList[Idx];
|
1039 |
|
1040 |
{ if line isn't blank }
|
1041 |
if ValStr <> '' then begin
|
1042 |
|
1043 |
{ assume it's the schema name }
|
1044 |
if (ValStr[1] = '[') and (ValStr[Length(ValStr)] = ']') then
|
1045 |
SchemaName := Copy(ValStr, 2, Length(ValStr) - 2)
|
1046 |
else
|
1047 |
{ assume the line is a comment }
|
1048 |
if ValStr[1] = FCommentDelimiter {';'} then
|
1049 |
{ ignore it };
|
1050 |
{ else, it's blank, so skip it }
|
1051 |
end;
|
1052 |
|
1053 |
end;
|
1054 |
|
1055 |
{ extract other Schema Info }
|
1056 |
{ get layout type }
|
1057 |
ValStr := AList.Values['Filetype'];
|
1058 |
if UpperCase(ValStr) = 'VARYING' then
|
1059 |
FLayoutType := ltVarying
|
1060 |
else
|
1061 |
if UpperCase(ValStr) = 'FIXED' then
|
1062 |
FLayoutType := ltFixed
|
1063 |
else
|
1064 |
FLayoutType := ltUnknown;
|
1065 |
|
1066 |
{ get field separator for schema }
|
1067 |
ValStr := AList.Values['Separator'];
|
1068 |
if Length(ValStr) > 0 then
|
1069 |
FFieldDelimiter := StDeEscape(ValStr)
|
1070 |
else
|
1071 |
case FLayoutType of {!!.01}
|
1072 |
ltFixed : FFieldDelimiter := StDefaultFixedSep; {!!.01}
|
1073 |
ltVarying: FFieldDelimiter := StDefaultDelim; {!!.01}
|
1074 |
end; {!!.01}
|
1075 |
|
1076 |
{ get quote delimiter for schema }
|
1077 |
ValStr := AList.Values['Delimiter'];
|
1078 |
if Length(ValStr) > 0 then
|
1079 |
FQuoteDelimiter := StDeEscape(ValStr)
|
1080 |
else
|
1081 |
FQuoteDelimiter := StDefaultQuote;
|
1082 |
|
1083 |
{ get quote delimiter for schema }
|
1084 |
ValStr := AList.Values['Comment'];
|
1085 |
if Length(ValStr) > 0 then
|
1086 |
FCommentDelimiter := StDeEscape(ValStr)
|
1087 |
else
|
1088 |
FCommentDelimiter := StDefaultQuote;
|
1089 |
|
1090 |
{ build fields list }
|
1091 |
Idx := 1;
|
1092 |
dsFieldList.Clear;
|
1093 |
ValStr := AList.Values['Field' + IntToStr(Idx)];
|
1094 |
while ValStr <> '' do begin
|
1095 |
dsFieldList.AddFieldStr(ValStr);
|
1096 |
Inc(Idx);
|
1097 |
ValStr := AList.Values['Field' + IntToStr(Idx)];
|
1098 |
end;
|
1099 |
end;
|
1100 |
{!!.01 -- End Added }
|
1101 |
|
1102 |
|
1103 |
{ TStTextDataRecord }
|
1104 |
|
1105 |
constructor TStTextDataRecord.Create;
|
1106 |
begin
|
1107 |
inherited Create;
|
1108 |
|
1109 |
{ set default values }
|
1110 |
FValue := '';
|
1111 |
FQuoteAlways := False;
|
1112 |
FQuoteIfSpaces := False;
|
1113 |
|
1114 |
{ create internal instances }
|
1115 |
FFieldList := TStringList.Create;
|
1116 |
end;
|
1117 |
|
1118 |
destructor TStTextDataRecord.Destroy;
|
1119 |
begin
|
1120 |
{ free internal instances }
|
1121 |
FFieldList.Free;
|
1122 |
|
1123 |
inherited Destroy;
|
1124 |
end;
|
1125 |
|
1126 |
procedure TStTextDataRecord.BuildRecord(Values : TStrings; var NewRecord : String);
|
1127 |
{ re-construct record structure from list of field values }
|
1128 |
var
|
1129 |
i : Integer;
|
1130 |
Temp : String;
|
1131 |
begin
|
1132 |
NewRecord := '';
|
1133 |
|
1134 |
for i := 0 to Pred(Values.Count) do begin
|
1135 |
Temp := Values[i];
|
1136 |
|
1137 |
{ re-quote value if needed }
|
1138 |
DoQuote(Temp);
|
1139 |
|
1140 |
{ add value onto record }
|
1141 |
if i = 0 then
|
1142 |
NewRecord := Temp
|
1143 |
else
|
1144 |
NewRecord := NewRecord + FSchema.FieldDelimiter + Temp;
|
1145 |
end;
|
1146 |
end;
|
1147 |
|
1148 |
procedure TStTextDataRecord.DoQuote(var Value : String);
|
1149 |
{ quote field string if needed or desired }
|
1150 |
var
|
1151 |
QuoteIt : Boolean;
|
1152 |
begin
|
1153 |
{ fire event if available }
|
1154 |
if Assigned(FOnQuoteField) then begin
|
1155 |
FOnQuoteField(self, Value);
|
1156 |
end
|
1157 |
else begin { use default quoting policy }
|
1158 |
QuoteIt := False;
|
1159 |
if FQuoteAlways then
|
1160 |
QuoteIt := True
|
1161 |
else
|
1162 |
if ((Pos(' ', Value) > 0) and FQuoteIfSpaces)
|
1163 |
or (Pos(FSchema.FieldDelimiter, Value) > 0)
|
1164 |
then
|
1165 |
QuoteIt := True;
|
1166 |
|
1167 |
if QuoteIt then
|
1168 |
Value := FSchema.QuoteDelimiter + Value + FSchema.QuoteDelimiter;
|
1169 |
end;
|
1170 |
end;
|
1171 |
|
1172 |
function ConvertValue(Value : TVarRec) : String;
|
1173 |
{ convert variant record to equivalent string }
|
1174 |
const
|
1175 |
BoolChars: array[Boolean] of Char = ('F', 'T');
|
1176 |
begin
|
1177 |
case Value.VType of
|
1178 |
vtAnsiString: Result := AnsiString(Value.VAnsiString);
|
1179 |
{$IFDEF UNICODE}
|
1180 |
vtUnicodeString: Result := UnicodeString(Value.VUnicodeString);
|
1181 |
vtWideString: Result := WideString(Value.VWideString);
|
1182 |
{$ENDIF}
|
1183 |
vtBoolean: Result := BoolChars[Value.VBoolean];
|
1184 |
vtChar: Result := Value.VChar;
|
1185 |
vtCurrency: Result := CurrToStr(Value.VCurrency^);
|
1186 |
vtExtended: Result := FloatToStr(Value.VExtended^);
|
1187 |
vtInteger: Result := IntToStr(Value.VInteger);
|
1188 |
vtPChar: Result := Value.VPChar;
|
1189 |
vtString: Result := Value.VString^;
|
1190 |
{$IFDEF VERSION4}
|
1191 |
vtInt64: Result := IntToStr(Value.VInt64^);
|
1192 |
{$ENDIF VERSION4}
|
1193 |
else
|
1194 |
raise EStException.CreateResTP(stscTxtDatUnhandledVariant, 0);
|
1195 |
end;
|
1196 |
end;
|
1197 |
|
1198 |
procedure TStTextDataRecord.FillRecordFromArray(Values : array of const);
|
1199 |
{ supply field values from a variant open array }
|
1200 |
var
|
1201 |
i, j : Integer;
|
1202 |
begin
|
1203 |
{$IFDEF Version4}
|
1204 |
if Length(Values) > 0 then begin
|
1205 |
{$ENDIF}
|
1206 |
i := 0;
|
1207 |
j := Low(Values);
|
1208 |
while (j <= High(Values)) and (i < Schema.FieldCount) do begin
|
1209 |
SetField(i, ConvertValue(Values[j]));
|
1210 |
Inc(i);
|
1211 |
Inc(j);
|
1212 |
end;
|
1213 |
{$IFDEF Version4}
|
1214 |
end;
|
1215 |
{$ENDIF}
|
1216 |
end;
|
1217 |
|
1218 |
procedure TStTextDataRecord.FillRecordFromList(Items : TStrings);
|
1219 |
{ supply field values from <name>=<value> pairs }
|
1220 |
{
|
1221 |
Fields filled from pairs provided in TStrings
|
1222 |
<NAME> entries in Items that don't match Field Names are ignored
|
1223 |
Fields with Names having no corresponding entry in Items are left empty
|
1224 |
}
|
1225 |
var
|
1226 |
i : Integer;
|
1227 |
FN : String;
|
1228 |
begin
|
1229 |
if Assigned(Items) then begin
|
1230 |
for i := 0 to Pred(Schema.FieldCount) do begin
|
1231 |
FN := Schema.Fields[i].FieldName;
|
1232 |
FieldByName[FN] := Items.Values[FN];
|
1233 |
end;
|
1234 |
end;
|
1235 |
end;
|
1236 |
|
1237 |
procedure TStTextDataRecord.FillRecordFromValues(Values : TStrings);
|
1238 |
{ supply field values from a list of values }
|
1239 |
{
|
1240 |
Fields filled from Values provided in TStrings
|
1241 |
if more Values than Fields, extras are ignored
|
1242 |
if fewer Values than Fields, remaining Fields are left empty
|
1243 |
}
|
1244 |
var
|
1245 |
i : Integer;
|
1246 |
begin
|
1247 |
if Assigned(Values) then begin
|
1248 |
i := 0;
|
1249 |
while (i < Values.Count) and (i < Schema.FieldCount) do begin
|
1250 |
SetField(i, Values[i]);
|
1251 |
Inc(i);
|
1252 |
end;
|
1253 |
end;
|
1254 |
end;
|
1255 |
|
1256 |
|
1257 |
function TStTextDataRecord.GetFieldByName(const FieldName: String): String;
|
1258 |
{ retrieve value of field in current record with given name }
|
1259 |
var
|
1260 |
Idx : Integer;
|
1261 |
begin
|
1262 |
Result := '';
|
1263 |
Idx := FSchema.IndexOf(FieldName);
|
1264 |
if Idx > -1 then
|
1265 |
Result := GetField(Idx)
|
1266 |
else
|
1267 |
raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
|
1268 |
end;
|
1269 |
|
1270 |
function TStTextDataRecord.GetField(Index: Integer): String;
|
1271 |
{ retrieve value of field in current record at given index }
|
1272 |
var
|
1273 |
Len, Offset: Integer;
|
1274 |
DataField : TStDataField;
|
1275 |
Fields : TStringList;
|
1276 |
begin
|
1277 |
if (Index < -1) or (Index > Pred(FSchema.FieldCount)) then
|
1278 |
raise EStException.CreateResTP(stscBadIndex, 0);
|
1279 |
|
1280 |
{ get characteristics of the field of interest }
|
1281 |
DataField := FSchema.Fields[Index];
|
1282 |
Len := DataField.FieldLen;
|
1283 |
{ Decimals := DataField.FieldDecimals; }
|
1284 |
Offset := DataField.FFieldOffset;
|
1285 |
|
1286 |
|
1287 |
{ extract field data from record }
|
1288 |
case FSchema.LayoutType of
|
1289 |
ltFixed : begin
|
1290 |
{ note: Offset is zero based, strings are 1 based } {!!.01}
|
1291 |
Result := Copy(FValue, Offset + 1, Len); {!!.01}
|
1292 |
end;
|
1293 |
|
1294 |
ltVarying : begin
|
1295 |
Fields := TStringList.Create;
|
1296 |
try
|
1297 |
ExtractTokensL(FValue, FSchema.FieldDelimiter, FSchema.QuoteDelimiter,
|
1298 |
True, Fields);
|
1299 |
Result := Fields[Index];
|
1300 |
finally
|
1301 |
Fields.Free;
|
1302 |
end;
|
1303 |
end;
|
1304 |
|
1305 |
ltUnknown : begin
|
1306 |
raise EStException.CreateResTP(stscTxtDatInvalidSchema, 0);
|
1307 |
end;
|
1308 |
end; {case}
|
1309 |
end;
|
1310 |
|
1311 |
function TStTextDataRecord.GetFieldCount: Integer;
|
1312 |
begin
|
1313 |
GetFieldList; {!!.02}
|
1314 |
Result := FFieldList.Count;
|
1315 |
end;
|
1316 |
|
1317 |
function TStTextDataRecord.GetFieldList: TStrings;
|
1318 |
{ convert fields of current record into TStrings collection
|
1319 |
of <name>=<value> pairs }
|
1320 |
var
|
1321 |
i : Integer;
|
1322 |
FN : String;
|
1323 |
begin
|
1324 |
FFieldList.Clear;
|
1325 |
|
1326 |
for i := 0 to Pred(FSchema.FieldCount) do begin
|
1327 |
FN := FSchema.Fields[i].FieldName;
|
1328 |
FFieldList.Add(FN + '=' + FieldByName[FN]);
|
1329 |
end;
|
1330 |
|
1331 |
Result := FFieldList;
|
1332 |
end;
|
1333 |
|
1334 |
function TStTextDataRecord.GetValues: TStrings;
|
1335 |
var
|
1336 |
i : Integer;
|
1337 |
FN : String;
|
1338 |
begin
|
1339 |
FFieldList.Clear;
|
1340 |
|
1341 |
for i := 0 to Pred(FSchema.FieldCount) do begin
|
1342 |
FN := FSchema.Fields[i].FieldName;
|
1343 |
FFieldList.Add(FieldByName[FN]);
|
1344 |
end;
|
1345 |
|
1346 |
Result := FFieldList;
|
1347 |
end;
|
1348 |
|
1349 |
procedure TStTextDataRecord.MakeEmpty;
|
1350 |
{ create an empty record according to schema layout }
|
1351 |
var
|
1352 |
i, Width, FieldPos : Integer;
|
1353 |
begin
|
1354 |
case FSchema.LayoutType of
|
1355 |
{ string of spaces, length equal to total record width }
|
1356 |
ltFixed: begin
|
1357 |
Width := 0;
|
1358 |
for i := 0 to Pred(FSchema.FieldCount) do begin {!!.01}
|
1359 |
FieldPos := FSchema.Fields[i].FieldLen + {!!.01}
|
1360 |
FSchema.Fields[i].FieldOffset + 1; {!!.01}
|
1361 |
if Width < FieldPos then {!!.01}
|
1362 |
Width := FieldPos; {!!.01}
|
1363 |
end; {!!.01}
|
1364 |
FValue := StringOfChar(FSchema.FixedSeparator, Width); {!!.01}
|
1365 |
end;
|
1366 |
|
1367 |
{ string of field separators, length equal to one less than no. of fields }
|
1368 |
ltVarying: begin
|
1369 |
FValue := StringOfChar(FSchema.FieldDelimiter, Pred(FSchema.FieldCount));
|
1370 |
end;
|
1371 |
|
1372 |
ltUnknown : begin
|
1373 |
raise EStException.CreateResTP(stscTxtDatInvalidSchema, 0);
|
1374 |
end;
|
1375 |
end;
|
1376 |
end;
|
1377 |
|
1378 |
procedure TStTextDataRecord.SetFieldByName(const FieldName: String;
|
1379 |
const NewValue: String);
|
1380 |
{ set value of field in current record with given name }
|
1381 |
var
|
1382 |
Idx : Integer;
|
1383 |
begin
|
1384 |
Idx := FSchema.IndexOf(FieldName);
|
1385 |
if Idx > -1 then
|
1386 |
SetField(Idx, NewValue)
|
1387 |
else
|
1388 |
raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
|
1389 |
end;
|
1390 |
|
1391 |
procedure TStTextDataRecord.SetField(Index: Integer;
|
1392 |
const NewValue: String);
|
1393 |
{ set value of field in current record at given index }
|
1394 |
var
|
1395 |
Len, Offset: Integer;
|
1396 |
Temp, FieldVal : String;
|
1397 |
Fields : TStringList;
|
1398 |
Idx : Integer;
|
1399 |
DataField : TStDataField;
|
1400 |
begin
|
1401 |
if (Index < -1) or (Index > Pred(FSchema.FieldCount)) then
|
1402 |
raise EStException.CreateResTP(stscBadIndex, 0);
|
1403 |
|
1404 |
{ get characteristics of the field of interest }
|
1405 |
DataField := FSchema.Fields[Index];
|
1406 |
Len := DataField.FieldLen;
|
1407 |
Offset := DataField.FFieldOffset;
|
1408 |
|
1409 |
Temp := '';
|
1410 |
|
1411 |
case FSchema.LayoutType of
|
1412 |
ltFixed : begin
|
1413 |
for Idx := 0 to Pred(FSchema.FieldCount) do begin
|
1414 |
if Idx = Index then begin
|
1415 |
{ replace field with Value right buffered or trimmed to to fit field length }
|
1416 |
if Length(NewValue) < Len then
|
1417 |
FieldVal := PadChL(NewValue, FSchema.FFixedSeparator, Len) {!!.01}
|
1418 |
else
|
1419 |
FieldVal := Copy(NewValue, 1, Len);
|
1420 |
|
1421 |
{ note: Offset is zero based, strings are 1 based }
|
1422 |
Move(FieldVal[1], FValue[Offset + 1], Len * SizeOf(Char));
|
1423 |
end;
|
1424 |
end;
|
1425 |
end;
|
1426 |
|
1427 |
ltVarying : begin
|
1428 |
Fields := TStringList.Create;
|
1429 |
try
|
1430 |
{ parse out the field values }
|
1431 |
ExtractTokensL(FValue, FSchema.FFieldDelimiter, {!!.01}
|
1432 |
FSchema.QuoteDelimiter, True, Fields); {!!.01}
|
1433 |
|
1434 |
|
1435 |
{!!.02 - rewritten }
|
1436 |
// { find field of interest }
|
1437 |
// for Idx := 0 to Pred(FSchema.FieldCount) do begin
|
1438 |
// if Idx = Index then
|
1439 |
// { set the new value }
|
1440 |
// Fields[Idx] := NewValue;
|
1441 |
|
1442 |
{ set field of interest }
|
1443 |
Fields[Index] := NewValue;
|
1444 |
|
1445 |
{ reconstruct the record }
|
1446 |
BuildRecord(Fields, FValue);
|
1447 |
// end;
|
1448 |
{!!.02 - rewritten end }
|
1449 |
|
1450 |
finally
|
1451 |
Fields.Free;
|
1452 |
end;
|
1453 |
end;
|
1454 |
|
1455 |
ltUnknown : begin
|
1456 |
raise EStException.CreateResTP(stscTxtDatInvalidSchema, 0);
|
1457 |
end;
|
1458 |
end; {case}
|
1459 |
end;
|
1460 |
|
1461 |
procedure TStTextDataRecord.SetQuoteAlways(const Value: Boolean);
|
1462 |
begin
|
1463 |
FQuoteAlways := Value;
|
1464 |
end;
|
1465 |
|
1466 |
procedure TStTextDataRecord.SetQuoteIfSpaces(const Value: Boolean);
|
1467 |
begin
|
1468 |
FQuoteIfSpaces := Value;
|
1469 |
end;
|
1470 |
|
1471 |
procedure TStTextDataRecord.SetSchema(const Value: TStTextDataSchema);
|
1472 |
begin
|
1473 |
FSchema := Value;
|
1474 |
end;
|
1475 |
|
1476 |
{!!.02 - Added }
|
1477 |
function TStTextDataRecord.GetRecord: String;
|
1478 |
var
|
1479 |
Idx : Integer;
|
1480 |
Field : String;
|
1481 |
begin
|
1482 |
Result := '';
|
1483 |
for Idx := 0 to (FSchema.FieldCount - 2) do begin
|
1484 |
Field := self.Fields[Idx];
|
1485 |
DoQuote(Field);
|
1486 |
Result := Result + Field + FSchema.FFieldDelimiter;
|
1487 |
end;
|
1488 |
Field := self.Fields[FSchema.FieldCount-1];
|
1489 |
DoQuote(Field);
|
1490 |
Result := Result + Field;
|
1491 |
end;
|
1492 |
{!!.02 - End Added }
|
1493 |
|
1494 |
{ TStTextDataRecordSet }
|
1495 |
|
1496 |
(*
|
1497 |
TStLineTerminator = ( {possible line terminators...}
|
1498 |
ltNone, {..no terminator, ie fixed length lines}
|
1499 |
ltCR, {..carriage return (#13)}
|
1500 |
ltLF, {..line feed (#10)}
|
1501 |
ltCRLF, {..carriage return/line feed (#13/#10)}
|
1502 |
ltOther); {..another character}
|
1503 |
*)
|
1504 |
|
1505 |
constructor TStTextDataRecordSet.Create;
|
1506 |
begin
|
1507 |
inherited Create;
|
1508 |
FCurrentIndex := 0;
|
1509 |
FRecords := TList.Create;
|
1510 |
FIsDirty := False;
|
1511 |
FAtEndOfFile := False; {!!.01}
|
1512 |
FIgnoreStartingLines := 0; {!!.02}
|
1513 |
end;
|
1514 |
|
1515 |
destructor TStTextDataRecordSet.Destroy;
|
1516 |
begin
|
1517 |
FRecords.Free;
|
1518 |
inherited Destroy;
|
1519 |
end;
|
1520 |
|
1521 |
procedure TStTextDataRecordSet.Append;
|
1522 |
{ append new empty record to dataset }
|
1523 |
var
|
1524 |
Rec : TStTextDataRecord;
|
1525 |
begin
|
1526 |
Rec := TStTextDataRecord.Create;
|
1527 |
Rec.Schema := Schema;
|
1528 |
Rec.MakeEmpty;
|
1529 |
FRecords.Add(Rec);
|
1530 |
FIsDirty := True;
|
1531 |
Last;
|
1532 |
end;
|
1533 |
|
1534 |
procedure TStTextDataRecordSet.AppendArray(Values : array of const);
|
1535 |
{ append new record to dataset, set field values from a variant open array }
|
1536 |
begin
|
1537 |
Append;
|
1538 |
CurrentRecord.FillRecordFromArray(Values);
|
1539 |
end;
|
1540 |
|
1541 |
procedure TStTextDataRecordSet.AppendList(Items: TStrings);
|
1542 |
{ append new record to dataset, set field values from <NAME>=<VALUE> pairs}
|
1543 |
begin
|
1544 |
Append;
|
1545 |
CurrentRecord.FillRecordFromList(Items);
|
1546 |
end;
|
1547 |
|
1548 |
procedure TStTextDataRecordSet.AppendValues(Values: TStrings);
|
1549 |
{ append new record to dataset, set field values from TStrings}
|
1550 |
begin
|
1551 |
Append;
|
1552 |
CurrentRecord.FillRecordFromValues(Values);
|
1553 |
end;
|
1554 |
|
1555 |
function TStTextDataRecordSet.BOF: Boolean;
|
1556 |
{ test if at beginning of record set }
|
1557 |
begin
|
1558 |
Result := (FCurrentIndex = 0);
|
1559 |
end;
|
1560 |
|
1561 |
procedure TStTextDataRecordSet.Clear;
|
1562 |
{ empty record set }
|
1563 |
var
|
1564 |
i : Integer;
|
1565 |
begin
|
1566 |
for i := 0 to Pred(FRecords.Count) do
|
1567 |
TStTextDataRecord(FRecords[i]).Free;
|
1568 |
FRecords.Clear;
|
1569 |
FIsDirty := False;
|
1570 |
end;
|
1571 |
|
1572 |
procedure TStTextDataRecordSet.Delete;
|
1573 |
{ delete record at current position }
|
1574 |
begin
|
1575 |
TStTextDataRecord(FRecords[FCurrentIndex]).Free;
|
1576 |
FRecords.Delete(FCurrentIndex);
|
1577 |
FIsDirty := True;
|
1578 |
Next;
|
1579 |
end;
|
1580 |
|
1581 |
function TStTextDataRecordSet.EOF: Boolean;
|
1582 |
{ test if at end of record set }
|
1583 |
begin
|
1584 |
if FAtEndOfFile then {!!.01}
|
1585 |
FAtEndOfFile := FCurrentIndex = Pred(FRecords.Count); {!!.01}
|
1586 |
Result := FAtEndOfFile {!!.01}
|
1587 |
end;
|
1588 |
|
1589 |
procedure TStTextDataRecordSet.First;
|
1590 |
{ make first record in set current }
|
1591 |
begin
|
1592 |
FCurrentIndex := 0;
|
1593 |
end;
|
1594 |
|
1595 |
function TStTextDataRecordSet.GetCount: Integer;
|
1596 |
{ return count of records in set }
|
1597 |
begin
|
1598 |
Result := FRecords.Count;
|
1599 |
end;
|
1600 |
|
1601 |
function TStTextDataRecordSet.GetRecord(Index: Integer): TStTextDataRecord;
|
1602 |
{ return particular record by index }
|
1603 |
begin
|
1604 |
if (Index > -1) and (Index < FRecords.Count) then
|
1605 |
Result := FRecords[Index]
|
1606 |
else
|
1607 |
raise EStException.CreateResTP(stscBadIndex, 0);
|
1608 |
end;
|
1609 |
|
1610 |
function TStTextDataRecordSet.GetCurrentRecord: TStTextDataRecord;
|
1611 |
{ return current record }
|
1612 |
begin
|
1613 |
Result := FRecords[FCurrentIndex];
|
1614 |
end;
|
1615 |
|
1616 |
function TStTextDataRecordSet.GetSchema: TStTextDataSchema;
|
1617 |
{ return reference to associated schema, create default one if needed }
|
1618 |
begin
|
1619 |
if not Assigned(FSchema) then
|
1620 |
FSchema := TStTextDataSchema.Create;
|
1621 |
Result := FSchema;
|
1622 |
end;
|
1623 |
|
1624 |
procedure TStTextDataRecordSet.Insert(Index: Integer);
|
1625 |
{ insert new empty record into dataset at specified location,
|
1626 |
shifts the record set down one }
|
1627 |
var
|
1628 |
Rec : TStTextDataRecord;
|
1629 |
begin
|
1630 |
Rec := TStTextDataRecord.Create;
|
1631 |
Rec.Schema := Schema;
|
1632 |
Rec.MakeEmpty;
|
1633 |
FRecords.Insert(Index, Rec);
|
1634 |
FIsDirty := True;
|
1635 |
FCurrentIndex := Index;
|
1636 |
end;
|
1637 |
|
1638 |
procedure TStTextDataRecordSet.InsertArray(Index: Integer; Values : array of const);
|
1639 |
{ insert new record into dataset dataset at specified location,
|
1640 |
shifts the record set down one,
|
1641 |
set field values from a variant open array }
|
1642 |
begin
|
1643 |
Insert(Index);
|
1644 |
CurrentRecord.FillRecordFromArray(Values);
|
1645 |
end;
|
1646 |
|
1647 |
procedure TStTextDataRecordSet.InsertList(Index: Integer;
|
1648 |
Items: TStrings);
|
1649 |
{ insert new record into dataset dataset at specified location,
|
1650 |
shifts the record set down one,
|
1651 |
set field values from <NAME>=<VALUE> pairs}
|
1652 |
begin
|
1653 |
Insert(Index);
|
1654 |
CurrentRecord.FillRecordFromList(Items);
|
1655 |
end;
|
1656 |
|
1657 |
procedure TStTextDataRecordSet.InsertValues(Index: Integer;
|
1658 |
Values: TStrings);
|
1659 |
{ insert new record into dataset dataset at specified location,
|
1660 |
shifts the record set down one,
|
1661 |
set field values from TStrings}
|
1662 |
begin
|
1663 |
Insert(Index);
|
1664 |
CurrentRecord.FillRecordFromValues(Values);
|
1665 |
end;
|
1666 |
|
1667 |
procedure TStTextDataRecordSet.Last;
|
1668 |
{ make final record in set current }
|
1669 |
begin
|
1670 |
FCurrentIndex := Pred(FRecords.Count);
|
1671 |
end;
|
1672 |
|
1673 |
procedure TStTextDataRecordSet.LoadFromFile(const AFile: TFileName);
|
1674 |
var
|
1675 |
FS : TFileStream;
|
1676 |
begin
|
1677 |
FS := TFileStream.Create(AFile, fmOpenRead or fmShareDenyNone);
|
1678 |
try
|
1679 |
LoadFromStream(FS);
|
1680 |
finally
|
1681 |
FS.Free;
|
1682 |
end;
|
1683 |
end;
|
1684 |
|
1685 |
procedure TStTextDataRecordSet.LoadFromStream(AStream: TStream);
|
1686 |
var
|
1687 |
TS : TStAnsiTextStream;
|
1688 |
NewRec : TStTextDataRecord;
|
1689 |
i, Len : Integer; {!!.02}
|
1690 |
begin
|
1691 |
if FActive then
|
1692 |
raise EStException.CreateResTP(stscTxtDatRecordSetOpen, 0);
|
1693 |
|
1694 |
Clear;
|
1695 |
|
1696 |
TS := TStAnsiTextStream.Create(AStream);
|
1697 |
|
1698 |
{ match Ansi Stream terminator to schema's }
|
1699 |
TS.LineTermChar := AnsiChar(Schema.LineTermChar);
|
1700 |
TS.LineTerminator := Schema.LineTerminator;
|
1701 |
|
1702 |
{!!.02 - added }
|
1703 |
{ calculate length of fixed record }
|
1704 |
if Schema.LayoutType = ltFixed then begin
|
1705 |
Len := 0;
|
1706 |
for i := 0 to Pred(Schema.FieldCount) do
|
1707 |
Len := Len + Schema.Fields[i].FieldLen;
|
1708 |
TS.FixedLineLength := Len;
|
1709 |
end;
|
1710 |
{!!.02 - added end }
|
1711 |
|
1712 |
try
|
1713 |
{!!.02 - added }
|
1714 |
{ ignore starting lines }
|
1715 |
for i := 1 to FIgnoreStartingLines do
|
1716 |
TS.ReadLine;
|
1717 |
{!!.02 - added end }
|
1718 |
|
1719 |
while not TS.AtEndOfStream do begin
|
1720 |
{ new record }
|
1721 |
NewRec := TStTextDataRecord.Create;
|
1722 |
|
1723 |
{ set record data }
|
1724 |
NewRec.FValue := TS.ReadLine;
|
1725 |
|
1726 |
{!!.01 - Rewritten }
|
1727 |
if TrimCharsL(NewRec.FValue, St_WhiteSpace) <> '' then begin
|
1728 |
{ set the schema to match }
|
1729 |
NewRec.Schema := Schema;
|
1730 |
|
1731 |
{ append new record }
|
1732 |
FRecords.Add(NewRec);
|
1733 |
|
1734 |
end
|
1735 |
else {ignore blank lines}
|
1736 |
NewRec.Free;
|
1737 |
{!!.01 - End Rewritten }
|
1738 |
end;
|
1739 |
|
1740 |
|
1741 |
FActive := True;
|
1742 |
FIsDirty := False;
|
1743 |
finally
|
1744 |
TS.Free;
|
1745 |
end;
|
1746 |
end;
|
1747 |
|
1748 |
function TStTextDataRecordSet.Next : Boolean;
|
1749 |
{ make next record in set current }
|
1750 |
begin
|
1751 |
Result := True;
|
1752 |
|
1753 |
{ if already on last record, stay there }
|
1754 |
if FCurrentIndex = Pred(FRecords.Count) then begin {!!.01}
|
1755 |
FAtEndOfFile := True; { yep, we're at the end } {!!.01}
|
1756 |
Result := False; {!!.01}
|
1757 |
end {!!.01}
|
1758 |
else {!!.01}
|
1759 |
Inc(FCurrentIndex); {!!.01}
|
1760 |
end;
|
1761 |
|
1762 |
function TStTextDataRecordSet.Prior : Boolean;
|
1763 |
{ make previous record in set current }
|
1764 |
begin
|
1765 |
Result := True;
|
1766 |
Dec(FCurrentIndex);
|
1767 |
|
1768 |
{ if already on first record, stay there }
|
1769 |
if FCurrentIndex < 0 then begin
|
1770 |
FCurrentIndex := 0;
|
1771 |
Result := False;
|
1772 |
end;
|
1773 |
end;
|
1774 |
|
1775 |
procedure TStTextDataRecordSet.SaveToFile(const AFile: TFileName);
|
1776 |
var
|
1777 |
FS : TFileStream;
|
1778 |
begin
|
1779 |
if not FileExists(AFile) then begin
|
1780 |
FS := TFileStream.Create(AFile, fmCreate);
|
1781 |
FS.Free;
|
1782 |
end;
|
1783 |
|
1784 |
FS := TFileStream.Create(AFile, fmOpenWrite or fmShareDenyNone);
|
1785 |
|
1786 |
try
|
1787 |
SaveToStream(FS);
|
1788 |
finally
|
1789 |
FS.Free;
|
1790 |
end;
|
1791 |
end;
|
1792 |
|
1793 |
procedure TStTextDataRecordSet.SaveToStream(AStream: TStream);
|
1794 |
var
|
1795 |
TS : TStAnsiTextStream;
|
1796 |
i : Integer;
|
1797 |
begin
|
1798 |
TS := TStAnsiTextStream.Create(AStream);
|
1799 |
|
1800 |
{ match Ansi Stream terminator to schema's }
|
1801 |
TS.LineTermChar := AnsiChar(Schema.LineTermChar);
|
1802 |
TS.LineTerminator := Schema.LineTerminator;
|
1803 |
|
1804 |
{ write the records }
|
1805 |
try
|
1806 |
for i := 0 to Pred(FRecords.Count) do
|
1807 |
TS.WriteLine(TStTextDataRecord(FRecords[i]).AsString);
|
1808 |
|
1809 |
FIsDirty := False;
|
1810 |
finally
|
1811 |
TS.Free;
|
1812 |
end;
|
1813 |
end;
|
1814 |
|
1815 |
procedure TStTextDataRecordSet.SetActive(const Value: Boolean);
|
1816 |
{ activate or close record set }
|
1817 |
begin
|
1818 |
FActive := Value;
|
1819 |
if not FActive then begin
|
1820 |
Clear;
|
1821 |
FSchema := nil;
|
1822 |
end;
|
1823 |
end;
|
1824 |
|
1825 |
procedure TStTextDataRecordSet.SetCurrentRecord(
|
1826 |
const Value: TStTextDataRecord);
|
1827 |
begin
|
1828 |
TStTextDataRecord(FRecords[FCurrentIndex]).Free;
|
1829 |
FRecords.Insert(FCurrentIndex, Value);
|
1830 |
FIsDirty := True;
|
1831 |
end;
|
1832 |
|
1833 |
procedure TStTextDataRecordSet.SetRecord(Index: Integer;
|
1834 |
const Value: TStTextDataRecord);
|
1835 |
begin
|
1836 |
TStTextDataRecord(FRecords[Index]).Free;
|
1837 |
FRecords.Insert(Index, Value);
|
1838 |
FIsDirty := True;
|
1839 |
end;
|
1840 |
|
1841 |
procedure TStTextDataRecordSet.SetSchema(const Value: TStTextDataSchema);
|
1842 |
{ assign new schema, only works on inactive record set }
|
1843 |
begin
|
1844 |
if not FActive then begin
|
1845 |
if Assigned(FSchema) then
|
1846 |
FSchema.Free;
|
1847 |
FSchema := Value;
|
1848 |
end
|
1849 |
else
|
1850 |
raise EStException.CreateResTP(stscTxtDatRecordSetOpen, 0);
|
1851 |
end;
|
1852 |
|
1853 |
|
1854 |
|
1855 |
end.
|