Changeset 568


Ignore:
Timestamp:
Jan 30, 2024, 11:34:58 PM (10 months ago)
Author:
chronos
Message:
  • Modified: Update Common package.
Location:
Common
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • Common/Common.pas

    r566 r568  
    6565function GetFileFilterItemExt(Filter: string; Index: Integer): string;
    6666function IntToBin(Data: Int64; Count: Byte): string;
    67 function Implode(Separator: Char; List: TList<string>): string;
    68 function Implode(Separator: Char; List: TStringList; Around: string = ''): string;
     67function Implode(Separator: string; List: TList<string>): string;
     68function Implode(Separator: string; List: TStringList; Around: string = ''): string;
    6969function LastPos(const SubStr: String; const S: String): Integer;
    7070function LoadFileToStr(const FileName: TFileName): AnsiString;
    … …  
    207207end;*)
    208208
    209 function Implode(Separator: Char; List: TStringList; Around: string = ''): string;
     209function Implode(Separator: string; List: TStringList; Around: string = ''): string;
    210210var
    211211  I: Integer;
    … …  
    326326end;
    327327
    328 function Implode(Separator: Char; List: TList<string>): string;
     328function Implode(Separator: string; List: TList<string>): string;
    329329var
    330330  I: Integer;

  • Common/FormEx.pas

    r567 r568  
    6868  end;
    6969
     70  PersistentForm.Load(Self);
    7071  Translator.TranslateComponentRecursive(Self);
    7172  ThemeManager.UseTheme(Self);

  • Common/Forms/FormAbout.pas

    r566 r568  
    55uses
    66  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    7   StdCtrls, ExtCtrls, ApplicationInfo, Common, Translator, Theme, FormEx;
     7  StdCtrls, ExtCtrls, ApplicationInfo, Common, FormEx;
    88
    99type

  • Common/Table.pas

    r566 r568  
    44
    55uses
    6   Classes, SysUtils, Generics.Collections, ComCtrls;
     6  Classes, SysUtils, Generics.Collections, ComCtrls, XMLRead, XMLWrite, DOM;
    77
    88type
    9   TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki, tfXml);
     9  TTableFormat = (tfExcel, tfPlain, tfCsv, tfHtml, tfListView, tfMediaWiki,
     10    tfXml, tfJson);
     11  TTableFormats = set of TTableFormat;
    1012
    1113  { TRow }
    … …  
    2224  TTable = class
    2325  private
    24     function QuoteCsvString(Text: string): string;
     26    function QuoteString(Text: string; Quote: string): string;
     27    function UnquoteString(Text: string; Quote: string): string;
    2528    function ReplaceXmlEntities(Text: string): string;
    2629  public
    … …  
    3740    function GetOutputHtml: string;
    3841    function GetOutputMediaWiki: string;
     42    function GetOutputJson: string;
    3943    procedure GetOutputListView(ListView: TListView);
    4044    function GetOutput(OutputFormat: TTableFormat): string;
     45    procedure SetInputCsv(Text: string);
     46    procedure SetInputMediaWiki(Text: string);
     47    procedure SetInputJson(Text: string);
     48    procedure SetInputXml(Text: string);
     49    procedure SetInput(OutputFormat: TTableFormat; Text: string);
     50    function GetInputFormats: TTableFormats;
    4151    constructor Create;
    4252    destructor Destroy; override;
    … …  
    4555const
    4656  TableFormatText: array[TTableFormat] of string = ('Excel paste', 'Plain text', 'CSV',
    47     'HTML', 'ListView', 'MediaWiki', 'XML');
     57    'HTML', 'ListView', 'MediaWiki', 'XML', 'JSON');
    4858  TableFormatExt: array[TTableFormat] of string = ('.txt', '.txt', '.csv',
    49     '.htm', '', '.txt', '.xml');
     59    '.htm', '', '.txt', '.xml', '.json');
    5060
    5161
    … …  
    5565  Common;
    5666
     67resourcestring
     68  SUnsupportedFormat = 'Unsupported format';
     69
    5770{ TTable }
    5871
    59 function TTable.QuoteCsvString(Text: string): string;
    60 begin
    61   if Text <> '' then Result := '"' + Text + '"'
     72function TTable.QuoteString(Text: string; Quote: string): string;
     73begin
     74  if Text <> '' then Result := Quote + Text + Quote
    6275    else Result := Text;
     76end;
     77
     78function TTable.UnquoteString(Text: string; Quote: string): string;
     79begin
     80  Text := Trim(Text);
     81  if Text.StartsWith(Quote) and Text.EndsWith(Quote) then
     82    Result := Copy(Text, Length(Quote) + 1, Length(Text) - 2 * Length(Quote));
    6383end;
    6484
    … …  
    7494procedure TTable.Clear;
    7595begin
     96  Columns.Clear;
    7697  Rows.Clear;
    7798end;
    … …  
    87108  I: Integer;
    88109begin
    89   Result := '';
     110  Result := Implode(#9, Columns) + LineEnding;
    90111  for I := 0 to Rows.Count - 1 do
    91112    Result := Result + Implode(#9, Rows[I].Cells) + LineEnding;
    … …  
    116137    if J > 0 then Result := Result + ',';
    117138    if Columns[J] <> '' then
    118       Result := Result + QuoteCsvString(Columns[J]);
     139      Result := Result + QuoteString(Columns[J], '"');
    119140  end;
    120141  Result := Result + LineEnding;
    … …  
    126147      if J > 0 then Result := Result + ',';
    127148      if Cells[J] <> '' then
    128         Result := Result + QuoteCsvString(Cells[J]);
     149        Result := Result + QuoteString(Cells[J], '"');
    129150    end;
    130151    Result := Result + LineEnding;
    … …  
    138159begin
    139160  Result := '<?xml version="1.0" encoding="UTF-8"?>' + LineEnding +
    140     '<vcard>' + LineEnding +
    141     '  <title>' + Title + '</title>' + LineEnding +
    142     '  <contacts>' + LineEnding;
     161    '<table>' + LineEnding;
     162  if Title <> '' then
     163    Result := Result + '  <title>' + Title + '</title>' + LineEnding;
     164  Result := Result + '  <rows>' + LineEnding;
    143165  for I := 0 to Rows.Count - 1 do begin
    144     Result := Result + '    <contact>' + LineEnding;
     166    Result := Result + '    <row>' + LineEnding;
    145167    for J := 0 to Rows[I].Cells.Count - 1 do
    146168      if Rows[I].Cells[J] <> '' then
    147         Result := Result + '      <property name="' + Columns[J] + '">' + ReplaceXmlEntities(Rows[I].Cells[J]) + '</property>' + LineEnding;
    148     Result := Result + '    </contact>' + LineEnding;
    149   end;
    150   Result := Result + '  </contacts>' + LineEnding +
    151     '</vcard>';
     169        Result := Result + '      <cell name="' + Columns[J] + '">' + ReplaceXmlEntities(Rows[I].Cells[J]) + '</cell>' + LineEnding;
     170    Result := Result + '    </row>' + LineEnding;
     171  end;
     172  Result := Result + '  </rows>' + LineEnding +
     173    '</table>';
    152174end;
    153175
    … …  
    207229end;
    208230
     231function TTable.GetOutputJson: string;
     232var
     233  I: Integer;
     234  J: Integer;
     235begin
     236  Result := '[' + LineEnding;
     237  for I := 0 to Rows.Count - 1 do begin
     238    Result := Result + '  {' + LineEnding;
     239    for J := 0 to Rows[I].Cells.Count - 1 do begin
     240      if Rows[I].Cells[J] <> '' then begin
     241        Result := Result + '    "' + Columns[J] + '": "' + Rows[I].Cells[J] + '"';
     242        if J < Rows[I].Cells.Count - 1 then Result := Result + ',';
     243        Result := Result + LineEnding;
     244      end;
     245    end;
     246    Result := Result + '  }';
     247    if I < Rows.Count - 1 then Result := Result + ',';
     248    Result := Result + LineEnding;
     249  end;
     250  Result := Result + ']' + LineEnding;
     251end;
     252
    209253procedure TTable.GetOutputListView(ListView: TListView);
    210254var
    … …  
    255299    tfMediaWiki: Result := GetOutputMediaWiki;
    256300    tfXml: Result := GetOutputXml;
    257     else Result := '';
    258   end;
     301    tfJson: Result := GetOutputJson;
     302    else raise Exception.Create(SUnsupportedFormat);
     303  end;
     304end;
     305
     306procedure TTable.SetInputCsv(Text: string);
     307var
     308  Lines: TStringList;
     309  I: Integer;
     310  Row: TRow;
     311begin
     312  Clear;
     313  Lines := TStringList.Create;
     314  try
     315    Lines.Text := Text;
     316    for I := 0 to Lines.Count - 1 do begin
     317      if I = 0 then begin
     318        Columns.StrictDelimiter := True;
     319        Columns.DelimitedText := Trim(Lines[I]);
     320      end else begin
     321        Row := TRow.Create;
     322        Row.Cells.StrictDelimiter := True;
     323        Row.Cells.DelimitedText := Trim(Lines[I]);
     324        Rows.Add(Row);
     325      end;
     326    end;
     327  finally
     328    FreeAndNil(Lines);
     329  end;
     330end;
     331
     332procedure TTable.SetInputMediaWiki(Text: string);
     333var
     334  Lines: TStringList;
     335  I: Integer;
     336  Line: string;
     337  InsideTable: Boolean;
     338  Index: Integer;
     339  Row: TRow;
     340begin
     341  Clear;
     342  Lines := TStringList.Create;
     343  try
     344    Lines.Text := Text;
     345    Row := nil;
     346    InsideTable := False;
     347    for I := 0 to Lines.Count - 1 do begin
     348      Line := Trim(Lines[I]);
     349      if not InsideTable then begin
     350        if Line.StartsWith('{|') then InsideTable := True;
     351      end else begin
     352        if Line.StartsWith('|}') then InsideTable := False
     353        else
     354        if Line.StartsWith('!') then begin
     355          Delete(Line, 1, 1);
     356          Line := Trim(Line);
     357          repeat
     358            Index := Pos('!!', Line);
     359            if Index > 0 then begin
     360              Columns.Add(Trim(Copy(Line, 1, Index - 1)));
     361              Delete(Line, 1, Index + 1);
     362            end else begin
     363              Columns.Add(Trim(Line));
     364              Break;
     365            end;
     366          until False;
     367        end else
     368        if Line.StartsWith('|-') then begin
     369          if Assigned(Row) then Rows.Add(Row);
     370          Row := TRow.Create;
     371        end else
     372        if Line.StartsWith('|') then begin
     373          if Assigned(Row) then begin
     374            Delete(Line, 1, 1);
     375            Line := Trim(Line);
     376            repeat
     377              Index := Pos('||', Line);
     378              if Index > 0 then begin
     379                Row.Cells.Add(Trim(Copy(Line, 1, Index - 1)));
     380                Delete(Line, 1, Index + 1);
     381              end else begin
     382                Row.Cells.Add(Trim(Line));
     383                Break;
     384              end;
     385            until False;
     386
     387            while Row.Cells.Count < Columns.Count do
     388              Row.Cells.Add('');
     389          end;
     390        end;
     391      end;
     392    end;
     393    if Assigned(Row) then
     394      Rows.Add(Row);
     395  finally
     396    FreeAndNil(Lines);
     397  end;
     398end;
     399
     400procedure TTable.SetInputJson(Text: string);
     401type
     402  TState = (stOutside, stArray, stItem);
     403var
     404  Lines: TStringList;
     405  I: Integer;
     406  Line: string;
     407  State: TState;
     408  Index: Integer;
     409  Row: TRow;
     410  ColumnIndex: Integer;
     411  ColumnName: string;
     412  Value: string;
     413begin
     414  Clear;
     415  Lines := TStringList.Create;
     416  try
     417    Lines.Text := Text;
     418    Row := nil;
     419    State := stOutside;
     420    for I := 0 to Lines.Count - 1 do begin
     421      Line := Trim(Lines[I]);
     422      if State = stOutSide then begin
     423        if Line.StartsWith('[') then begin
     424          State := stArray;
     425        end;
     426      end else
     427      if State = stArray then begin
     428        if Line.StartsWith('{') then begin
     429          State := stItem;
     430          Row := TRow.Create;
     431          Rows.Add(Row);
     432        end;
     433      end else
     434      if State = stItem then begin
     435        if Line.StartsWith('}') then begin
     436          State := stArray;
     437        end else begin
     438          Index := Pos(':', Line);
     439          if Index > 0 then begin
     440            ColumnName := UnquoteString(Trim(Copy(Line, 1, Index - 1)), '"');
     441            ColumnIndex := Columns.IndexOf(ColumnName);
     442            if ColumnIndex < 0 then begin
     443              Columns.Add(ColumnName);
     444              ColumnIndex := Columns.Count - 1;
     445            end;
     446            while Row.Cells.Count < Columns.Count do
     447              Row.Cells.Add('');
     448            Value := Trim(Copy(Line, Index + 1, MaxInt));
     449            if Value.EndsWith(',') then Value := Copy(Value, 1, Length(Value) - 1);
     450            Row.Cells[ColumnIndex] := UnquoteString(Value, '"');
     451          end;
     452        end;
     453      end;
     454    end;
     455  finally
     456    FreeAndNil(Lines);
     457  end;
     458end;
     459
     460procedure TTable.SetInputXml(Text: string);
     461var
     462  Doc: TXMLDocument;
     463  TextStream: TStringStream;
     464  TableNode: TDOMNode;
     465  RowsNode: TDOMNode;
     466  RowNode: TDOMNode;
     467  CellNode: TDOMNode;
     468  NewRow: TRow;
     469  CellName: string;
     470  ColumnIndex: Integer;
     471begin
     472  Clear;
     473  TextStream := TStringStream.Create(Text);
     474  ReadXMLFile(Doc, TextStream);
     475  TableNode := Doc.DocumentElement;
     476  if Assigned(TableNode) and (TableNode.NodeName = 'table') then
     477  with TableNode do begin
     478    RowsNode := FindNode('rows');
     479    if Assigned(RowsNode) then begin
     480      RowNode := RowsNode.FirstChild;
     481      while Assigned(RowNode) and (RowNode.NodeName = 'row') do begin
     482        NewRow := TRow.Create;
     483        CellNode := RowNode.FirstChild;
     484        while Assigned(CellNode) and (CellNode.NodeName = 'cell') do begin
     485          CellName := string(TDOMElement(CellNode).GetAttribute('name'));
     486          ColumnIndex := Columns.IndexOf(CellName);
     487          if ColumnIndex < 0 then begin
     488            Columns.Add(CellName);
     489            ColumnIndex := Columns.Count - 1;
     490          end;
     491
     492          while NewRow.Cells.Count <= ColumnIndex do
     493            NewRow.Cells.Add('');
     494          NewRow.Cells[ColumnIndex] := string(CellNode.TextContent);
     495          CellNode := CellNode.NextSibling;
     496        end;
     497        Rows.Add(NewRow);
     498        RowNode := RowNode.NextSibling;
     499      end;
     500    end;
     501  end;
     502  FreeAndNil(TextStream);
     503  FreeAndNil(Doc);
     504end;
     505
     506procedure TTable.SetInput(OutputFormat: TTableFormat; Text: string);
     507begin
     508  case OutputFormat of
     509    tfCsv: SetInputCsv(Text);
     510    tfMediaWiki: SetInputMediaWiki(Text);
     511    tfJson: SetInputJson(Text);
     512    tfXml: SetInputXml(Text);
     513    else raise Exception.Create(SUnsupportedFormat);
     514  end;
     515end;
     516
     517function TTable.GetInputFormats: TTableFormats;
     518begin
     519  Result := [tfCsv, tfJson, tfMediaWiki, tfXml];
    259520end;
    260521
Note: See TracChangeset for help on using the changeset viewer.