Changeset 53

Timestamp:

Dec 8, 2021, 2:02:17 PM (3 years ago)

Author:

chronos

Message:

• Added: Allow to load from file or save to file individual selected contacts from the list.

Location:

trunk

Files:

• Forms/UFormContacts.lfm (modified) (7 diffs)
• Forms/UFormContacts.lrj (modified) (1 diff)
• Forms/UFormContacts.pas (modified) (6 diffs)
• Languages/vCardStudio.cs.po (modified) (5 diffs)
• Languages/vCardStudio.po (modified) (4 diffs)
• UContact.pas (modified) (8 diffs)
• UCore.pas (modified) (3 diffs)

trunk/Forms/UFormContacts.lfm

@@ -14 +14 @@
   object ListView1: TListView
     Left = 0
-    Height = 810
+    Height = 801
     Top = 0
     Width = 1210
@@ -58 +58 @@
     Left = 0
     Height = 39
-    Top = 842
+    Top = 833
     Width = 1210
     Align = alBottom
@@ -86 +86 @@
       Action = AClone
     end
+    object ToolButton5: TToolButton
+      Left = 141
+      Height = 33
+      Top = 2
+      Style = tbsSeparator
+    end
+    object ToolButton6: TToolButton
+      Left = 149
+      Top = 2
+      Action = ALoadFromFile
+    end
+    object ToolButton7: TToolButton
+      Left = 184
+      Top = 2
+      Action = ASaveToFile
+    end
   end
   object ListViewFilter1: TListViewFilter
     Left = 0
     Height = 32
-    Top = 810
+    Top = 801
     Width = 1210
     OnChange = ListViewFilter1Change
@@ -97 +113 @@
   object StatusBar1: TStatusBar
     Left = 0
-    Height = 27
-    Top = 881
+    Height = 36
+    Top = 872
     Width = 1210
     Panels = <    
@@ -124 +140 @@
     object MenuItem4: TMenuItem
       Action = ASelectAll
+    end
+    object MenuItem6: TMenuItem
+      Caption = '-'
+    end
+    object MenuItem7: TMenuItem
+      Action = ALoadFromFile
+    end
+    object MenuItem8: TMenuItem
+      Action = ASaveToFile
     end
   end
@@ -158 +183 @@
       OnExecute = ACloneExecute
     end
+    object ALoadFromFile: TAction
+      Caption = 'Load from file...'
+      ImageIndex = 5
+      OnExecute = ALoadFromFileExecute
+    end
+    object ASaveToFile: TAction
+      Caption = 'Save to file...'
+      ImageIndex = 7
+      OnExecute = ASaveToFileExecute
+    end
   end
   object ListViewSort1: TListViewSort
@@ -169 +204 @@
     Top = 428
   end
+  object SaveDialog1: TSaveDialog
+    Left = 720
+    Top = 408
+  end
+  object OpenDialog1: TOpenDialog
+    Left = 720
+    Top = 480
+  end
 end

trunk/Forms/UFormContacts.lrj

@@ -11 +11 @@
 {"hash":93079237,"name":"tformcontacts.aremove.caption","sourcebytes":[82,101,109,111,118,101],"value":"Remove"},
 {"hash":195296268,"name":"tformcontacts.aselectall.caption","sourcebytes":[83,101,108,101,99,116,32,97,108,108],"value":"Select all"},
-{"hash":4863557,"name":"tformcontacts.aclone.caption","sourcebytes":[67,108,111,110,101],"value":"Clone"}
+{"hash":4863557,"name":"tformcontacts.aclone.caption","sourcebytes":[67,108,111,110,101],"value":"Clone"},
+{"hash":177113358,"name":"tformcontacts.aloadfromfile.caption","sourcebytes":[76,111,97,100,32,102,114,111,109,32,102,105,108,101,46,46,46],"value":"Load from file..."},
+{"hash":10127854,"name":"tformcontacts.asavetofile.caption","sourcebytes":[83,97,118,101,32,116,111,32,102,105,108,101,46,46,46],"value":"Save to file..."}
 ]}

trunk/Forms/UFormContacts.pas

@@ -16 +16 @@
     AAdd: TAction;
     AClone: TAction;
+    ALoadFromFile: TAction;
+    ASaveToFile: TAction;
     ASelectAll: TAction;
     ARemove: TAction;
