source: trunk/Packages/csvdocument/csvdocument.pas

Last change on this file was 5, checked in by chronos, 2 weeks ago
  • Modified: Load Owners from XML file with additional information about prices.
File size: 27.9 KB
Line 
1{
2 CSV Parser, Builder and Document classes.
3 Version 0.5 2014-10-25
4
5 Copyright (C) 2010-2014 Vladimir Zhirov <vvzh.home@gmail.com>
6
7 Contributors:
8 Luiz Americo Pereira Camara
9 Mattias Gaertner
10 Reinier Olislagers
11
12 This library is free software; you can redistribute it and/or modify it
13 under the terms of the GNU Library General Public License as published by
14 the Free Software Foundation; either version 2 of the License, or (at your
15 option) any later version with the following modification:
16
17 As a special exception, the copyright holders of this library give you
18 permission to link this library with independent modules to produce an
19 executable, regardless of the license terms of these independent modules,and
20 to copy and distribute the resulting executable under terms of your choice,
21 provided that you also meet, for each linked independent module, the terms
22 and conditions of the license of that module. An independent module is a
23 module which is not derived from or based on this library. If you modify
24 this library, you may extend this exception to your version of the library,
25 but you are not obligated to do so. If you do not wish to do so, delete this
26 exception statement from your version.
27
28 This program is distributed in the hope that it will be useful, but WITHOUT
29 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
30 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
31 for more details.
32
33 You should have received a copy of the GNU Library General Public License
34 along with this library; if not, write to the Free Software Foundation,
35 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
36}
37
38unit CsvDocument;
39
40{$IFDEF FPC}
41 {$MODE DELPHI}
42{$ENDIF}
43
44interface
45
46uses
47 Classes, SysUtils, Contnrs, StrUtils;
48
49type
50 {$IFNDEF FPC}
51 TFPObjectList = TObjectList;
52 {$ENDIF}
53
54 TCSVChar = Char;
55
56 TCSVHandler = class(TObject)
57 private
58 procedure SetDelimiter(const AValue: TCSVChar);
59 procedure SetQuoteChar(const AValue: TCSVChar);
60 procedure UpdateCachedChars;
61 protected
62 // special chars
63 FDelimiter: TCSVChar;
64 FQuoteChar: TCSVChar;
65 FLineEnding: String;
66 // cached values to speed up special chars operations
67 FSpecialChars: TSysCharSet;
68 FDoubleQuote: String;
69 // parser settings
70 FIgnoreOuterWhitespace: Boolean;
71 // builder settings
72 FQuoteOuterWhitespace: Boolean;
73 // document settings
74 FEqualColCountPerRow: Boolean;
75 public
76 constructor Create;
77 procedure AssignCSVProperties(ASource: TCSVHandler);
78 // Delimiter that separates the field, e.g. comma, semicolon, tab
79 property Delimiter: TCSVChar read FDelimiter write SetDelimiter;
80 // Character used to quote "problematic" data
81 // (e.g. with delimiters or spaces in them)
82 // A common quotechar is "
83 property QuoteChar: TCSVChar read FQuoteChar write SetQuoteChar;
84 // String at the end of the line of data (e.g. CRLF)
85 property LineEnding: String read FLineEnding write FLineEnding;
86 // Ignore whitespace between delimiters and field data
87 property IgnoreOuterWhitespace: Boolean read FIgnoreOuterWhitespace write FIgnoreOuterWhitespace;
88 // Use quotes when outer whitespace is found
89 property QuoteOuterWhitespace: Boolean read FQuoteOuterWhitespace write FQuoteOuterWhitespace;
90 // When reading and writing: make sure every line has the same column count, create empty cells in the end of row if required
91 property EqualColCountPerRow: Boolean read FEqualColCountPerRow write FEqualColCountPerRow;
92 end;
93
94 // Sequential input from CSV stream
95
96 { TCSVParser }
97
98 TCSVParser = class(TCSVHandler)
99 private
100 // fields
101 FSourceStream: TStream;
102 FStrStreamWrapper: TStringStream;
103 // parser state
104 EndOfFile: Boolean;
105 EndOfLine: Boolean;
106 FCurrentChar: TCSVChar;
107 FCurrentRow: Integer;
108 FCurrentCol: Integer;
109 FMaxColCount: Integer;
110 // output buffers
111 FCellBuffer: String;
112 FWhitespaceBuffer: String;
113 procedure ClearOutput;
114 // basic parsing
115 procedure SkipEndOfLine;
116 procedure SkipDelimiter;
117 procedure SkipWhitespace;
118 procedure NextChar;
119 // complex parsing
120 procedure ParseCell;
121 procedure ParseQuotedValue;
122 // simple parsing
123 procedure ParseValue;
124 public
125 constructor Create;
126 destructor Destroy; override;
127 // Source data stream
128 procedure SetSource(AStream: TStream); overload;
129 // Source data string
130 procedure SetSource(const AString: String); overload;
131 // Rewind to beginning of data
132 procedure ResetParser;
133 // Read next cell data; return false if end of file reached
134 function ParseNextCell: Boolean;
135 // Current row (0 based)
136 property CurrentRow: Integer read FCurrentRow;
137 // Current column (0 based); -1 if invalid/before beginning of file
138 property CurrentCol: Integer read FCurrentCol;
139 // Data in current cell
140 property CurrentCellText: String read FCellBuffer;
141 // The maximum number of columns found in the stream:
142 property MaxColCount: Integer read FMaxColCount;
143 end;
144
145 // Sequential output to CSV stream
146 TCSVBuilder = class(TCSVHandler)
147 private
148 FOutputStream: TStream;
149 FDefaultOutput: TMemoryStream;
150 FNeedLeadingDelimiter: Boolean;
151 function GetDefaultOutputAsString: String;
152 protected
153 procedure AppendStringToStream(const AString: String; AStream: TStream);
154 function QuoteCSVString(const AValue: String): String;
155 public
156 constructor Create;
157 destructor Destroy; override;
158 // Set output/destination stream.
159 // If not called, output is sent to DefaultOutput
160 procedure SetOutput(AStream: TStream);
161 // If using default stream, reset output to beginning.
162 // If using user-defined stream, user should reposition stream himself
163 procedure ResetBuilder;
164 // Add a cell to the output with data AValue
165 procedure AppendCell(const AValue: String);
166 // Write end of row to the output, starting a new row
167 procedure AppendRow;
168 // Default output as memorystream (if output not set using SetOutput)
169 property DefaultOutput: TMemoryStream read FDefaultOutput;
170 // Default output in string format (if output not set using SetOutput)
171 property DefaultOutputAsString: String read GetDefaultOutputAsString;
172 end;
173
174 // Random access to CSV document. Reads entire document into memory.
175 TCSVDocument = class(TCSVHandler)
176 private
177 FRows: TFPObjectList;
178 FParser: TCSVParser;
179 FBuilder: TCSVBuilder;
180 // helpers
181 procedure ForceRowIndex(ARowIndex: Integer);
182 function CreateNewRow(const AFirstCell: String = ''): TObject;
183 // property getters/setters
184 function GetCell(ACol, ARow: Integer): String;
185 procedure SetCell(ACol, ARow: Integer; const AValue: String);
186 function GetCSVText: String;
187 procedure SetCSVText(const AValue: String);
188 function GetRowCount: Integer;
189 function GetColCount(ARow: Integer): Integer;
190 function GetMaxColCount: Integer;
191 public
192 constructor Create;
193 destructor Destroy; override;
194
195 // Input/output
196
197 // Load document from file AFileName
198 procedure LoadFromFile(const AFilename: String);
199 // Load document from stream AStream
200 procedure LoadFromStream(AStream: TStream);
201 // Save document to file AFilename
202 procedure SaveToFile(const AFilename: String);
203 // Save document to stream AStream
204 procedure SaveToStream(AStream: TStream);
205
206 // Row and cell operations
207
208 // Add a new row and a cell with content AFirstCell
209 procedure AddRow(const AFirstCell: String = '');
210 // Add a cell at row ARow with data AValue
211 procedure AddCell(ARow: Integer; const AValue: String = '');
212 // Insert a row at row ARow with first cell data AFirstCell
213 // If there is no row ARow, insert row at end
214 procedure InsertRow(ARow: Integer; const AFirstCell: String = '');
215 // Insert a cell at specified position with data AValue
216 procedure InsertCell(ACol, ARow: Integer; const AValue: String = '');
217 // Remove specified row
218 procedure RemoveRow(ARow: Integer);
219 // Remove specified cell
220 procedure RemoveCell(ACol, ARow: Integer);
221 // Indicates if there is a row at specified position
222 function HasRow(ARow: Integer): Boolean;
223 // Indicates if there is a cell at specified position
224 function HasCell(ACol, ARow: Integer): Boolean;
225
226 // Search
227
228 // Return column for cell data AString at row ARow
229 function IndexOfCol(const AString: String; ARow: Integer): Integer;
230 // Return row for cell data AString at coloumn ACol
231 function IndexOfRow(const AString: String; ACol: Integer): Integer;
232
233 // Utils
234
235 // Remove all data
236 procedure Clear;
237 // Copy entire row ARow to row position AInsertPos.
238 // Adds empty rows if necessary
239 procedure CloneRow(ARow, AInsertPos: Integer);
240 // Exchange contents of the two specified rows
241 procedure ExchangeRows(ARow1, ARow2: Integer);
242 // Rewrite all line endings within cell data to LineEnding
243 procedure UnifyEmbeddedLineEndings;
244 // Remove empty cells at end of rows from entire document
245 procedure RemoveTrailingEmptyCells;
246
247 // Properties
248
249 // Cell data at column ACol, row ARow.
250 property Cells[ACol, ARow: Integer]: String read GetCell write SetCell; default;
251 // Number of rows
252 property RowCount: Integer read GetRowCount;
253 // Number of columns for row ARow
254 property ColCount[ARow: Integer]: Integer read GetColCount;
255 // Maximum number of columns found in all rows in document
256 property MaxColCount: Integer read GetMaxColCount;
257 // Document formatted as CSV text
258 property CSVText: String read GetCSVText write SetCSVText;
259 end;
260
261implementation
262
263const
264 CsvCharSize = SizeOf(TCSVChar);
265 CR = #13;
266 LF = #10;
267 HTAB = #9;
268 SPACE = #32;
269 WhitespaceChars = [HTAB, SPACE];
270 LineEndingChars = [CR, LF];
271
272// The following implementation of ChangeLineEndings function originates from
273// Lazarus CodeTools library by Mattias Gaertner. It was explicitly allowed
274// by Mattias to relicense it under modified LGPL and include into CsvDocument.
275
276function ChangeLineEndings(const AString, ALineEnding: String): String;
277var
278 I: Integer;
279 Src: PChar;
280 Dest: PChar;
281 DestLength: Integer;
282 EndingLength: Integer;
283 EndPos: PChar;
284begin
285 if AString = '' then
286 Exit(AString);
287 EndingLength := Length(ALineEnding);
288 DestLength := Length(AString);
289
290 Src := PChar(AString);
291 EndPos := Src + DestLength;
292 while Src < EndPos do
293 begin
294 if (Src^ = CR) then
295 begin
296 Inc(Src);
297 if (Src^ = LF) then
298 begin
299 Inc(Src);
300 Inc(DestLength, EndingLength - 2);
301 end else
302 Inc(DestLength, EndingLength - 1);
303 end else
304 begin
305 if (Src^ = LF) then
306 Inc(DestLength, EndingLength - 1);
307 Inc(Src);
308 end;
309 end;
310
311 SetLength(Result, DestLength);
312 Src := PChar(AString);
313 Dest := PChar(Result);
314 EndPos := Dest + DestLength;
315 while (Dest < EndPos) do
316 begin
317 if Src^ in LineEndingChars then
318 begin
319 for I := 1 to EndingLength do
320 begin
321 Dest^ := ALineEnding[I];
322 Inc(Dest);
323 end;
324 if (Src^ = CR) and (Src[1] = LF) then
325 Inc(Src, 2)
326 else
327 Inc(Src);
328 end else
329 begin
330 Dest^ := Src^;
331 Inc(Src);
332 Inc(Dest);
333 end;
334 end;
335end;
336
337{ TCSVHandler }
338
339procedure TCSVHandler.SetDelimiter(const AValue: TCSVChar);
340begin
341 if FDelimiter <> AValue then
342 begin
343 FDelimiter := AValue;
344 UpdateCachedChars;
345 end;
346end;
347
348procedure TCSVHandler.SetQuoteChar(const AValue: TCSVChar);
349begin
350 if FQuoteChar <> AValue then
351 begin
352 FQuoteChar := AValue;
353 UpdateCachedChars;
354 end;
355end;
356
357procedure TCSVHandler.UpdateCachedChars;
358begin
359 FDoubleQuote := FQuoteChar + FQuoteChar;
360 FSpecialChars := [CR, LF, FDelimiter, FQuoteChar];
361end;
362
363constructor TCSVHandler.Create;
364begin
365 inherited Create;
366 FDelimiter := ',';
367 FQuoteChar := '"';
368 FLineEnding := CR + LF;
369 FIgnoreOuterWhitespace := False;
370 FQuoteOuterWhitespace := True;
371 FEqualColCountPerRow := True;
372 UpdateCachedChars;
373end;
374
375procedure TCSVHandler.AssignCSVProperties(ASource: TCSVHandler);
376begin
377 FDelimiter := ASource.FDelimiter;
378 FQuoteChar := ASource.FQuoteChar;
379 FLineEnding := ASource.FLineEnding;
380 FIgnoreOuterWhitespace := ASource.FIgnoreOuterWhitespace;
381 FQuoteOuterWhitespace := ASource.FQuoteOuterWhitespace;
382 FEqualColCountPerRow := ASource.FEqualColCountPerRow;
383 UpdateCachedChars;
384end;
385
386{ TCSVParser }
387
388procedure TCSVParser.ClearOutput;
389begin
390 FCellBuffer := '';
391 FWhitespaceBuffer := '';
392 FCurrentRow := 0;
393 FCurrentCol := -1;
394 FMaxColCount := 0;
395end;
396
397procedure TCSVParser.SkipEndOfLine;
398begin
399 // treat LF+CR as two linebreaks, not one
400 if (FCurrentChar = CR) then
401 NextChar;
402 if (FCurrentChar = LF) then
403 NextChar;
404end;
405
406procedure TCSVParser.SkipDelimiter;
407begin
408 if FCurrentChar = FDelimiter then
409 NextChar;
410end;
411
412procedure TCSVParser.SkipWhitespace;
413begin
414 while FCurrentChar = SPACE do
415 NextChar;
416end;
417
418procedure TCSVParser.NextChar;
419begin
420 if FSourceStream.Read(FCurrentChar, CsvCharSize) < CsvCharSize then
421 begin
422 FCurrentChar := #0;
423 EndOfFile := True;
424 end;
425 EndOfLine := FCurrentChar in LineEndingChars;
426end;
427
428procedure TCSVParser.ParseCell;
429begin
430 FCellBuffer := '';
431 if FIgnoreOuterWhitespace then
432 SkipWhitespace;
433 if FCurrentChar = FQuoteChar then
434 ParseQuotedValue
435 else
436 ParseValue;
437end;
438
439procedure TCSVParser.ParseQuotedValue;
440var
441 QuotationEnd: Boolean;
442begin
443 NextChar; // skip opening quotation char
444 repeat
445 // read value up to next quotation char
446 while not ((FCurrentChar = FQuoteChar) or EndOfFile) do
447 begin
448 if EndOfLine then
449 begin
450 AppendStr(FCellBuffer, FLineEnding);
451 SkipEndOfLine;
452 end else
453 begin
454 AppendStr(FCellBuffer, FCurrentChar);
455 NextChar;
456 end;
457 end;
458 // skip quotation char (closing or escaping)
459 if not EndOfFile then
460 NextChar;
461 // check if it was escaping
462 if FCurrentChar = FQuoteChar then
463 begin
464 AppendStr(FCellBuffer, FCurrentChar);
465 QuotationEnd := False;
466 NextChar;
467 end else
468 QuotationEnd := True;
469 until QuotationEnd;
470 // read the rest of the value until separator or new line
471 ParseValue;
472end;
473
474procedure TCSVParser.ParseValue;
475begin
476 while not ((FCurrentChar = FDelimiter) or EndOfLine or EndOfFile) do
477 begin
478 AppendStr(FWhitespaceBuffer, FCurrentChar);
479 NextChar;
480 end;
481 // merge whitespace buffer
482 if FIgnoreOuterWhitespace then
483 RemoveTrailingChars(FWhitespaceBuffer, WhitespaceChars);
484 AppendStr(FCellBuffer, FWhitespaceBuffer);
485 FWhitespaceBuffer := '';
486end;
487
488constructor TCSVParser.Create;
489begin
490 inherited Create;
491 ClearOutput;
492 FStrStreamWrapper := nil;
493 EndOfFile := True;
494end;
495
496destructor TCSVParser.Destroy;
497begin
498 FreeAndNil(FStrStreamWrapper);
499 inherited Destroy;
500end;
501
502procedure TCSVParser.SetSource(AStream: TStream);
503begin
504 FSourceStream := AStream;
505 ResetParser;
506end;
507
508procedure TCSVParser.SetSource(const AString: String); overload;
509begin
510 FreeAndNil(FStrStreamWrapper);
511 FStrStreamWrapper := TStringStream.Create(AString);
512 SetSource(FStrStreamWrapper);
513end;
514
515procedure TCSVParser.ResetParser;
516begin
517 ClearOutput;
518 FSourceStream.Seek(0, soFromBeginning);
519 EndOfFile := False;
520 NextChar;
521end;
522
523// Parses next cell; returns True if there are more cells in the input stream.
524function TCSVParser.ParseNextCell: Boolean;
525var
526 LineColCount: Integer;
527begin
528 if EndOfLine or EndOfFile then
529 begin
530 // Having read the previous line, adjust column count if necessary:
531 LineColCount := FCurrentCol + 1;
532 if LineColCount > FMaxColCount then
533 FMaxColCount := LineColCount;
534 end;
535
536 if EndOfFile then
537 Exit(False);
538
539 // Handle line ending
540 if EndOfLine then
541 begin
542 SkipEndOfLine;
543 if EndOfFile then
544 Exit(False);
545 FCurrentCol := 0;
546 Inc(FCurrentRow);
547 end else
548 Inc(FCurrentCol);
549
550 // Skipping a delimiter should be immediately followed by parsing a cell
551 // without checking for line break first, otherwise we miss last empty cell.
552 // But 0th cell does not start with delimiter unlike other cells, so
553 // the following check is required not to miss the first empty cell:
554 if FCurrentCol > 0 then
555 SkipDelimiter;
556 ParseCell;
557 Result := True;
558end;
559
560{ TCSVBuilder }
561
562function TCSVBuilder.GetDefaultOutputAsString: String;
563var
564 StreamSize: Integer;
565begin
566 Result := '';
567 StreamSize := FDefaultOutput.Size;
568 if StreamSize > 0 then
569 begin
570 SetLength(Result, StreamSize);
571 FDefaultOutput.ReadBuffer(Result[1], StreamSize);
572 end;
573end;
574
575procedure TCSVBuilder.AppendStringToStream(const AString: String; AStream: TStream);
576var
577 StrLen: Integer;
578begin
579 StrLen := Length(AString);
580 if StrLen > 0 then
581 AStream.WriteBuffer(AString[1], StrLen);
582end;
583
584function TCSVBuilder.QuoteCSVString(const AValue: String): String;
585var
586 I: Integer;
587 ValueLen: Integer;
588 NeedQuotation: Boolean;
589begin
590 ValueLen := Length(AValue);
591
592 NeedQuotation := (AValue <> '') and FQuoteOuterWhitespace
593 and ((AValue[1] in WhitespaceChars) or (AValue[ValueLen] in WhitespaceChars));
594
595 if not NeedQuotation then
596 for I := 1 to ValueLen do
597 begin
598 if AValue[I] in FSpecialChars then
599 begin
600 NeedQuotation := True;
601 Break;
602 end;
603 end;
604
605 if NeedQuotation then
606 begin
607 // double existing quotes
608 Result := FDoubleQuote;
609 Insert(StringReplace(AValue, FQuoteChar, FDoubleQuote, [rfReplaceAll]),
610 Result, 2);
611 end else
612 Result := AValue;
613end;
614
615constructor TCSVBuilder.Create;
616begin
617 inherited Create;
618 FDefaultOutput := TMemoryStream.Create;
619 FOutputStream := FDefaultOutput;
620end;
621
622destructor TCSVBuilder.Destroy;
623begin
624 FreeAndNil(FDefaultOutput);
625 inherited Destroy;
626end;
627
628procedure TCSVBuilder.SetOutput(AStream: TStream);
629begin
630 if Assigned(AStream) then
631 FOutputStream := AStream
632 else
633 FOutputStream := FDefaultOutput;
634
635 ResetBuilder;
636end;
637
638procedure TCSVBuilder.ResetBuilder;
639begin
640 if FOutputStream = FDefaultOutput then
641 FDefaultOutput.Clear;
642
643 // Do not clear external FOutputStream because it may be pipe stream
644 // or something else that does not support size and position.
645 // To clear external output is up to the user of TCSVBuilder.
646
647 FNeedLeadingDelimiter := False;
648end;
649
650procedure TCSVBuilder.AppendCell(const AValue: String);
651var
652 CellValue: String;
653begin
654 if FNeedLeadingDelimiter then
655 FOutputStream.WriteBuffer(FDelimiter, CsvCharSize);
656
657 CellValue := ChangeLineEndings(AValue, FLineEnding);
658 CellValue := QuoteCSVString(CellValue);
659 AppendStringToStream(CellValue, FOutputStream);
660
661 FNeedLeadingDelimiter := True;
662end;
663
664procedure TCSVBuilder.AppendRow;
665begin
666 AppendStringToStream(FLineEnding, FOutputStream);
667 FNeedLeadingDelimiter := False;
668end;
669
670//------------------------------------------------------------------------------
671
672type
673 TCSVCell = class
674 public
675 // Value (contents) of cell in string form
676 Value: String;
677 end;
678
679 TCSVRow = class
680 private
681 FCells: TFPObjectList;
682 procedure ForceCellIndex(ACellIndex: Integer);
683 function CreateNewCell(const AValue: String): TCSVCell;
684 function GetCellValue(ACol: Integer): String;
685 procedure SetCellValue(ACol: Integer; const AValue: String);
686 function GetColCount: Integer;
687 public
688 constructor Create;
689 destructor Destroy; override;
690 // cell operations
691 // Add cell with value AValue to row
692 procedure AddCell(const AValue: String = '');
693 // Insert cell with value AValue at specified column
694 procedure InsertCell(ACol: Integer; const AValue: String);
695 // Remove cell from specified column
696 procedure RemoveCell(ACol: Integer);
697 // Indicates if specified column contains a cell/data
698 function HasCell(ACol: Integer): Boolean;
699 // utilities
700 // Copy entire row
701 function Clone: TCSVRow;
702 // Remove all empty cells at the end of the row
703 procedure TrimEmptyCells;
704 // Replace various line endings in data with ALineEnding
705 procedure SetValuesLineEnding(const ALineEnding: String);
706 // properties
707 // Value/data of cell at column ACol
708 property CellValue[ACol: Integer]: String read GetCellValue write SetCellValue;
709 // Number of columns in row
710 property ColCount: Integer read GetColCount;
711 end;
712
713{ TCSVRow }
714
715procedure TCSVRow.ForceCellIndex(ACellIndex: Integer);
716begin
717 while FCells.Count <= ACellIndex do
718 AddCell();
719end;
720
721function TCSVRow.CreateNewCell(const AValue: String): TCSVCell;
722begin
723 Result := TCSVCell.Create;
724 Result.Value := AValue;
725end;
726
727function TCSVRow.GetCellValue(ACol: Integer): String;
728begin
729 if HasCell(ACol) then
730 Result := TCSVCell(FCells[ACol]).Value
731 else
732 Result := '';
733end;
734
735procedure TCSVRow.SetCellValue(ACol: Integer; const AValue: String);
736begin
737 ForceCellIndex(ACol);
738 TCSVCell(FCells[ACol]).Value := AValue;
739end;
740
741function TCSVRow.GetColCount: Integer;
742begin
743 Result := FCells.Count;
744end;
745
746constructor TCSVRow.Create;
747begin
748 inherited Create;
749 FCells := TFPObjectList.Create;
750end;
751
752destructor TCSVRow.Destroy;
753begin
754 FreeAndNil(FCells);
755 inherited Destroy;
756end;
757
758procedure TCSVRow.AddCell(const AValue: String = '');
759begin
760 FCells.Add(CreateNewCell(AValue));
761end;
762
763procedure TCSVRow.InsertCell(ACol: Integer; const AValue: String);
764begin
765 FCells.Insert(ACol, CreateNewCell(AValue));
766end;
767
768procedure TCSVRow.RemoveCell(ACol: Integer);
769begin
770 if HasCell(ACol) then
771 FCells.Delete(ACol);
772end;
773
774function TCSVRow.HasCell(ACol: Integer): Boolean;
775begin
776 Result := (ACol >= 0) and (ACol < FCells.Count);
777end;
778
779function TCSVRow.Clone: TCSVRow;
780var
781 I: Integer;
782begin
783 Result := TCSVRow.Create;
784 for I := 0 to ColCount - 1 do
785 Result.AddCell(CellValue[I]);
786end;
787
788procedure TCSVRow.TrimEmptyCells;
789var
790 I: Integer;
791 MaxCol: Integer;
792begin
793 MaxCol := FCells.Count - 1;
794 for I := MaxCol downto 0 do
795 begin
796 if (TCSVCell(FCells[I]).Value = '') then
797 begin
798 if (FCells.Count > 1) then
799 FCells.Delete(I);
800 end else
801 break; // We hit the first non-empty cell so stop
802 end;
803end;
804
805procedure TCSVRow.SetValuesLineEnding(const ALineEnding: String);
806var
807 I: Integer;
808begin
809 for I := 0 to FCells.Count - 1 do
810 CellValue[I] := ChangeLineEndings(CellValue[I], ALineEnding);
811end;
812
813{ TCSVDocument }
814
815procedure TCSVDocument.ForceRowIndex(ARowIndex: Integer);
816begin
817 while FRows.Count <= ARowIndex do
818 AddRow();
819end;
820
821function TCSVDocument.CreateNewRow(const AFirstCell: String): TObject;
822var
823 NewRow: TCSVRow;
824begin
825 NewRow := TCSVRow.Create;
826 if AFirstCell <> '' then
827 NewRow.AddCell(AFirstCell);
828 Result := NewRow;
829end;
830
831function TCSVDocument.GetCell(ACol, ARow: Integer): String;
832begin
833 if HasRow(ARow) then
834 Result := TCSVRow(FRows[ARow]).CellValue[ACol]
835 else
836 Result := '';
837end;
838
839procedure TCSVDocument.SetCell(ACol, ARow: Integer; const AValue: String);
840begin
841 ForceRowIndex(ARow);
842 TCSVRow(FRows[ARow]).CellValue[ACol] := AValue;
843end;
844
845function TCSVDocument.GetCSVText: String;
846var
847 StringStream: TStringStream;
848begin
849 StringStream := TStringStream.Create('');
850 try
851 SaveToStream(StringStream);
852 Result := StringStream.DataString;
853 finally
854 FreeAndNil(StringStream);
855 end;
856end;
857
858procedure TCSVDocument.SetCSVText(const AValue: String);
859var
860 StringStream: TStringStream;
861begin
862 StringStream := TStringStream.Create(AValue);
863 try
864 LoadFromStream(StringStream);
865 finally
866 FreeAndNil(StringStream);
867 end;
868end;
869
870function TCSVDocument.GetRowCount: Integer;
871begin
872 Result := FRows.Count;
873end;
874
875function TCSVDocument.GetColCount(ARow: Integer): Integer;
876begin
877 if HasRow(ARow) then
878 Result := TCSVRow(FRows[ARow]).ColCount
879 else
880 Result := 0;
881end;
882
883// Returns maximum number of columns in the document
884function TCSVDocument.GetMaxColCount: Integer;
885var
886 I, CC: Integer;
887begin
888 // While calling MaxColCount in TCSVParser could work,
889 // we'd need to adjust for any subsequent changes in
890 // TCSVDocument
891 Result := 0;
892 for I := 0 to RowCount - 1 do
893 begin
894 CC := ColCount[I];
895 if CC > Result then
896 Result := CC;
897 end;
898end;
899
900constructor TCSVDocument.Create;
901begin
902 inherited Create;
903 FRows := TFPObjectList.Create;
904 FParser := nil;
905 FBuilder := nil;
906end;
907
908destructor TCSVDocument.Destroy;
909begin
910 FreeAndNil(FBuilder);
911 FreeAndNil(FParser);
912 FreeAndNil(FRows);
913 inherited Destroy;
914end;
915
916procedure TCSVDocument.LoadFromFile(const AFilename: String);
917var
918 FileStream: TFileStream;
919begin
920 FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
921 try
922 LoadFromStream(FileStream);
923 finally
924 FileStream.Free;
925 end;
926end;
927
928procedure TCSVDocument.LoadFromStream(AStream: TStream);
929var
930 I, J, MaxCol: Integer;
931begin
932 Clear;
933
934 if not Assigned(FParser) then
935 FParser := TCSVParser.Create;
936
937 FParser.AssignCSVProperties(Self);
938 with FParser do
939 begin
940 SetSource(AStream);
941 while ParseNextCell do
942 Cells[CurrentCol, CurrentRow] := CurrentCellText;
943 end;
944
945 if FEqualColCountPerRow then
946 begin
947 MaxCol := MaxColCount - 1;
948 for I := 0 to RowCount - 1 do
949 for J := ColCount[I] to MaxCol do
950 Cells[J, I] := '';
951 end;
952end;
953
954procedure TCSVDocument.SaveToFile(const AFilename: String);
955var
956 FileStream: TFileStream;
957begin
958 FileStream := TFileStream.Create(AFilename, fmCreate);
959 try
960 SaveToStream(FileStream);
961 finally
962 FileStream.Free;
963 end;
964end;
965
966procedure TCSVDocument.SaveToStream(AStream: TStream);
967var
968 I, J, MaxCol: Integer;
969begin
970 if not Assigned(FBuilder) then
971 FBuilder := TCSVBuilder.Create;
972
973 FBuilder.AssignCSVProperties(Self);
974 with FBuilder do
975 begin
976 if FEqualColCountPerRow then
977 MaxCol := MaxColCount - 1;
978
979 SetOutput(AStream);
980 for I := 0 to RowCount - 1 do
981 begin
982 if not FEqualColCountPerRow then
983 MaxCol := ColCount[I] - 1;
984 for J := 0 to MaxCol do
985 AppendCell(Cells[J, I]);
986 AppendRow;
987 end;
988 end;
989end;
990
991procedure TCSVDocument.AddRow(const AFirstCell: String = '');
992begin
993 FRows.Add(CreateNewRow(AFirstCell));
994end;
995
996procedure TCSVDocument.AddCell(ARow: Integer; const AValue: String = '');
997begin
998 ForceRowIndex(ARow);
999 TCSVRow(FRows[ARow]).AddCell(AValue);
1000end;
1001
1002procedure TCSVDocument.InsertRow(ARow: Integer; const AFirstCell: String = '');
1003begin
1004 if HasRow(ARow) then
1005 FRows.Insert(ARow, CreateNewRow(AFirstCell))
1006 else
1007 AddRow(AFirstCell);
1008end;
1009
1010procedure TCSVDocument.InsertCell(ACol, ARow: Integer; const AValue: String);
1011begin
1012 ForceRowIndex(ARow);
1013 TCSVRow(FRows[ARow]).InsertCell(ACol, AValue);
1014end;
1015
1016procedure TCSVDocument.RemoveRow(ARow: Integer);
1017begin
1018 if HasRow(ARow) then
1019 FRows.Delete(ARow);
1020end;
1021
1022procedure TCSVDocument.RemoveCell(ACol, ARow: Integer);
1023begin
1024 if HasRow(ARow) then
1025 TCSVRow(FRows[ARow]).RemoveCell(ACol);
1026end;
1027
1028function TCSVDocument.HasRow(ARow: Integer): Boolean;
1029begin
1030 Result := (ARow >= 0) and (ARow < FRows.Count);
1031end;
1032
1033function TCSVDocument.HasCell(ACol, ARow: Integer): Boolean;
1034begin
1035 if HasRow(ARow) then
1036 Result := TCSVRow(FRows[ARow]).HasCell(ACol)
1037 else
1038 Result := False;
1039end;
1040
1041function TCSVDocument.IndexOfCol(const AString: String; ARow: Integer): Integer;
1042var
1043 CC: Integer;
1044begin
1045 CC := ColCount[ARow];
1046 Result := 0;
1047 while (Result < CC) and (Cells[Result, ARow] <> AString) do
1048 Inc(Result);
1049 if Result = CC then
1050 Result := -1;
1051end;
1052
1053function TCSVDocument.IndexOfRow(const AString: String; ACol: Integer): Integer;
1054var
1055 RC: Integer;
1056begin
1057 RC := RowCount;
1058 Result := 0;
1059 while (Result < RC) and (Cells[ACol, Result] <> AString) do
1060 Inc(Result);
1061 if Result = RC then
1062 Result := -1;
1063end;
1064
1065procedure TCSVDocument.Clear;
1066begin
1067 FRows.Clear;
1068end;
1069
1070procedure TCSVDocument.CloneRow(ARow, AInsertPos: Integer);
1071var
1072 NewRow: TObject;
1073begin
1074 if not HasRow(ARow) then
1075 Exit;
1076 NewRow := TCSVRow(FRows[ARow]).Clone;
1077 if not HasRow(AInsertPos) then
1078 begin
1079 ForceRowIndex(AInsertPos - 1);
1080 FRows.Add(NewRow);
1081 end else
1082 FRows.Insert(AInsertPos, NewRow);
1083end;
1084
1085procedure TCSVDocument.ExchangeRows(ARow1, ARow2: Integer);
1086begin
1087 if not (HasRow(ARow1) and HasRow(ARow2)) then
1088 Exit;
1089 FRows.Exchange(ARow1, ARow2);
1090end;
1091
1092procedure TCSVDocument.UnifyEmbeddedLineEndings;
1093var
1094 I: Integer;
1095begin
1096 for I := 0 to FRows.Count - 1 do
1097 TCSVRow(FRows[I]).SetValuesLineEnding(FLineEnding);
1098end;
1099
1100procedure TCSVDocument.RemoveTrailingEmptyCells;
1101var
1102 I: Integer;
1103begin
1104 for I := 0 to FRows.Count - 1 do
1105 TCSVRow(FRows[I]).TrimEmptyCells;
1106end;
1107
1108end.
Note: See TracBrowser for help on using the repository browser.