- Timestamp:
- Jul 2, 2023, 3:05:45 PM (18 months ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Table.pas
r168 r169 7 7 8 8 type 9 TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki, tfXml); 9 TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki, 10 tfXml, tfJson); 10 11 11 12 { TRow } … … 22 23 TTable = class 23 24 private 24 function QuoteCsvString(Text: string): string; 25 function QuoteString(Text: string; Quote: string): string; 26 function UnquoteString(Text: string; Quote: string): string; 25 27 function ReplaceXmlEntities(Text: string): string; 26 28 public … … 37 39 function GetOutputHtml: string; 38 40 function GetOutputMediaWiki: string; 41 function GetOutputJson: string; 39 42 procedure GetOutputListView(ListView: TListView); 40 43 function GetOutput(OutputFormat: TTableFormat): string; … … 45 48 procedure SetInputHtml(Text: string); 46 49 procedure SetInputMediaWiki(Text: string); 50 procedure SetInputJson(Text: string); 47 51 procedure SetInput(OutputFormat: TTableFormat; Text: string); 48 52 constructor Create; … … 52 56 const 53 57 TableFormatText: array[TTableFormat] of string = ('Excel paste', 'Plain text', 'CSV', 54 'HTML', 'ListView', 'MediaWiki', 'XML' );58 'HTML', 'ListView', 'MediaWiki', 'XML', 'JSON'); 55 59 TableFormatExt: array[TTableFormat] of string = ('.txt', '.txt', '.csv', 56 '.htm', '', '.txt', '.xml' );60 '.htm', '', '.txt', '.xml', '.json'); 57 61 58 62 … … 67 71 { TTable } 68 72 69 function TTable.Quote CsvString(Text: string): string;70 begin 71 if Text <> '' then Result := '"' + Text + '"'73 function TTable.QuoteString(Text: string; Quote: string): string; 74 begin 75 if Text <> '' then Result := Quote + Text + Quote 72 76 else Result := Text; 77 end; 78 79 function TTable.UnquoteString(Text: string; Quote: string): string; 80 begin 81 Text := Trim(Text); 82 if Text.StartsWith(Quote) and Text.EndsWith(Quote) then 83 Result := Copy(Text, Length(Quote) + 1, Length(Text) - 2 * Length(Quote)); 73 84 end; 74 85 … … 98 109 I: Integer; 99 110 begin 100 Result := '';111 Result := Implode(#9, Columns) + LineEnding; 101 112 for I := 0 to Rows.Count - 1 do 102 113 Result := Result + Implode(#9, Rows[I].Cells) + LineEnding; … … 127 138 if J > 0 then Result := Result + ','; 128 139 if Columns[J] <> '' then 129 Result := Result + Quote CsvString(Columns[J]);140 Result := Result + QuoteString(Columns[J], '"'); 130 141 end; 131 142 Result := Result + LineEnding; … … 137 148 if J > 0 then Result := Result + ','; 138 149 if Cells[J] <> '' then 139 Result := Result + Quote CsvString(Cells[J]);150 Result := Result + QuoteString(Cells[J], '"'); 140 151 end; 141 152 Result := Result + LineEnding; … … 149 160 begin 150 161 Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding + 151 '<table>' + LineEnding + 152 ' <title>' + Title + '</title>' + LineEnding + 153 ' <rows>' + LineEnding; 162 '<table>' + LineEnding; 163 if Title <> '' then 164 Result := Result + ' <title>' + Title + '</title>' + LineEnding; 165 Result := Result + ' <rows>' + LineEnding; 154 166 for I := 0 to Rows.Count - 1 do begin 155 167 Result := Result + ' <row>' + LineEnding; … … 218 230 end; 219 231 232 function TTable.GetOutputJson: string; 233 var 234 I: Integer; 235 J: Integer; 236 begin 237 Result := '[' + LineEnding; 238 for I := 0 to Rows.Count - 1 do begin 239 Result := Result + ' {' + LineEnding; 240 for J := 0 to Rows[I].Cells.Count - 1 do begin 241 if Rows[I].Cells[J] <> '' then begin 242 Result := Result + ' "' + Columns[J] + '": "' + Rows[I].Cells[J] + '"'; 243 if J < Rows[I].Cells.Count - 1 then Result := Result + ','; 244 Result := Result + LineEnding; 245 end; 246 end; 247 Result := Result + ' }'; 248 if I < Rows.Count - 1 then Result := Result + ','; 249 Result := Result + LineEnding; 250 end; 251 Result := Result + ']' + LineEnding; 252 end; 253 220 254 procedure TTable.GetOutputListView(ListView: TListView); 221 255 var … … 266 300 tfMediaWiki: Result := GetOutputMediaWiki; 267 301 tfXml: Result := GetOutputXml; 302 tfJson: Result := GetOutputJson; 268 303 else raise Exception.Create(SUnsupportedFormat); 269 304 end; … … 384 419 end; 385 420 421 procedure TTable.SetInputJson(Text: string); 422 type 423 TState = (stOutside, stArray, stItem); 424 var 425 Lines: TStringList; 426 I: Integer; 427 Line: string; 428 State: TState; 429 Index: Integer; 430 Row: TRow; 431 ColumnIndex: Integer; 432 ColumnName: string; 433 Value: string; 434 begin 435 Clear; 436 Lines := TStringList.Create; 437 try 438 Lines.Text := Text; 439 Row := nil; 440 State := stOutside; 441 for I := 0 to Lines.Count - 1 do begin 442 Line := Trim(Lines[I]); 443 if State = stOutSide then begin 444 if Line.StartsWith('[') then begin 445 State := stArray; 446 end; 447 end else 448 if State = stArray then begin 449 if Line.StartsWith('{') then begin 450 State := stItem; 451 Row := TRow.Create; 452 Rows.Add(Row); 453 end; 454 end else 455 if State = stItem then begin 456 if Line.StartsWith('}') then begin 457 State := stArray; 458 end else begin 459 Index := Pos(':', Line); 460 if Index > 0 then begin 461 ColumnName := UnquoteString(Trim(Copy(Line, 1, Index - 1)), '"'); 462 ColumnIndex := Columns.IndexOf(ColumnName); 463 if ColumnIndex < 0 then begin 464 Columns.Add(ColumnName); 465 ColumnIndex := Columns.Count - 1; 466 end; 467 while Row.Cells.Count < Columns.Count do 468 Row.Cells.Add(''); 469 Value := Trim(Copy(Line, Index + 1, MaxInt)); 470 if Value.EndsWith(',') then Value := Copy(Value, 1, Length(Value) - 1); 471 Row.Cells[ColumnIndex] := UnquoteString(Value, '"'); 472 end; 473 end; 474 end; 475 end; 476 finally 477 FreeAndNil(Lines); 478 end; 479 end; 480 386 481 procedure TTable.SetInput(OutputFormat: TTableFormat; Text: string); 387 482 begin … … 393 488 tfMediaWiki: SetInputMediaWiki(Text); 394 489 tfXml: SetInputXml(Text); 490 tfJson: SetInputJson(Text); 395 491 else raise Exception.Create(SUnsupportedFormat); 396 492 end; -
trunk/TestCases.pas
r168 r169 308 308 Output := Input; 309 309 end; 310 with TTestCaseVCardExportImport(AddNew('Export/Import XML', TTestCaseVCardExportImport)) do begin 311 Format := tfXml; 312 HumanReadableHeader := False; 313 Input := BeginEnd( 314 'N:Surname;Name' + VCardLineEnding + 315 'FN:Name Surname' + VCardLineEnding) + 316 BeginEnd( 317 'N:Surname2;Name2' + VCardLineEnding + 318 'FN:Name2 Surname2' + VCardLineEnding); 319 Output := Input; 320 end; 321 with TTestCaseVCardExportImport(AddNew('Export/Import JSON', TTestCaseVCardExportImport)) do begin 322 Format := tfJSON; 323 HumanReadableHeader := False; 324 Input := BeginEnd( 325 'N:Surname;Name' + VCardLineEnding + 326 'FN:Name Surname' + VCardLineEnding) + 327 BeginEnd( 328 'N:Surname2;Name2' + VCardLineEnding + 329 'FN:Name2 Surname2' + VCardLineEnding); 330 Output := Input; 331 end; 310 332 311 333 with TTestCaseLoadSave(AddNew('Merge same cell phone', TTestCaseLoadSave)) do begin
Note:
See TracChangeset
for help on using the changeset viewer.