Changeset 168 for trunk/Packages/VCard

Timestamp:

Jul 1, 2023, 8:17:50 PM (17 months ago)

Author:

chronos

Message:

• Modifed: Export/Import moved to TVCard class.
• Added: Export/Import tests for CSV and MediaWiki formats.

File:

• trunk/Packages/VCard/VCard.pas (modified) (5 diffs)

trunk/Packages/VCard/VCard.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Dialogs, LazUTF8, Base64, Graphics, Common,
+  Classes, SysUtils, Dialogs, LazUTF8, Base64, Graphics, Common, Table,
   Generics.Collections, Generics.Defaults, ListViewSort;
 
@@ -109 +109 @@
     function GetBySysNameGroups(SysName: string; Groups: TStringArray): TContactField;
     function GetByIndex(Index: TContactFieldIndex): TContactField;
+    function GetByTitle(Title: string): TContactField;
     procedure LoadToStrings(AItems: TStrings);
   end;
@@ -235 +236 @@
     procedure SaveToFile(FileName: string);
     procedure LoadFromFile(FileName: string);
+    procedure ExportToStrings(Lines: TStrings; Format: TTableFormat; HumanReadableHeader: Boolean);
+    procedure ImportFromStrings(Lines: TStrings; Format: TTableFormat; HumanReadableHeader: Boolean);
+    procedure ExportToFile(FileName: string; Format: TTableFormat; HumanReadableHeader: Boolean);
+    procedure ImportFromFile(FileName: string; Format: TTableFormat; HumanReadableHeader: Boolean);
+    procedure ExportToTable(Table: TTable; HumanReadableHeader: Boolean);
+    procedure ImportFromTable(Table: TTable; HumanReadableHeader: Boolean);
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -642 +649 @@
 end;
 
+procedure TVCard.ExportToStrings(Lines: TStrings; Format: TTableFormat;
+  HumanReadableHeader: Boolean);
+var
+  Table: TTable;
+begin
+  Table := TTable.Create;
+  try
+    ExportToTable(Table, HumanReadableHeader);
+    Lines.Text := Table.GetOutput(Format);
+  finally
+    FreeAndNil(Table);
+  end;
+end;
+
+procedure TVCard.ImportFromStrings(Lines: TStrings; Format: TTableFormat;
+  HumanReadableHeader: Boolean);
+var
+  Table: TTable;
+begin
+  Table := TTable.Create;
+  try
+    Table.SetInput(Format, Lines.Text);
+    ImportFromTable(Table, HumanReadableHeader);
+  finally
+    FreeAndNil(Table);
+  end;
+end;
+
+procedure TVCard.ExportToFile(FileName: string; Format: TTableFormat;
+  HumanReadableHeader: Boolean);
+var
+  Lines: TStringList;
+begin
+  Lines := TStringList.Create;
+  try
+    ExportToStrings(Lines, Format, HumanReadableHeader);
+    Lines.SaveToFile(FileName);
+  finally
+    Lines.Free;
+  end
+end;
+
+procedure TVCard.ImportFromFile(FileName: string; Format: TTableFormat;
+  HumanReadableHeader: Boolean);
+var
+  Lines: TStringList;
+begin
+  Lines := TStringList.Create;
+  Lines.LoadFromFile(FileName);
+  {$IF FPC_FULLVERSION>=30200}
+  if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
+    Lines.LoadFromFile(FileName, TEncoding.Unicode);
+    if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
+      Lines.LoadFromFile(FileName, TEncoding.BigEndianUnicode);
+    end;
+  end;
+  {$ENDIF}
+  try
+    ImportFromStrings(Lines, Format, HumanReadableHeader);
+  finally
+    Lines.Free;
+  end;
+end;
+
+procedure TVCard.ExportToTable(Table: TTable; HumanReadableHeader: Boolean);
+var
+  Row: TRow;
+  I: Integer;
+  J: Integer;
+  Values: TStringList;
+  Index: Integer;
+  Fields: TContactFields;
+  Field: TContactField;
+  Columns: TStringList;
+begin
+  Table.Clear;
+
+  Values := TStringList.Create;
+  Columns := TStringList.Create;
+  try
+      // Get all properties types
+      for I := 0 to Contacts.Count - 1 do begin
+        for J := 0 to Contacts[I].Properties.Count - 1 do
+        if not Contacts[I].Properties[J].Name.StartsWith('PHOTO') and
+          (Table.Columns.IndexOf(Contacts[I].Properties[J].Name) = -1) then begin
+            Table.Columns.Add(Contacts[I].Properties[J].Name);
+            Columns.Add(Contacts[I].Properties[J].Name);
+          end;
+      end;
+
+      if HumanReadableHeader then begin
+        Fields := TContact.GetFields;
+        for I := 0 to Table.Columns.Count - 1 do begin
+          Field := Fields.GetBySysName(Table.Columns[I]);
+          if Assigned(Field) then Table.Columns[I] := Field.Title;
+        end;
+      end;
+
+      for I := 0 to Contacts.Count - 1 do begin
+        Values.Clear;
+        for J := 0 to Columns.Count - 1 do
+          Values.Add('');
+        for J := 0 to Contacts[I].Properties.Count - 1 do begin
+          Index := Columns.IndexOf(Contacts[I].Properties[J].Name);
+          if Index <> -1 then
+            Values[Index] := Contacts[I].Properties[J].Value;
+        end;
+
+        Row := Table.AddRow;
+        for J := 0 to Values.Count - 1 do
+          Row.Cells.Add(Values[J]);
+      end;
+  finally
+    Values.Free;
+    Columns.Free;
+  end;
+end;
+
+procedure TVCard.ImportFromTable(Table: TTable; HumanReadableHeader: Boolean);
+var
+  Contact: TContact;
+  I: Integer;
+  J: Integer;
+  Fields: TContactFields;
+  Field: TContactField;
+begin
+  if HumanReadableHeader then begin
+    Fields := TContact.GetFields;
+    for I := 0 to Table.Columns.Count - 1 do begin
+      Field := Fields.GetByTitle(Table.Columns[I]);
+      if Assigned(Field) then Table.Columns[I] := Field.SysName;
+    end;
+  end;
+
+  Contacts.Clear;
+  for I := 0 to Table.Rows.Count - 1 do begin
+    Contact := Contacts.AddNew;
+    for J := 0 to Table.Rows[I].Cells.Count - 1 do
+      Contact.Properties.AddNew(Table.Columns[J], Table.Rows[I].Cells[J]);
+  end;
+end;
+
 constructor TVCard.Create(AOwner: TComponent);
 begin
@@ -1445 +1594 @@
       else Result := nil;
   end;
+end;
+
+function TContactFields.GetByTitle(Title: string): TContactField;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (Items[I].Title <> Title) do Inc(I);
+  if I < Count then Result := Items[I]
+    else Result := nil;
 end;