@@ -28 +30 @@
     MenuItem4: TMenuItem;
     MenuItem5: TMenuItem;
+    MenuItem6: TMenuItem;
+    MenuItem7: TMenuItem;
+    MenuItem8: TMenuItem;
+    OpenDialog1: TOpenDialog;
     PopupMenuContact: TPopupMenu;
+    SaveDialog1: TSaveDialog;
     StatusBar1: TStatusBar;
     ToolBar1: TToolBar;
@@ -35 +42 @@
     ToolButton3: TToolButton;
     ToolButton4: TToolButton;
+    ToolButton5: TToolButton;
+    ToolButton6: TToolButton;
+    ToolButton7: TToolButton;
     procedure AAddExecute(Sender: TObject);
     procedure ACloneExecute(Sender: TObject);
+    procedure ALoadFromFileExecute(Sender: TObject);
     procedure AModifyExecute(Sender: TObject);
     procedure ARemoveExecute(Sender: TObject);
+    procedure ASaveToFileExecute(Sender: TObject);
     procedure ASelectAllExecute(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -314 +326 @@
 end;
 
+procedure TFormContacts.ALoadFromFileExecute(Sender: TObject);
+var
+  TempFile: TContactsFile;
+begin
+  if Assigned(ListView1.Selected) then begin
+    TempFile := TContactsFile.Create;
+    try
+      OpenDialog1.Filter := TempFile.GetFileFilter;
+      OpenDialog1.DefaultExt := TempFile.GetFileExt;
+    finally
+      TempFile.Free;
+    end;
+    OpenDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
+    OpenDialog1.FileName := ExtractFileName(Core.LastContactFileName);
+    if OpenDialog1.Execute then begin
+      TContact(ListView1.Selected.Data).LoadFromFile(OpenDialog1.FileName);
+      Core.LastContactFileName := OpenDialog1.FileName;
+      ReloadList;
+    end;
+  end;
+end;
+
 procedure TFormContacts.AModifyExecute(Sender: TObject);
 var
@@ -359 +393 @@
 end;
 
+procedure TFormContacts.ASaveToFileExecute(Sender: TObject);
+var
+  TempFile: TContactsFile;
+begin
+  if Assigned(ListView1.Selected) then begin
+    TempFile := TContactsFile.Create;
+    try
+      SaveDialog1.Filter := TempFile.GetFileFilter;
+      SaveDialog1.DefaultExt := TempFile.GetFileExt;
+    finally
+      TempFile.Free;
+    end;
+    SaveDialog1.InitialDir := ExtractFileDir(Core.LastContactFileName);
+    SaveDialog1.FileName := TContact(ListView1.Selected.Data).Fields[cfFullName] +
+      VCardFileExt;
+    if SaveDialog1.Execute then begin
+      TContact(ListView1.Selected.Data).SaveToFile(SaveDialog1.FileName);
+      Core.LastContactFileName := SaveDialog1.FileName;
+    end;
+  end;
+end;
+
 procedure TFormContacts.ASelectAllExecute(Sender: TObject);
 var
@@ -409 +465 @@
 begin
   if FUpdateCount = 0 then DoUpdateInterface;
+  ALoadFromFile.Enabled := Assigned(ListView1.Selected);
+  ASaveToFile.Enabled := Assigned(ListView1.Selected);
+  AModify.Enabled := Assigned(ListView1.Selected);
+  AClone.Enabled := Assigned(ListView1.Selected);
+  ARemove.Enabled := Assigned(ListView1.Selected);
+  ASelectAll.Enabled := ListView1.Items.Count > 0;
 end;
 

trunk/Languages/vCardStudio.cs.po

@@ -77 +77 @@
 
 #: tformcontact.aphotoload.caption
+msgctxt "tformcontact.aphotoload.caption"
 msgid "Load from file"
 msgstr "Načíst ze souboru"
 
 #: tformcontact.aphotosave.caption
+msgctxt "tformcontact.aphotosave.caption"
 msgid "Save to file"
 msgstr "Uložit do souboru"
@@ -358 +360 @@
 msgstr "Klonovat"
 
+#: tformcontacts.aloadfromfile.caption
+msgctxt "tformcontacts.aloadfromfile.caption"
+msgid "Load from file..."
+msgstr "Načíst ze souboru..."
+
 #: tformcontacts.amodify.caption
 msgctxt "tformcontacts.amodify.caption"
@@ -368 +375 @@
 msgstr "Odstranit"
 
+#: tformcontacts.asavetofile.caption
+msgctxt "tformcontacts.asavetofile.caption"
+msgid "Save to file..."
+msgstr "Uložit do souboru..."
+
 #: tformcontacts.aselectall.caption
 msgctxt "tformcontacts.aselectall.caption"
@@ -618 +630 @@
 msgstr "E-mail"
 
+#: ucontact.sexpectedproperty
+msgid "Expected contact property"
+msgstr "Očekávána vlastnost kontaktu"
+
 #: ucontact.sfax
 msgid "Fax"
@@ -932 +948 @@
 msgid "Invalid line length for encoded text"
 msgstr "Neplatná délka řádky kódovaného textu"
+

trunk/Languages/vCardStudio.po

@@ -67 +67 @@
 
 #: tformcontact.aphotoload.caption
+msgctxt "tformcontact.aphotoload.caption"
 msgid "Load from file"
 msgstr ""
 
 #: tformcontact.aphotosave.caption
+msgctxt "tformcontact.aphotosave.caption"
 msgid "Save to file"
 msgstr ""
@@ -348 +350 @@
 msgstr ""
 
+#: tformcontacts.aloadfromfile.caption
+msgctxt "tformcontacts.aloadfromfile.caption"
+msgid "Load from file..."
+msgstr ""
+
 #: tformcontacts.amodify.caption
 msgctxt "tformcontacts.amodify.caption"
@@ -358 +365 @@
 msgstr ""
 
+#: tformcontacts.asavetofile.caption
+msgctxt "tformcontacts.asavetofile.caption"
+msgid "Save to file..."
+msgstr ""
+
 #: tformcontacts.aselectall.caption
 msgctxt "tformcontacts.aselectall.caption"
@@ -606 +618 @@
 msgstr ""
 
+#: ucontact.sexpectedproperty
+msgid "Expected contact property"
+msgstr ""
+
 #: ucontact.sfax
 msgid "Fax"

trunk/UContact.pas

@@ -98 +98 @@
     constructor Create;
     destructor Destroy; override;
+    procedure SaveToStrings(Output: TStrings);
+    function LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
+    procedure SaveToFile(FileName: string);
+    procedure LoadFromFile(FileName: string);
     property Fields[Index: TContactFieldIndex]: string read GetField write SetField;
   end;
@@ -132 +136 @@
   end;
 
+const
+  VCardFileExt = '.vcf';
+
 
 implementation
@@ -144 +151 @@
   SFieldIndexNotDefined = 'Field index not defined';
   SContactHasNoParent = 'Contact has no parent';
+  SExpectedProperty = 'Expected contact property';
   SLastName = 'Last Name';
   SFirstName = 'First Name';
@@ -593 +601 @@
   FreeAndNil(Properties);
   inherited;
+end;
+
+procedure TContact.SaveToStrings(Output: TStrings);
+var
+  I: Integer;
+  J: Integer;
+  NameText: string;
+  Value2: string;
+  Text: string;
+  LineIndex: Integer;
+  OutText: string;
+  LinePrefix: string;
+const
+  MaxLineLength = 73;
+begin
+    with Output do begin
+      Add('BEGIN:VCARD');
+      for J := 0 to Properties.Count - 1 do
+      with Properties[J] do begin
+        NameText := Name;
+        if Attributes.Count > 0 then
+          NameText := NameText + ';' + Attributes.DelimitedText;
+        if Encoding <> '' then begin
+          Value2 := GetEncodedValue;
+          NameText := NameText + ';ENCODING=' + Encoding;
+        end else Value2 := Value;
+        if Pos(LineEnding, Value2) > 0 then begin
+          Add(NameText + ':' + GetNext(Value2, LineEnding));
+          while Pos(LineEnding, Value2) > 0 do begin
+            Add(' ' + GetNext(Value2, LineEnding));
+          end;
+          Add(' ' + GetNext(Value2, LineEnding));
+          Add('');
+        end else begin
+          OutText := NameText + ':' + Value2;
+          LineIndex := 0;
+          LinePrefix := '';
+          while True do begin
+            if Length(OutText) > MaxLineLength then begin
+              if (LineIndex > 0) and (LinePrefix = '') then LinePrefix := ' ';
+              Add(LinePrefix + Copy(OutText, 1, MaxLineLength));
+              System.Delete(OutText, 1, MaxLineLength);
+              Inc(LineIndex);
+              Continue;
+            end else begin
+              Add(LinePrefix + OutText);
+              Break;
+            end;
+          end;
+          if LinePrefix <> '' then Add('');
+        end;
+      end;
+      Add('END:VCARD');
+    end;
+end;
+
+function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
+type
+  TParseState = (psNone, psInside, psFinished);
+var
+  ParseState: TParseState;
+  Line: string;
+  Value: string;
+  I: Integer;
+  NewProperty: TContactProperty;
+  CommandPart: string;
+  Names: string;
+begin
+  ParseState := psNone;
+  I := StartLine;
+  while I < Lines.Count do begin
+    Line := Trim(Lines[I]);
+    if Line = '' then begin
+      // Skip empty lines
+    end else
+    if ParseState = psNone then begin
+      if Line = 'BEGIN:VCARD' then begin
+        ParseState := psInside;
+      end else begin
+        Parent.Error('Expected vCard begin', I + 1);
+        I := -1;
+        Break;
+      end;
+    end else
+    if ParseState = psInside then begin
+      if Line = 'END:VCARD' then begin
+        ParseState := psFinished;
+        Inc(I);
+        Break;
+      end else
+      if Pos(':', Line) > 0 then begin
+        CommandPart := GetNext(Line, ':');
+        Names := CommandPart;
+        Value := Line;
+        while True do begin
+          Inc(I);
+          if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
+            Value := Value + Trim(Lines[I]);
+          end else
+          if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
+            (Lines[I][1] = '=') then begin
+            Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
+          end else begin
+            Dec(I);
+            Break;
+          end;
+        end;
+        NewProperty := Properties.GetByName(Names);
+        if not Assigned(NewProperty) then begin
+          NewProperty := TContactProperty.Create;
+          Properties.Add(NewProperty);
+        end;
+        NewProperty.Attributes.DelimitedText := Names;
+        if NewProperty.Attributes.Count > 0 then begin
+          NewProperty.Name := NewProperty.Attributes[0];
+          NewProperty.Attributes.Delete(0);
+        end;
+        NewProperty.Value := Value;
+        NewProperty.EvaluateAttributes;
+      end else begin
+        Parent.Error(SExpectedProperty, I + 1);
+        I := -1;
+        Break;
+      end;
+    end;
+    Inc(I);
+  end;
+  Result := I;
+end;
+
+procedure TContact.SaveToFile(FileName: string);
+var
+  Lines: TStringList;
+begin
+  Lines := TStringList.Create;
+  try
+    SaveToStrings(Lines);
+    Lines.SaveToFile(FileName);
+  finally
+    Lines.Free;
+  end;
+end;
+
+procedure TContact.LoadFromFile(FileName: string);
+var
+  Lines: TStringList;
+  I: Integer;
+begin
+  Lines := TStringList.Create;
+  try
+    Lines.LoadFromFile(FileName);
+    I := LoadFromStrings(Lines);
+  finally
+    Lines.Free;
+  end;
 end;
 
@@ -672 +835 @@
 function TContactsFile.GetFileExt: string;
 begin
-  Result := '.vcf';
+  Result := VCardFileExt;
 end;
 
@@ -693 +856 @@
   Output: TStringList;
   I: Integer;
-  J: Integer;
-  NameText: string;
-  Value2: string;
-  Text: string;
-  LineIndex: Integer;
-  OutText: string;
-  LinePrefix: string;
-const
-  MaxLineLength = 73;
 begin
   inherited;
+  Output := TStringList.Create;
   try
-    Output := TStringList.Create;
     for I := 0 to Contacts.Count - 1 do
-    with Contacts[I], Output do begin
-      Add('BEGIN:VCARD');
-      for J := 0 to Properties.Count - 1 do
-      with Properties[J] do begin
-        NameText := Name;
-        if Attributes.Count > 0 then
-          NameText := NameText + ';' + Attributes.DelimitedText;
-        if Encoding <> '' then begin
-          Value2 := GetEncodedValue;
-          NameText := NameText + ';ENCODING=' + Encoding;
-        end else Value2 := Value;
-        if Pos(LineEnding, Value2) > 0 then begin
-          Add(NameText + ':' + GetNext(Value2, LineEnding));
-          while Pos(LineEnding, Value2) > 0 do begin
-            Add(' ' + GetNext(Value2, LineEnding));
-          end;
-          Add(' ' + GetNext(Value2, LineEnding));
-          Add('');
-        end else begin
-          OutText := NameText + ':' + Value2;
-          LineIndex := 0;
-          LinePrefix := '';
-          while True do begin
-            if Length(OutText) > MaxLineLength then begin
-              if (LineIndex > 0) and (LinePrefix = '') then LinePrefix := ' ';
-              Add(LinePrefix + Copy(OutText, 1, MaxLineLength));
-              System.Delete(OutText, 1, MaxLineLength);
-              Inc(LineIndex);
-              Continue;
-            end else begin
-              Add(LinePrefix + OutText);
-              Break;
-            end;
-          end;
-          if LinePrefix <> '' then Add('');
-        end;
-      end;
-      Add('END:VCARD');
-    end;
+      Contacts[I].SaveToStrings(Output);
     Output.SaveToFile(FileName);
   finally
@@ -755 +871 @@
 var
   Lines: TStringList;
-  Line: string;
-  Value: string;
-  I: Integer;
-  NewRecord: TContact;
-  NewProperty: TContactProperty;
-  CommandPart: string;
-  Names: string;
+  Contact: TContact;
+  I: Integer;
 begin
   inherited;
-  NewRecord := nil;
   Contacts.Clear;
   Lines := TStringList.Create;
@@ -771 +881 @@
     I := 0;
     while I < Lines.Count do begin
-      Line := Lines[I];
-      if Line = '' then
-      else
-      if Line = 'BEGIN:VCARD' then begin
-        NewRecord := TContact.Create;
-        NewRecord.Parent := Self;
-      end else
-      if Line = 'END:VCARD' then begin
-        if Assigned(NewRecord) then begin
-          Contacts.Add(NewRecord);
-          NewRecord := nil;
-        end else Error(SFoundBlockEndWithoutBlockStart, I + 1);
-      end else
-      if Pos(':', Line) > 0 then begin
-        CommandPart := GetNext(Line, ':');
-        if Assigned(NewRecord) then begin
-          Names := CommandPart;
-          Value := Line;
-          while True do begin
-            Inc(I);
-            if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
-              Value := Value + Trim(Lines[I]);
-            end else
-            if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
-              (Lines[I][1] = '=') then begin
-              Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
-            end else begin
-              Dec(I);
-              Break;
-            end;
-          end;
-          NewProperty := NewRecord.Properties.GetByName(Names);
-          if not Assigned(NewProperty) then begin
-            NewProperty := TContactProperty.Create;
-            NewRecord.Properties.Add(NewProperty);
-          end;
-          NewProperty.Attributes.DelimitedText := Names;
-          if NewProperty.Attributes.Count > 0 then begin
-            NewProperty.Name := NewProperty.Attributes[0];
-            NewProperty.Attributes.Delete(0);
-          end;
-          NewProperty.Value := Value;
-          NewProperty.EvaluateAttributes;
-        end else Error(SFoundPropertiesBeforeBlockStart, I + 1);
+      Contact := TContact.Create;
+      Contact.Parent := Self;
+      I := Contact.LoadFromStrings(Lines, I);
+      if (I <= Lines.Count) and (I <> -1) then Contacts.Add(Contact)
+      else begin
+        FreeAndNil(Contact);
+        Break;
       end;
-      Inc(I);
     end;
   finally

trunk/UCore.pas

@@ -82 +82 @@
     ReopenLastFileOnStart: Boolean;
     LastContactTabIndex: Integer;
+    LastContactFileName: string;
     ToolbarVisible: Boolean;
     function GetProfileImage: TImage;
@@ -431 +432 @@
     ReopenLastFileOnStart := ReadBoolWithDefault('ReopenLastFileOnStart', True);
     LastContactTabIndex := ReadIntegerWithDefault('LastContactTabIndex', 0);
+    LastContactFileName := ReadStringWithDefault('LastContactFileName', '');
   finally
     Free;
@@ -453 +455 @@
     WriteBool('ReopenLastFileOnStart', ReopenLastFileOnStart);
     WriteInteger('LastContactTabIndex', LastContactTabIndex);
+    WriteString('LastContactFileName', LastContactFileName);
   finally
     Free;