| 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 |
|
|---|
| 38 | unit CsvDocument;
|
|---|
| 39 |
|
|---|
| 40 | {$IFDEF FPC}
|
|---|
| 41 | {$MODE DELPHI}
|
|---|
| 42 | {$ENDIF}
|
|---|
| 43 |
|
|---|
| 44 | interface
|
|---|
| 45 |
|
|---|
| 46 | uses
|
|---|
| 47 | Classes, SysUtils, Contnrs, StrUtils;
|
|---|
| 48 |
|
|---|
| 49 | type
|
|---|
| 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 |
|
|---|
| 261 | implementation
|
|---|
| 262 |
|
|---|
| 263 | const
|
|---|
| 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 |
|
|---|
| 276 | function ChangeLineEndings(const AString, ALineEnding: String): String;
|
|---|
| 277 | var
|
|---|
| 278 | I: Integer;
|
|---|
| 279 | Src: PChar;
|
|---|
| 280 | Dest: PChar;
|
|---|
| 281 | DestLength: Integer;
|
|---|
| 282 | EndingLength: Integer;
|
|---|
| 283 | EndPos: PChar;
|
|---|
| 284 | begin
|
|---|
| 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;
|
|---|
| 335 | end;
|
|---|
| 336 |
|
|---|
| 337 | { TCSVHandler }
|
|---|
| 338 |
|
|---|
| 339 | procedure TCSVHandler.SetDelimiter(const AValue: TCSVChar);
|
|---|
| 340 | begin
|
|---|
| 341 | if FDelimiter <> AValue then
|
|---|
| 342 | begin
|
|---|
| 343 | FDelimiter := AValue;
|
|---|
| 344 | UpdateCachedChars;
|
|---|
| 345 | end;
|
|---|
| 346 | end;
|
|---|
| 347 |
|
|---|
| 348 | procedure TCSVHandler.SetQuoteChar(const AValue: TCSVChar);
|
|---|
| 349 | begin
|
|---|
| 350 | if FQuoteChar <> AValue then
|
|---|
| 351 | begin
|
|---|
| 352 | FQuoteChar := AValue;
|
|---|
| 353 | UpdateCachedChars;
|
|---|
| 354 | end;
|
|---|
| 355 | end;
|
|---|
| 356 |
|
|---|
| 357 | procedure TCSVHandler.UpdateCachedChars;
|
|---|
| 358 | begin
|
|---|
| 359 | FDoubleQuote := FQuoteChar + FQuoteChar;
|
|---|
| 360 | FSpecialChars := [CR, LF, FDelimiter, FQuoteChar];
|
|---|
| 361 | end;
|
|---|
| 362 |
|
|---|
| 363 | constructor TCSVHandler.Create;
|
|---|
| 364 | begin
|
|---|
| 365 | inherited Create;
|
|---|
| 366 | FDelimiter := ',';
|
|---|
| 367 | FQuoteChar := '"';
|
|---|
| 368 | FLineEnding := CR + LF;
|
|---|
| 369 | FIgnoreOuterWhitespace := False;
|
|---|
| 370 | FQuoteOuterWhitespace := True;
|
|---|
| 371 | FEqualColCountPerRow := True;
|
|---|
| 372 | UpdateCachedChars;
|
|---|
| 373 | end;
|
|---|
| 374 |
|
|---|
| 375 | procedure TCSVHandler.AssignCSVProperties(ASource: TCSVHandler);
|
|---|
| 376 | begin
|
|---|
| 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;
|
|---|
| 384 | end;
|
|---|
| 385 |
|
|---|
| 386 | { TCSVParser }
|
|---|
| 387 |
|
|---|
| 388 | procedure TCSVParser.ClearOutput;
|
|---|
| 389 | begin
|
|---|
| 390 | FCellBuffer := '';
|
|---|
| 391 | FWhitespaceBuffer := '';
|
|---|
| 392 | FCurrentRow := 0;
|
|---|
| 393 | FCurrentCol := -1;
|
|---|
| 394 | FMaxColCount := 0;
|
|---|
| 395 | end;
|
|---|
| 396 |
|
|---|
| 397 | procedure TCSVParser.SkipEndOfLine;
|
|---|
| 398 | begin
|
|---|
| 399 | // treat LF+CR as two linebreaks, not one
|
|---|
| 400 | if (FCurrentChar = CR) then
|
|---|
| 401 | NextChar;
|
|---|
| 402 | if (FCurrentChar = LF) then
|
|---|
| 403 | NextChar;
|
|---|
| 404 | end;
|
|---|
| 405 |
|
|---|
| 406 | procedure TCSVParser.SkipDelimiter;
|
|---|
| 407 | begin
|
|---|
| 408 | if FCurrentChar = FDelimiter then
|
|---|
| 409 | NextChar;
|
|---|
| 410 | end;
|
|---|
| 411 |
|
|---|
| 412 | procedure TCSVParser.SkipWhitespace;
|
|---|
| 413 | begin
|
|---|
| 414 | while FCurrentChar = SPACE do
|
|---|
| 415 | NextChar;
|
|---|
| 416 | end;
|
|---|
| 417 |
|
|---|
| 418 | procedure TCSVParser.NextChar;
|
|---|
| 419 | begin
|
|---|
| 420 | if FSourceStream.Read(FCurrentChar, CsvCharSize) < CsvCharSize then
|
|---|
| 421 | begin
|
|---|
| 422 | FCurrentChar := #0;
|
|---|
| 423 | EndOfFile := True;
|
|---|
| 424 | end;
|
|---|
| 425 | EndOfLine := FCurrentChar in LineEndingChars;
|
|---|
| 426 | end;
|
|---|
| 427 |
|
|---|
| 428 | procedure TCSVParser.ParseCell;
|
|---|
| 429 | begin
|
|---|
| 430 | FCellBuffer := '';
|
|---|
| 431 | if FIgnoreOuterWhitespace then
|
|---|
| 432 | SkipWhitespace;
|
|---|
| 433 | if FCurrentChar = FQuoteChar then
|
|---|
| 434 | ParseQuotedValue
|
|---|
| 435 | else
|
|---|
| 436 | ParseValue;
|
|---|
| 437 | end;
|
|---|
| 438 |
|
|---|
| 439 | procedure TCSVParser.ParseQuotedValue;
|
|---|
| 440 | var
|
|---|
| 441 | QuotationEnd: Boolean;
|
|---|
| 442 | begin
|
|---|
| 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;
|
|---|
| 472 | end;
|
|---|
| 473 |
|
|---|
| 474 | procedure TCSVParser.ParseValue;
|
|---|
| 475 | begin
|
|---|
| 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 := '';
|
|---|
| 486 | end;
|
|---|
| 487 |
|
|---|
| 488 | constructor TCSVParser.Create;
|
|---|
| 489 | begin
|
|---|
| 490 | inherited Create;
|
|---|
| 491 | ClearOutput;
|
|---|
| 492 | FStrStreamWrapper := nil;
|
|---|
| 493 | EndOfFile := True;
|
|---|
| 494 | end;
|
|---|
| 495 |
|
|---|
| 496 | destructor TCSVParser.Destroy;
|
|---|
| 497 | begin
|
|---|
| 498 | FreeAndNil(FStrStreamWrapper);
|
|---|
| 499 | inherited Destroy;
|
|---|
| 500 | end;
|
|---|
| 501 |
|
|---|
| 502 | procedure TCSVParser.SetSource(AStream: TStream);
|
|---|
| 503 | begin
|
|---|
| 504 | FSourceStream := AStream;
|
|---|
| 505 | ResetParser;
|
|---|
| 506 | end;
|
|---|
| 507 |
|
|---|
| 508 | procedure TCSVParser.SetSource(const AString: String); overload;
|
|---|
| 509 | begin
|
|---|
| 510 | FreeAndNil(FStrStreamWrapper);
|
|---|
| 511 | FStrStreamWrapper := TStringStream.Create(AString);
|
|---|
| 512 | SetSource(FStrStreamWrapper);
|
|---|
| 513 | end;
|
|---|
| 514 |
|
|---|
| 515 | procedure TCSVParser.ResetParser;
|
|---|
| 516 | begin
|
|---|
| 517 | ClearOutput;
|
|---|
| 518 | FSourceStream.Seek(0, soFromBeginning);
|
|---|
| 519 | EndOfFile := False;
|
|---|
| 520 | NextChar;
|
|---|
| 521 | end;
|
|---|
| 522 |
|
|---|
| 523 | // Parses next cell; returns True if there are more cells in the input stream.
|
|---|
| 524 | function TCSVParser.ParseNextCell: Boolean;
|
|---|
| 525 | var
|
|---|
| 526 | LineColCount: Integer;
|
|---|
| 527 | begin
|
|---|
| 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;
|
|---|
| 558 | end;
|
|---|
| 559 |
|
|---|
| 560 | { TCSVBuilder }
|
|---|
| 561 |
|
|---|
| 562 | function TCSVBuilder.GetDefaultOutputAsString: String;
|
|---|
| 563 | var
|
|---|
| 564 | StreamSize: Integer;
|
|---|
| 565 | begin
|
|---|
| 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;
|
|---|
| 573 | end;
|
|---|
| 574 |
|
|---|
| 575 | procedure TCSVBuilder.AppendStringToStream(const AString: String; AStream: TStream);
|
|---|
| 576 | var
|
|---|
| 577 | StrLen: Integer;
|
|---|
| 578 | begin
|
|---|
| 579 | StrLen := Length(AString);
|
|---|
| 580 | if StrLen > 0 then
|
|---|
| 581 | AStream.WriteBuffer(AString[1], StrLen);
|
|---|
| 582 | end;
|
|---|
| 583 |
|
|---|
| 584 | function TCSVBuilder.QuoteCSVString(const AValue: String): String;
|
|---|
| 585 | var
|
|---|
| 586 | I: Integer;
|
|---|
| 587 | ValueLen: Integer;
|
|---|
| 588 | NeedQuotation: Boolean;
|
|---|
| 589 | begin
|
|---|
| 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;
|
|---|
| 613 | end;
|
|---|
| 614 |
|
|---|
| 615 | constructor TCSVBuilder.Create;
|
|---|
| 616 | begin
|
|---|
| 617 | inherited Create;
|
|---|
| 618 | FDefaultOutput := TMemoryStream.Create;
|
|---|
| 619 | FOutputStream := FDefaultOutput;
|
|---|
| 620 | end;
|
|---|
| 621 |
|
|---|
| 622 | destructor TCSVBuilder.Destroy;
|
|---|
| 623 | begin
|
|---|
| 624 | FreeAndNil(FDefaultOutput);
|
|---|
| 625 | inherited Destroy;
|
|---|
| 626 | end;
|
|---|
| 627 |
|
|---|
| 628 | procedure TCSVBuilder.SetOutput(AStream: TStream);
|
|---|
| 629 | begin
|
|---|
| 630 | if Assigned(AStream) then
|
|---|
| 631 | FOutputStream := AStream
|
|---|
| 632 | else
|
|---|
| 633 | FOutputStream := FDefaultOutput;
|
|---|
| 634 |
|
|---|
| 635 | ResetBuilder;
|
|---|
| 636 | end;
|
|---|
| 637 |
|
|---|
| 638 | procedure TCSVBuilder.ResetBuilder;
|
|---|
| 639 | begin
|
|---|
| 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;
|
|---|
| 648 | end;
|
|---|
| 649 |
|
|---|
| 650 | procedure TCSVBuilder.AppendCell(const AValue: String);
|
|---|
| 651 | var
|
|---|
| 652 | CellValue: String;
|
|---|
| 653 | begin
|
|---|
| 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;
|
|---|
| 662 | end;
|
|---|
| 663 |
|
|---|
| 664 | procedure TCSVBuilder.AppendRow;
|
|---|
| 665 | begin
|
|---|
| 666 | AppendStringToStream(FLineEnding, FOutputStream);
|
|---|
| 667 | FNeedLeadingDelimiter := False;
|
|---|
| 668 | end;
|
|---|
| 669 |
|
|---|
| 670 | //------------------------------------------------------------------------------
|
|---|
| 671 |
|
|---|
| 672 | type
|
|---|
| 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 |
|
|---|
| 715 | procedure TCSVRow.ForceCellIndex(ACellIndex: Integer);
|
|---|
| 716 | begin
|
|---|
| 717 | while FCells.Count <= ACellIndex do
|
|---|
| 718 | AddCell();
|
|---|
| 719 | end;
|
|---|
| 720 |
|
|---|
| 721 | function TCSVRow.CreateNewCell(const AValue: String): TCSVCell;
|
|---|
| 722 | begin
|
|---|
| 723 | Result := TCSVCell.Create;
|
|---|
| 724 | Result.Value := AValue;
|
|---|
| 725 | end;
|
|---|
| 726 |
|
|---|
| 727 | function TCSVRow.GetCellValue(ACol: Integer): String;
|
|---|
| 728 | begin
|
|---|
| 729 | if HasCell(ACol) then
|
|---|
| 730 | Result := TCSVCell(FCells[ACol]).Value
|
|---|
| 731 | else
|
|---|
| 732 | Result := '';
|
|---|
| 733 | end;
|
|---|
| 734 |
|
|---|
| 735 | procedure TCSVRow.SetCellValue(ACol: Integer; const AValue: String);
|
|---|
| 736 | begin
|
|---|
| 737 | ForceCellIndex(ACol);
|
|---|
| 738 | TCSVCell(FCells[ACol]).Value := AValue;
|
|---|
| 739 | end;
|
|---|
| 740 |
|
|---|
| 741 | function TCSVRow.GetColCount: Integer;
|
|---|
| 742 | begin
|
|---|
| 743 | Result := FCells.Count;
|
|---|
| 744 | end;
|
|---|
| 745 |
|
|---|
| 746 | constructor TCSVRow.Create;
|
|---|
| 747 | begin
|
|---|
| 748 | inherited Create;
|
|---|
| 749 | FCells := TFPObjectList.Create;
|
|---|
| 750 | end;
|
|---|
| 751 |
|
|---|
| 752 | destructor TCSVRow.Destroy;
|
|---|
| 753 | begin
|
|---|
| 754 | FreeAndNil(FCells);
|
|---|
| 755 | inherited Destroy;
|
|---|
| 756 | end;
|
|---|
| 757 |
|
|---|
| 758 | procedure TCSVRow.AddCell(const AValue: String = '');
|
|---|
| 759 | begin
|
|---|
| 760 | FCells.Add(CreateNewCell(AValue));
|
|---|
| 761 | end;
|
|---|
| 762 |
|
|---|
| 763 | procedure TCSVRow.InsertCell(ACol: Integer; const AValue: String);
|
|---|
| 764 | begin
|
|---|
| 765 | FCells.Insert(ACol, CreateNewCell(AValue));
|
|---|
| 766 | end;
|
|---|
| 767 |
|
|---|
| 768 | procedure TCSVRow.RemoveCell(ACol: Integer);
|
|---|
| 769 | begin
|
|---|
| 770 | if HasCell(ACol) then
|
|---|
| 771 | FCells.Delete(ACol);
|
|---|
| 772 | end;
|
|---|
| 773 |
|
|---|
| 774 | function TCSVRow.HasCell(ACol: Integer): Boolean;
|
|---|
| 775 | begin
|
|---|
| 776 | Result := (ACol >= 0) and (ACol < FCells.Count);
|
|---|
| 777 | end;
|
|---|
| 778 |
|
|---|
| 779 | function TCSVRow.Clone: TCSVRow;
|
|---|
| 780 | var
|
|---|
| 781 | I: Integer;
|
|---|
| 782 | begin
|
|---|
| 783 | Result := TCSVRow.Create;
|
|---|
| 784 | for I := 0 to ColCount - 1 do
|
|---|
| 785 | Result.AddCell(CellValue[I]);
|
|---|
| 786 | end;
|
|---|
| 787 |
|
|---|
| 788 | procedure TCSVRow.TrimEmptyCells;
|
|---|
| 789 | var
|
|---|
| 790 | I: Integer;
|
|---|
| 791 | MaxCol: Integer;
|
|---|
| 792 | begin
|
|---|
| 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;
|
|---|
| 803 | end;
|
|---|
| 804 |
|
|---|
| 805 | procedure TCSVRow.SetValuesLineEnding(const ALineEnding: String);
|
|---|
| 806 | var
|
|---|
| 807 | I: Integer;
|
|---|
| 808 | begin
|
|---|
| 809 | for I := 0 to FCells.Count - 1 do
|
|---|
| 810 | CellValue[I] := ChangeLineEndings(CellValue[I], ALineEnding);
|
|---|
| 811 | end;
|
|---|
| 812 |
|
|---|
| 813 | { TCSVDocument }
|
|---|
| 814 |
|
|---|
| 815 | procedure TCSVDocument.ForceRowIndex(ARowIndex: Integer);
|
|---|
| 816 | begin
|
|---|
| 817 | while FRows.Count <= ARowIndex do
|
|---|
| 818 | AddRow();
|
|---|
| 819 | end;
|
|---|
| 820 |
|
|---|
| 821 | function TCSVDocument.CreateNewRow(const AFirstCell: String): TObject;
|
|---|
| 822 | var
|
|---|
| 823 | NewRow: TCSVRow;
|
|---|
| 824 | begin
|
|---|
| 825 | NewRow := TCSVRow.Create;
|
|---|
| 826 | if AFirstCell <> '' then
|
|---|
| 827 | NewRow.AddCell(AFirstCell);
|
|---|
| 828 | Result := NewRow;
|
|---|
| 829 | end;
|
|---|
| 830 |
|
|---|
| 831 | function TCSVDocument.GetCell(ACol, ARow: Integer): String;
|
|---|
| 832 | begin
|
|---|
| 833 | if HasRow(ARow) then
|
|---|
| 834 | Result := TCSVRow(FRows[ARow]).CellValue[ACol]
|
|---|
| 835 | else
|
|---|
| 836 | Result := '';
|
|---|
| 837 | end;
|
|---|
| 838 |
|
|---|
| 839 | procedure TCSVDocument.SetCell(ACol, ARow: Integer; const AValue: String);
|
|---|
| 840 | begin
|
|---|
| 841 | ForceRowIndex(ARow);
|
|---|
| 842 | TCSVRow(FRows[ARow]).CellValue[ACol] := AValue;
|
|---|
| 843 | end;
|
|---|
| 844 |
|
|---|
| 845 | function TCSVDocument.GetCSVText: String;
|
|---|
| 846 | var
|
|---|
| 847 | StringStream: TStringStream;
|
|---|
| 848 | begin
|
|---|
| 849 | StringStream := TStringStream.Create('');
|
|---|
| 850 | try
|
|---|
| 851 | SaveToStream(StringStream);
|
|---|
| 852 | Result := StringStream.DataString;
|
|---|
| 853 | finally
|
|---|
| 854 | FreeAndNil(StringStream);
|
|---|
| 855 | end;
|
|---|
| 856 | end;
|
|---|
| 857 |
|
|---|
| 858 | procedure TCSVDocument.SetCSVText(const AValue: String);
|
|---|
| 859 | var
|
|---|
| 860 | StringStream: TStringStream;
|
|---|
| 861 | begin
|
|---|
| 862 | StringStream := TStringStream.Create(AValue);
|
|---|
| 863 | try
|
|---|
| 864 | LoadFromStream(StringStream);
|
|---|
| 865 | finally
|
|---|
| 866 | FreeAndNil(StringStream);
|
|---|
| 867 | end;
|
|---|
| 868 | end;
|
|---|
| 869 |
|
|---|
| 870 | function TCSVDocument.GetRowCount: Integer;
|
|---|
| 871 | begin
|
|---|
| 872 | Result := FRows.Count;
|
|---|
| 873 | end;
|
|---|
| 874 |
|
|---|
| 875 | function TCSVDocument.GetColCount(ARow: Integer): Integer;
|
|---|
| 876 | begin
|
|---|
| 877 | if HasRow(ARow) then
|
|---|
| 878 | Result := TCSVRow(FRows[ARow]).ColCount
|
|---|
| 879 | else
|
|---|
| 880 | Result := 0;
|
|---|
| 881 | end;
|
|---|
| 882 |
|
|---|
| 883 | // Returns maximum number of columns in the document
|
|---|
| 884 | function TCSVDocument.GetMaxColCount: Integer;
|
|---|
| 885 | var
|
|---|
| 886 | I, CC: Integer;
|
|---|
| 887 | begin
|
|---|
| 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;
|
|---|
| 898 | end;
|
|---|
| 899 |
|
|---|
| 900 | constructor TCSVDocument.Create;
|
|---|
| 901 | begin
|
|---|
| 902 | inherited Create;
|
|---|
| 903 | FRows := TFPObjectList.Create;
|
|---|
| 904 | FParser := nil;
|
|---|
| 905 | FBuilder := nil;
|
|---|
| 906 | end;
|
|---|
| 907 |
|
|---|
| 908 | destructor TCSVDocument.Destroy;
|
|---|
| 909 | begin
|
|---|
| 910 | FreeAndNil(FBuilder);
|
|---|
| 911 | FreeAndNil(FParser);
|
|---|
| 912 | FreeAndNil(FRows);
|
|---|
| 913 | inherited Destroy;
|
|---|
| 914 | end;
|
|---|
| 915 |
|
|---|
| 916 | procedure TCSVDocument.LoadFromFile(const AFilename: String);
|
|---|
| 917 | var
|
|---|
| 918 | FileStream: TFileStream;
|
|---|
| 919 | begin
|
|---|
| 920 | FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
|
|---|
| 921 | try
|
|---|
| 922 | LoadFromStream(FileStream);
|
|---|
| 923 | finally
|
|---|
| 924 | FileStream.Free;
|
|---|
| 925 | end;
|
|---|
| 926 | end;
|
|---|
| 927 |
|
|---|
| 928 | procedure TCSVDocument.LoadFromStream(AStream: TStream);
|
|---|
| 929 | var
|
|---|
| 930 | I, J, MaxCol: Integer;
|
|---|
| 931 | begin
|
|---|
| 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;
|
|---|
| 952 | end;
|
|---|
| 953 |
|
|---|
| 954 | procedure TCSVDocument.SaveToFile(const AFilename: String);
|
|---|
| 955 | var
|
|---|
| 956 | FileStream: TFileStream;
|
|---|
| 957 | begin
|
|---|
| 958 | FileStream := TFileStream.Create(AFilename, fmCreate);
|
|---|
| 959 | try
|
|---|
| 960 | SaveToStream(FileStream);
|
|---|
| 961 | finally
|
|---|
| 962 | FileStream.Free;
|
|---|
| 963 | end;
|
|---|
| 964 | end;
|
|---|
| 965 |
|
|---|
| 966 | procedure TCSVDocument.SaveToStream(AStream: TStream);
|
|---|
| 967 | var
|
|---|
| 968 | I, J, MaxCol: Integer;
|
|---|
| 969 | begin
|
|---|
| 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;
|
|---|
| 989 | end;
|
|---|
| 990 |
|
|---|
| 991 | procedure TCSVDocument.AddRow(const AFirstCell: String = '');
|
|---|
| 992 | begin
|
|---|
| 993 | FRows.Add(CreateNewRow(AFirstCell));
|
|---|
| 994 | end;
|
|---|
| 995 |
|
|---|
| 996 | procedure TCSVDocument.AddCell(ARow: Integer; const AValue: String = '');
|
|---|
| 997 | begin
|
|---|
| 998 | ForceRowIndex(ARow);
|
|---|
| 999 | TCSVRow(FRows[ARow]).AddCell(AValue);
|
|---|
| 1000 | end;
|
|---|
| 1001 |
|
|---|
| 1002 | procedure TCSVDocument.InsertRow(ARow: Integer; const AFirstCell: String = '');
|
|---|
| 1003 | begin
|
|---|
| 1004 | if HasRow(ARow) then
|
|---|
| 1005 | FRows.Insert(ARow, CreateNewRow(AFirstCell))
|
|---|
| 1006 | else
|
|---|
| 1007 | AddRow(AFirstCell);
|
|---|
| 1008 | end;
|
|---|
| 1009 |
|
|---|
| 1010 | procedure TCSVDocument.InsertCell(ACol, ARow: Integer; const AValue: String);
|
|---|
| 1011 | begin
|
|---|
| 1012 | ForceRowIndex(ARow);
|
|---|
| 1013 | TCSVRow(FRows[ARow]).InsertCell(ACol, AValue);
|
|---|
| 1014 | end;
|
|---|
| 1015 |
|
|---|
| 1016 | procedure TCSVDocument.RemoveRow(ARow: Integer);
|
|---|
| 1017 | begin
|
|---|
| 1018 | if HasRow(ARow) then
|
|---|
| 1019 | FRows.Delete(ARow);
|
|---|
| 1020 | end;
|
|---|
| 1021 |
|
|---|
| 1022 | procedure TCSVDocument.RemoveCell(ACol, ARow: Integer);
|
|---|
| 1023 | begin
|
|---|
| 1024 | if HasRow(ARow) then
|
|---|
| 1025 | TCSVRow(FRows[ARow]).RemoveCell(ACol);
|
|---|
| 1026 | end;
|
|---|
| 1027 |
|
|---|
| 1028 | function TCSVDocument.HasRow(ARow: Integer): Boolean;
|
|---|
| 1029 | begin
|
|---|
| 1030 | Result := (ARow >= 0) and (ARow < FRows.Count);
|
|---|
| 1031 | end;
|
|---|
| 1032 |
|
|---|
| 1033 | function TCSVDocument.HasCell(ACol, ARow: Integer): Boolean;
|
|---|
| 1034 | begin
|
|---|
| 1035 | if HasRow(ARow) then
|
|---|
| 1036 | Result := TCSVRow(FRows[ARow]).HasCell(ACol)
|
|---|
| 1037 | else
|
|---|
| 1038 | Result := False;
|
|---|
| 1039 | end;
|
|---|
| 1040 |
|
|---|
| 1041 | function TCSVDocument.IndexOfCol(const AString: String; ARow: Integer): Integer;
|
|---|
| 1042 | var
|
|---|
| 1043 | CC: Integer;
|
|---|
| 1044 | begin
|
|---|
| 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;
|
|---|
| 1051 | end;
|
|---|
| 1052 |
|
|---|
| 1053 | function TCSVDocument.IndexOfRow(const AString: String; ACol: Integer): Integer;
|
|---|
| 1054 | var
|
|---|
| 1055 | RC: Integer;
|
|---|
| 1056 | begin
|
|---|
| 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;
|
|---|
| 1063 | end;
|
|---|
| 1064 |
|
|---|
| 1065 | procedure TCSVDocument.Clear;
|
|---|
| 1066 | begin
|
|---|
| 1067 | FRows.Clear;
|
|---|
| 1068 | end;
|
|---|
| 1069 |
|
|---|
| 1070 | procedure TCSVDocument.CloneRow(ARow, AInsertPos: Integer);
|
|---|
| 1071 | var
|
|---|
| 1072 | NewRow: TObject;
|
|---|
| 1073 | begin
|
|---|
| 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);
|
|---|
| 1083 | end;
|
|---|
| 1084 |
|
|---|
| 1085 | procedure TCSVDocument.ExchangeRows(ARow1, ARow2: Integer);
|
|---|
| 1086 | begin
|
|---|
| 1087 | if not (HasRow(ARow1) and HasRow(ARow2)) then
|
|---|
| 1088 | Exit;
|
|---|
| 1089 | FRows.Exchange(ARow1, ARow2);
|
|---|
| 1090 | end;
|
|---|
| 1091 |
|
|---|
| 1092 | procedure TCSVDocument.UnifyEmbeddedLineEndings;
|
|---|
| 1093 | var
|
|---|
| 1094 | I: Integer;
|
|---|
| 1095 | begin
|
|---|
| 1096 | for I := 0 to FRows.Count - 1 do
|
|---|
| 1097 | TCSVRow(FRows[I]).SetValuesLineEnding(FLineEnding);
|
|---|
| 1098 | end;
|
|---|
| 1099 |
|
|---|
| 1100 | procedure TCSVDocument.RemoveTrailingEmptyCells;
|
|---|
| 1101 | var
|
|---|
| 1102 | I: Integer;
|
|---|
| 1103 | begin
|
|---|
| 1104 | for I := 0 to FRows.Count - 1 do
|
|---|
| 1105 | TCSVRow(FRows[I]).TrimEmptyCells;
|
|---|
| 1106 | end;
|
|---|
| 1107 |
|
|---|
| 1108 | end.
|
|---|