Changeset 168 for trunk


Ignore:
Timestamp:
Jul 1, 2023, 8:17:50 PM (17 months ago)
Author:
chronos
Message:
Location:
trunk
Files:
13 edited

Legend:

Unmodified
Added
Removed

  • trunk/Core.pas

    r167 r168  
    221221  FormImport := TFormImport.Create(nil);
    222222  try
    223     FormImport.ShowModal;
     223    if FormImport.ShowModal = mrOK then begin
     224      TVCardFile(DataFile).Modified := True;
     225      UpdateFile;
     226    end;
    224227  finally
    225228    FormImport.Free;

  • trunk/Forms/FormExport.pas

    r167 r168  
    3636    Table: TTable;
    3737    RedrawPending: Boolean;
    38     procedure PrepareTable;
    3938    procedure UpdateFileNameExt;
    4039    procedure LoadConfig;
    … …  
    6261begin
    6362  TableFormat := TTableFormat(ComboBoxOutputFormat.Items.Objects[ComboBoxOutputFormat.ItemIndex]);
    64   SaveStringToFile(Table.GetOutput(TableFormat), EditOutputFile.Text);
     63  TVCardFile(Core.Core.DataFile).VCard.ExportToFile(EditOutputFile.Text, TableFormat,
     64    CheckBoxHumanReadableHeader.Checked);
    6565end;
    6666
    … …  
    118118begin
    119119  if RedrawPending then begin
    120     PrepareTable;
     120    TVCardFile(Core.Core.DataFile).VCard.ExportToTable(Table,
     121      CheckBoxHumanReadableHeader.Checked);
    121122    Table.GetOutputListView(ListView1);
    122123    RedrawPending := False;
    123   end;
    124 end;
    125 
    126 procedure TFormExport.PrepareTable;
    127 var
    128   Row: TRow;
    129   I: Integer;
    130   J: Integer;
    131   Values: TStringList;
    132   Index: Integer;
    133   Fields: TContactFields;
    134   Field: TContactField;
    135   Columns: TStringList;
    136 begin
    137   Fields := TContact.GetFields;
    138   Table.Clear;
    139 
    140   Values := TStringList.Create;
    141   Columns := TStringList.Create;
    142   try
    143     with TVCardFile(Core.Core.DataFile), VCard do begin
    144       Table.Title := ExtractFileNameWithoutExt(FileName);
    145 
    146       // Get all properties types
    147       for I := 0 to Contacts.Count - 1 do begin
    148         for J := 0 to Contacts[I].Properties.Count - 1 do
    149         if not Contacts[I].Properties[J].Name.StartsWith('PHOTO') and
    150           (Table.Columns.IndexOf(Contacts[I].Properties[J].Name) = -1) then begin
    151             Table.Columns.Add(Contacts[I].Properties[J].Name);
    152             Columns.Add(Contacts[I].Properties[J].Name);
    153           end;
    154       end;
    155 
    156       if CheckBoxHumanReadableHeader.Checked then begin
    157         for I := 0 to Table.Columns.Count - 1 do begin
    158           Field := Fields.GetBySysName(Table.Columns[I]);
    159           if Assigned(Field) then Table.Columns[I] := Field.Title;
    160         end;
    161       end;
    162 
    163       for I := 0 to Contacts.Count - 1 do begin
    164         Values.Clear;
    165         for J := 0 to Columns.Count - 1 do
    166           Values.Add('');
    167         for J := 0 to Contacts[I].Properties.Count - 1 do begin
    168           Index := Columns.IndexOf(Contacts[I].Properties[J].Name);
    169           if Index <> -1 then
    170             Values[Index] := Contacts[I].Properties[J].Value;
    171         end;
    172 
    173         Row := Table.AddRow;
    174         for J := 0 to Values.Count - 1 do
    175           Row.Cells.Add(Values[J]);
    176       end;
    177     end;
    178   finally
    179     Values.Free;
    180     Columns.Free;
    181124  end;
    182125end;

  • trunk/Forms/FormImage.lfm

    r165 r168  
    5151    Anchors = [akLeft, akBottom]
    5252    Caption = 'Clear'
    53     OnClick = uttonClearClick
     53    OnClick = ButtonClearClick
    5454    TabOrder = 2
    5555  end
    5656  object EditUrl: TEdit
    5757    Left = 84
    58     Height = 33
    59     Top = 426
     58    Height = 43
     59    Top = 416
    6060    Width = 610
    6161    Anchors = [akLeft, akRight, akBottom]
    … …  
    8585  object Label1: TLabel
    8686    Left = 16
    87     Height = 25
    88     Top = 432
    89     Width = 35
     87    Height = 26
     88    Top = 431
     89    Width = 38
    9090    Anchors = [akLeft, akBottom]
    9191    Caption = 'URL:'

  • trunk/Forms/FormImage.pas

    r162 r168  
    2222    OpenPictureDialog1: TOpenPictureDialog;
    2323    SavePictureDialog1: TSavePictureDialog;
    24     procedure uttonClearClick(Sender: TObject);
     24    procedure ButtonClearClick(Sender: TObject);
    2525    procedure ButtonLoadClick(Sender: TObject);
    2626    procedure ButtonSaveClick(Sender: TObject);
    … …  
    6767end;
    6868
    69 procedure TFormImage.uttonClearClick(Sender: TObject);
     69procedure TFormImage.ButtonClearClick(Sender: TObject);
    7070begin
    7171  Image.Clear;

  • trunk/Forms/FormImport.lfm

    r167 r168  
    8080      Width = 464
    8181      Anchors = [akTop, akLeft, akRight]
     82      OnChange = EditInputFileChange
    8283      TabOrder = 1
    8384    end

  • trunk/Forms/FormImport.pas

    r167 r168  
    2727    procedure ButtonImportClick(Sender: TObject);
    2828    procedure ComboBoxInputFormatChange(Sender: TObject);
     29    procedure EditInputFileChange(Sender: TObject);
    2930    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    3031    procedure FormCreate(Sender: TObject);
    … …  
    4748
    4849uses
    49   Core, Common, RegistryEx, VCardFile;
     50  Core, Common, RegistryEx, VCardFile, VCard;
    5051
    5152{ TFormImport }
    … …  
    6162begin
    6263  TableFormat := TTableFormat(ComboBoxInputFormat.Items.Objects[ComboBoxInputFormat.ItemIndex]);
    63   Table.SetInput(TableFormat, LoadFileToStr(EditInputFile.Text));
    64   Table.Title := ExtractFileNameWithoutExt(EditInputFile.Text);
     64  TVCardFile(Core.Core.DataFile).VCard.ImportFromFile(EditInputFile.Text, TableFormat,
     65    CheckBoxHumanReadableHeader.Checked);
    6566end;
    6667
    … …  
    6869begin
    6970  UpdateTableFormat;
     71end;
     72
     73procedure TFormImport.EditInputFileChange(Sender: TObject);
     74begin
     75  RedrawPending := True;
    7076end;
    7177

  • trunk/Languages/vCardStudio.cs.po

    r167 r168  
    276276msgstr "Očekáváno:"
    277277
     278#: test.sexport
     279msgid "Export:"
     280msgstr ""
     281
    278282#: test.soutput
    279283msgctxt "test.soutput"
    … …  
    975979msgctxt "tformexport.checkboxhumanreadableheader.caption"
    976980msgid "Human readable header"
    977 msgstr ""
     981msgstr "Lidsky čitelná hlavička"
    978982
    979983#: tformexport.label1.caption
    … …  
    11011105msgctxt "tformimport.checkboxhumanreadableheader.caption"
    11021106msgid "Human readable header"
    1103 msgstr ""
     1107msgstr "Lidsky čitelná hlavička"
    11041108
    11051109#: tformimport.label1.caption

  • trunk/Languages/vCardStudio.pot

    r167 r168  
    266266msgstr ""
    267267
     268#: test.sexport
     269msgid "Export:"
     270msgstr ""
     271
    268272#: test.soutput
    269273msgctxt "test.soutput"

  • trunk/Languages/vCardStudio.sv.po

    r167 r168  
    277277msgstr ""
    278278
     279#: test.sexport
     280msgid "Export:"
     281msgstr ""
     282
    279283#: test.soutput
    280284msgctxt "test.soutput"

  • trunk/Packages/Common/Table.pas

    r167 r168  
    281281
    282282procedure TTable.SetInputCsv(Text: string);
    283 begin
    284 
     283var
     284  Lines: TStringList;
     285  I: Integer;
     286  Row: TRow;
     287begin
     288  Clear;
     289  Lines := TStringList.Create;
     290  try
     291    Lines.Text := Text;
     292    for I := 0 to Lines.Count - 1 do begin
     293      if I = 0 then begin
     294        Columns.StrictDelimiter := True;
     295        Columns.DelimitedText := Trim(Lines[I]);
     296      end else begin
     297        Row := TRow.Create;
     298        Row.Cells.StrictDelimiter := True;
     299        Row.Cells.DelimitedText := Trim(Lines[I]);
     300        Rows.Add(Row);
     301      end;
     302    end;
     303  finally
     304    FreeAndNil(Lines);
     305  end;
    285306end;
    286307
    … …  
    296317
    297318procedure TTable.SetInputMediaWiki(Text: string);
    298 begin
    299 
     319var
     320  Lines: TStringList;
     321  I: Integer;
     322  Line: string;
     323  InsideTable: Boolean;
     324  Index: Integer;
     325  Row: TRow;
     326begin
     327  Clear;
     328  Lines := TStringList.Create;
     329  try
     330    Lines.Text := Text;
     331    Row := nil;
     332    InsideTable := False;
     333    for I := 0 to Lines.Count - 1 do begin
     334      Line := Trim(Lines[I]);
     335      if not InsideTable then begin
     336        if Line.StartsWith('{|') then InsideTable := True;
     337      end else begin
     338        if Line.StartsWith('|}') then InsideTable := False
     339        else
     340        if Line.StartsWith('!') then begin
     341          Delete(Line, 1, 1);
     342          Line := Trim(Line);
     343          repeat
     344            Index := Pos('!!', Line);
     345            if Index > 0 then begin
     346              Columns.Add(Trim(Copy(Line, 1, Index - 1)));
     347              Delete(Line, 1, Index + 1);
     348            end else begin
     349              Columns.Add(Trim(Line));
     350              Break;
     351            end;
     352          until False;
     353        end else
     354        if Line.StartsWith('|-') then begin
     355          if Assigned(Row) then Rows.Add(Row);
     356          Row := TRow.Create;
     357        end else
     358        if Line.StartsWith('|') then begin
     359          if Assigned(Row) then begin
     360            Delete(Line, 1, 1);
     361            Line := Trim(Line);
     362            repeat
     363              Index := Pos('||', Line);
     364              if Index > 0 then begin
     365                Row.Cells.Add(Trim(Copy(Line, 1, Index - 1)));
     366                Delete(Line, 1, Index + 1);
     367              end else begin
     368                Row.Cells.Add(Trim(Line));
     369                Break;
     370              end;
     371            until False;
     372
     373            while Row.Cells.Count < Columns.Count do
     374              Row.Cells.Add('');
     375          end;
     376        end;
     377      end;
     378    end;
     379    if Assigned(Row) then
     380      Rows.Add(Row);
     381  finally
     382    FreeAndNil(Lines);
     383  end;
    300384end;
    301385

  • trunk/Packages/VCard/VCard.pas

    r152 r168  
    44
    55uses
    6   Classes, SysUtils, Dialogs, LazUTF8, Base64, Graphics, Common,
     6  Classes, SysUtils, Dialogs, LazUTF8, Base64, Graphics, Common, Table,
    77  Generics.Collections, Generics.Defaults, ListViewSort;
    88
    … …  
    109109    function GetBySysNameGroups(SysName: string; Groups: TStringArray): TContactField;
    110110    function GetByIndex(Index: TContactFieldIndex): TContactField;
     111    function GetByTitle(Title: string): TContactField;
    111112    procedure LoadToStrings(AItems: TStrings);
    112113  end;
    … …  
    235236    procedure SaveToFile(FileName: string);
    236237    procedure LoadFromFile(FileName: string);
     238    procedure ExportToStrings(Lines: TStrings; Format: TTableFormat; HumanReadableHeader: Boolean);
     239    procedure ImportFromStrings(Lines: TStrings; Format: TTableFormat; HumanReadableHeader: Boolean);
     240    procedure ExportToFile(FileName: string; Format: TTableFormat; HumanReadableHeader: Boolean);
     241    procedure ImportFromFile(FileName: string; Format: TTableFormat; HumanReadableHeader: Boolean);
     242    procedure ExportToTable(Table: TTable; HumanReadableHeader: Boolean);
     243    procedure ImportFromTable(Table: TTable; HumanReadableHeader: Boolean);
    237244    constructor Create(AOwner: TComponent); override;
    238245    destructor Destroy; override;
    … …  
    642649end;
    643650
     651procedure TVCard.ExportToStrings(Lines: TStrings; Format: TTableFormat;
     652  HumanReadableHeader: Boolean);
     653var
     654  Table: TTable;
     655begin
     656  Table := TTable.Create;
     657  try
     658    ExportToTable(Table, HumanReadableHeader);
     659    Lines.Text := Table.GetOutput(Format);
     660  finally
     661    FreeAndNil(Table);
     662  end;
     663end;
     664
     665procedure TVCard.ImportFromStrings(Lines: TStrings; Format: TTableFormat;
     666  HumanReadableHeader: Boolean);
     667var
     668  Table: TTable;
     669begin
     670  Table := TTable.Create;
     671  try
     672    Table.SetInput(Format, Lines.Text);
     673    ImportFromTable(Table, HumanReadableHeader);
     674  finally
     675    FreeAndNil(Table);
     676  end;
     677end;
     678
     679procedure TVCard.ExportToFile(FileName: string; Format: TTableFormat;
     680  HumanReadableHeader: Boolean);
     681var
     682  Lines: TStringList;
     683begin
     684  Lines := TStringList.Create;
     685  try
     686    ExportToStrings(Lines, Format, HumanReadableHeader);
     687    Lines.SaveToFile(FileName);
     688  finally
     689    Lines.Free;
     690  end
     691end;
     692
     693procedure TVCard.ImportFromFile(FileName: string; Format: TTableFormat;
     694  HumanReadableHeader: Boolean);
     695var
     696  Lines: TStringList;
     697begin
     698  Lines := TStringList.Create;
     699  Lines.LoadFromFile(FileName);
     700  {$IF FPC_FULLVERSION>=30200}
     701  if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
     702    Lines.LoadFromFile(FileName, TEncoding.Unicode);
     703    if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
     704      Lines.LoadFromFile(FileName, TEncoding.BigEndianUnicode);
     705    end;
     706  end;
     707  {$ENDIF}
     708  try
     709    ImportFromStrings(Lines, Format, HumanReadableHeader);
     710  finally
     711    Lines.Free;
     712  end;
     713end;
     714
     715procedure TVCard.ExportToTable(Table: TTable; HumanReadableHeader: Boolean);
     716var
     717  Row: TRow;
     718  I: Integer;
     719  J: Integer;
     720  Values: TStringList;
     721  Index: Integer;
     722  Fields: TContactFields;
     723  Field: TContactField;
     724  Columns: TStringList;
     725begin
     726  Table.Clear;
     727
     728  Values := TStringList.Create;
     729  Columns := TStringList.Create;
     730  try
     731      // Get all properties types
     732      for I := 0 to Contacts.Count - 1 do begin
     733        for J := 0 to Contacts[I].Properties.Count - 1 do
     734        if not Contacts[I].Properties[J].Name.StartsWith('PHOTO') and
     735          (Table.Columns.IndexOf(Contacts[I].Properties[J].Name) = -1) then begin
     736            Table.Columns.Add(Contacts[I].Properties[J].Name);
     737            Columns.Add(Contacts[I].Properties[J].Name);
     738          end;
     739      end;
     740
     741      if HumanReadableHeader then begin
     742        Fields := TContact.GetFields;
     743        for I := 0 to Table.Columns.Count - 1 do begin
     744          Field := Fields.GetBySysName(Table.Columns[I]);
     745          if Assigned(Field) then Table.Columns[I] := Field.Title;
     746        end;
     747      end;
     748
     749      for I := 0 to Contacts.Count - 1 do begin
     750        Values.Clear;
     751        for J := 0 to Columns.Count - 1 do
     752          Values.Add('');
     753        for J := 0 to Contacts[I].Properties.Count - 1 do begin
     754          Index := Columns.IndexOf(Contacts[I].Properties[J].Name);
     755          if Index <> -1 then
     756            Values[Index] := Contacts[I].Properties[J].Value;
     757        end;
     758
     759        Row := Table.AddRow;
     760        for J := 0 to Values.Count - 1 do
     761          Row.Cells.Add(Values[J]);
     762      end;
     763  finally
     764    Values.Free;
     765    Columns.Free;
     766  end;
     767end;
     768
     769procedure TVCard.ImportFromTable(Table: TTable; HumanReadableHeader: Boolean);
     770var
     771  Contact: TContact;
     772  I: Integer;
     773  J: Integer;
     774  Fields: TContactFields;
     775  Field: TContactField;
     776begin
     777  if HumanReadableHeader then begin
     778    Fields := TContact.GetFields;
     779    for I := 0 to Table.Columns.Count - 1 do begin
     780      Field := Fields.GetByTitle(Table.Columns[I]);
     781      if Assigned(Field) then Table.Columns[I] := Field.SysName;
     782    end;
     783  end;
     784
     785  Contacts.Clear;
     786  for I := 0 to Table.Rows.Count - 1 do begin
     787    Contact := Contacts.AddNew;
     788    for J := 0 to Table.Rows[I].Cells.Count - 1 do
     789      Contact.Properties.AddNew(Table.Columns[J], Table.Rows[I].Cells[J]);
     790  end;
     791end;
     792
    644793constructor TVCard.Create(AOwner: TComponent);
    645794begin
    … …  
    14451594      else Result := nil;
    14461595  end;
     1596end;
     1597
     1598function TContactFields.GetByTitle(Title: string): TContactField;
     1599var
     1600  I: Integer;
     1601begin
     1602  I := 0;
     1603  while (I < Count) and (Items[I].Title <> Title) do Inc(I);
     1604  if I < Count then Result := Items[I]
     1605    else Result := nil;
    14471606end;
    14481607

  • trunk/Test.pas

    r152 r168  
    44
    55uses
    6   Classes, SysUtils, VCard, VCardProcessor, TestCase;
     6  Classes, SysUtils, VCard, VCardProcessor, TestCase, Table;
    77
    88type
    … …  
    4040  end;
    4141
     42  { TTestCaseVCardExportImport }
     43
     44  TTestCaseVCardExportImport = class(TTestCase)
     45    Input: string;
     46    Output: string;
     47    Format: TTableFormat;
     48    HumanReadableHeader: Boolean;
     49    procedure Run; override;
     50  end;
     51
    4252
    4353implementation
    … …  
    4959  SExpected = 'Expected:';
    5060  SOutput = 'Output:';
     61  SExport = 'Export:';
     62
     63{ TTestCaseVCardExportImport }
     64
     65procedure TTestCaseVCardExportImport.Run;
     66var
     67  Lines: TStringList;
     68  ExportedLines: TStringList;
     69begin
     70  Lines := TStringList.Create;
     71  ExportedLines := TStringList.Create;
     72  try
     73    with TVCardFile.Create(nil) do
     74    try
     75      Lines.Text := Input;
     76      VCard.LoadFromStrings(Lines);
     77
     78      VCard.ExportToStrings(ExportedLines, Format, HumanReadableHeader);
     79      VCard.Contacts.Clear;
     80      VCard.ImportFromStrings(ExportedLines, Format, HumanReadableHeader);
     81
     82      Lines.Text := '';
     83      VCard.SaveToStrings(Lines);
     84      Evaluate(Lines.Text = Output);
     85      Log := SExpected + LineEnding +
     86        '"' + Output + '"' + LineEnding + LineEnding +
     87        SExport + LineEnding +
     88        '"' + ExportedLines.Text + '"' + LineEnding + LineEnding +
     89        SOutput + LineEnding +
     90        '"' + Lines.Text + '"';
     91    finally
     92      Free;
     93    end;
     94  finally
     95    FreeAndNil(Lines);
     96    FreeAndNil(ExportedLines);
     97  end;
     98end;
    5199
    52100{ TTestCaseVCardProcessor }

  • trunk/TestCases.pas

    r152 r168  
    1212
    1313uses
    14   VCard;
     14  VCard, Table;
    1515
    1616const
    … …  
    275275    end;
    276276
     277    with TTestCaseVCardExportImport(AddNew('Export/Import CSV', TTestCaseVCardExportImport)) do begin
     278      Format := tfCsv;
     279      HumanReadableHeader := False;
     280      Input := BeginEnd(
     281        'N:Surname;Name' + VCardLineEnding +
     282        'FN:Name Surname' + VCardLineEnding) +
     283        BeginEnd(
     284        'N:Surname2;Name2' + VCardLineEnding +
     285        'FN:Name2 Surname2' + VCardLineEnding);
     286      Output := Input;
     287    end;
     288    with TTestCaseVCardExportImport(AddNew('Export/Import CSV human header', TTestCaseVCardExportImport)) do begin
     289      Format := tfCsv;
     290      HumanReadableHeader := True;
     291      Input := BeginEnd(
     292        'N:Surname;Name' + VCardLineEnding +
     293        'FN:Name Surname' + VCardLineEnding) +
     294        BeginEnd(
     295        'N:Surname2;Name2' + VCardLineEnding +
     296        'FN:Name2 Surname2' + VCardLineEnding);
     297      Output := Input;
     298    end;
     299    with TTestCaseVCardExportImport(AddNew('Export/Import MediaWiki', TTestCaseVCardExportImport)) do begin
     300      Format := tfMediaWiki;
     301      HumanReadableHeader := False;
     302      Input := BeginEnd(
     303        'N:Surname;Name' + VCardLineEnding +
     304        'FN:Name Surname' + VCardLineEnding) +
     305        BeginEnd(
     306        'N:Surname2;Name2' + VCardLineEnding +
     307        'FN:Name2 Surname2' + VCardLineEnding);
     308      Output := Input;
     309    end;
     310
    277311    with TTestCaseLoadSave(AddNew('Merge same cell phone', TTestCaseLoadSave)) do begin
    278312      Input := VCardBegin + MacLineEnding +
Note: See TracChangeset for help on using the changeset viewer.