csvdocument.pas 28 KB

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