Changeset 42 for trunk

Timestamp:

Dec 2, 2021, 12:18:18 PM (3 years ago)

Author:

chronos

Message:

• Fixed: Loading of JPEG photo. Image binary data were affected by TStringList. Store them just as a string type.
• Fixed: Reset list filter if different file is opened to avoid confusing empty list after file open.
• Fixed: Decoding long quoted-printable text due to range check error of small index variable type.

Location:

trunk

Files:

• Forms/UFormContact.lfm (modified) (2 diffs)
• Forms/UFormContact.pas (modified) (1 diff)
• Forms/UFormContacts.pas (modified) (2 diffs)
• Forms/UFormProperties.pas (modified) (3 diffs)
• Forms/UFormProperty.pas (modified) (2 diffs)
• Packages/Common/UListViewSort.pas (modified) (4 diffs)
• UContact.pas (modified) (15 diffs)
• UCore.pas (modified) (1 diff)
• UQuotedPrintable.pas (modified) (1 diff)

trunk/Forms/UFormContact.lfm

@@ -18 +18 @@
     Top = 8
     Width = 939
-    ActivePage = TabSheetGeneral
+    ActivePage = TabSheetOthers
     Anchors = [akTop, akLeft, akRight, akBottom]
     ParentFont = False
-    TabIndex = 0
+    TabIndex = 3
     TabOrder = 0
     object TabSheetGeneral: TTabSheet
@@ -835 +835 @@
       object MemoNotes: TMemo
         Left = 16
-        Height = 167
+        Height = 392
         Top = 48
         Width = 893

trunk/Forms/UFormContact.pas

@@ -171 +171 @@
     Item.Caption := Contact.Properties[Item.Index].Name;
     Item.SubItems.Add(Attributes.DelimitedText);
-    Item.SubItems.Add(Contact.Properties[Item.Index].Values.DelimitedText);
+    Item.SubItems.Add(Contact.Properties[Item.Index].Value);
     Item.Data := Contact.Properties[Item.Index];
   end;

trunk/Forms/UFormContacts.pas

@@ -133 +133 @@
 begin
   if Assigned(Contacts) then Contacts.AssignToList(ListViewSort1.List)
-    else ListViewSort1.List.Clear;
+    else begin
+      ListViewSort1.List.Clear;
+    end;
   FilterList(ListViewSort1.List);
 end;
@@ -178 +180 @@
   ReloadList;
   UpdateInterface;
+  ListViewFilter1.Reset;
 end;
 

trunk/Forms/UFormProperties.pas

@@ -83 +83 @@
     Item.Caption := Name;
     Item.SubItems.Add(Attributes.DelimitedText);
-    Item.SubItems.Add(Values.DelimitedText);
+    Item.SubItems.Add(Value);
     Item.Data := ListViewSort1.List[Item.Index];
   end;
@@ -118 +118 @@
       0: Result := CompareString(TContactProperty(Item1).Name, TContactProperty(Item2).Name);
       1: Result := CompareString(TContactProperty(Item1).Attributes.DelimitedText, TContactProperty(Item2).Attributes.DelimitedText);
-      2: Result := CompareString(TContactProperty(Item1).Values.DelimitedText, TContactProperty(Item2).Values.DelimitedText);
+      2: Result := CompareString(TContactProperty(Item1).Value, TContactProperty(Item2).Value);
     end;
     if ListViewSort1.Order = soDown then Result := -Result;
@@ -149 +149 @@
              UTF8LowerCase(TContactProperty(List.Items[I]).Attributes.DelimitedText)) > 0 then Inc(FoundCount);
            if Pos(UTF8LowerCase(StringGrid.Cells[2, 0]),
-             UTF8LowerCase(TContactProperty(List.Items[I]).Values.DelimitedText)) > 0 then Inc(FoundCount);
+             UTF8LowerCase(TContactProperty(List.Items[I]).Value)) > 0 then Inc(FoundCount);
            if FoundCount <> EnteredCount then List.Delete(I);
          end;

trunk/Forms/UFormProperty.pas

@@ -80 +80 @@
     EditName.Text := FContactProperty.Name;
     EditAttributes.Text := FContactProperty.Attributes.DelimitedText;
-    EditValues.Text := FContactProperty.Values.DelimitedText;
+    EditValues.Text := FContactProperty.Value;
   end else begin
     EditName.Text := '';
@@ -95 +95 @@
   FContactProperty.Name := EditName.Text;
   FContactProperty.Attributes.DelimitedText := EditAttributes.Text;
-  FContactProperty.Values.DelimitedText := EditValues.Text;
+  FContactProperty.Value := EditValues.Text;
 end;
 

trunk/Packages/Common/UListViewSort.pas

@@ -81 +81 @@
     FOnChange: TNotifyEvent;
     FStringGrid1: TStringGrid;
+    procedure DoOnChange;
     procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure GridDoOnResize(Sender: TObject);
@@ -90 +91 @@
     function TextEnteredColumn(Index: Integer): Boolean;
     function GetColValue(Index: Integer): string;
+    procedure Reset;
     property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
   published
@@ -152 +154 @@
 { TListViewFilter }
 
+procedure TListViewFilter.DoOnChange;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
 procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 begin
-  if Assigned(FOnChange) then
-    FOnChange(Self);
+  DoOnChange;
 end;
 
@@ -227 +233 @@
     Result := StringGrid.Cells[Index, 0]
     else Result := '';
+end;
+
+procedure TListViewFilter.Reset;
+var
+  I: Integer;
+begin
+  with StringGrid do
+  for I := 0 to ColCount - 1 do
+    Cells[I, 0] := '';
+  DoOnChange;
 end;
 

trunk/UContact.pas

@@ -13 +13 @@
   TErrorEvent = procedure (Text: string; Line: Integer) of object;
 
-  TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage);
+  TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage, dtStringList);
 
   TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTitleBefore,
@@ -53 +53 @@
 
   TContactProperty = class
+  private
+    function GetValueItem(Index: Integer): string;
+    procedure SetValueItem(Index: Integer; AValue: string);
+  public
     Name: string;
     Attributes: TStringList;
-    Values: TStringList;
+    Value: string;
     Encoding: string;
     Charset: string;
@@ -65 +69 @@
     constructor Create;
     destructor Destroy; override;
+    property ValueItem[Index: Integer]: string read GetValueItem write SetValueItem;
   end;
 
@@ -264 +269 @@
 { TContactProperty }
 
+function TContactProperty.GetValueItem(Index: Integer): string;
+var
+  List: TStringList;
+begin
+  List := TStringList.Create;
+  try
+    List.Delimiter := ';';
+    List.NameValueSeparator := '=';
+    List.StrictDelimiter := True;
+    List.DelimitedText := Value;
+    if Index < List.Count then
+      Result := List.Strings[Index]
+      else Result := '';
+  finally
+    List.Free;
+  end;
+end;
+
+procedure TContactProperty.SetValueItem(Index: Integer; AValue: string);
+var
+  List: TStringList;
+begin
+  List := TStringList.Create;
+  try
+    List.Delimiter := ';';
+    List.NameValueSeparator := '=';
+    List.StrictDelimiter := True;
+    List.DelimitedText := Value;
+
+    // Extend subitems count
+    while List.Count <= Index do
+      List.Add('');
+
+    List.Strings[Index] := AValue;
+
+    // Remove empty items
+    while (List.Count > 0) and (List.Strings[List.Count - 1] = '') do
+      List.Delete(List.Count - 1);
+
+    Value := List.DelimitedText;
+  finally
+    List.Free;
+  end;
+end;
+
 procedure TContactProperty.EvaluateAttributes;
 var
@@ -274 +324 @@
     Encoding := Attributes.Values['ENCODING'];
     if (Encoding = 'QUOTED-PRINTABLE') or (Encoding = 'BASE64') then begin
-      Values.DelimitedText := GetDecodedValue;
+      Value := GetDecodedValue;
       Attributes.Delete(Attributes.IndexOfName('ENCODING'));
     end;
@@ -292 +342 @@
 function TContactProperty.GetDecodedValue: string;
 begin
-  if Encoding = 'BASE64' then
-    Result := DecodeStringBase64(Values.DelimitedText)
-  else
-  if Encoding = 'QUOTED-PRINTABLE' then
-    Result := DecodeQuotedPrintable(Values.DelimitedText)
+  if Encoding = 'BASE64' then begin
+    Result := DecodeStringBase64(Value)
+  end else
+  if Encoding = 'QUOTED-PRINTABLE' then begin
+    Result := DecodeQuotedPrintable(Value)
+  end
   else Result := '';
 end;
@@ -330 +381 @@
   Name := Source.Name;
   Attributes.Assign(Source.Attributes);
-  Values.Assign(Source.Values);
+  Value := Source.Value;
+  Encoding := Source.Encoding;
+  Charset := Source.Charset;
 end;
 
@@ -339 +392 @@
   Attributes.NameValueSeparator := '=';
   Attributes.StrictDelimiter := True;
-  Values := TStringList.Create;
-  Values.Delimiter := ';';
-  Values.NameValueSeparator := '=';
-  Values.StrictDelimiter := True;
 end;
 
 destructor TContactProperty.Destroy;
 begin
-  FreeAndNil(Values);
   FreeAndNil(Attributes);
   inherited;
@@ -448 +496 @@
     Field := Parent.Fields.GetByIndex(Index);
     if Field.ValueIndex <> -1 then begin
-      if Field.ValueIndex < Prop.Values.Count then
-        Result := Prop.Values.Strings[Field.ValueIndex]
-        else Result := '';
-    end else Result := Prop.Values.DelimitedText;
+      Result := Prop.ValueItem[Field.ValueIndex]
+    end else Result := Prop.Value;
   end else Result := '';
 end;
@@ -473 +519 @@
     if Assigned(Prop) then begin
       if Field.ValueIndex <> -1 then begin
-        // Extend subitems count
-        while Prop.Values.Count <= Field.ValueIndex do
-          Prop.Values.Add('');
-
-        Prop.Values.Strings[Field.ValueIndex] := AValue;
-      end else Prop.Values.DelimitedText := AValue;
-
-      // Remove empty items
-      while (Prop.Values.Count > 0) and (Prop.Values.Strings[Prop.Values.Count - 1] = '') do
-        Prop.Values.Delete(Prop.Values.Count - 1);
+        Prop.ValueItem[Field.ValueIndex] := AValue;
+      end else Prop.Value := AValue;
 
       // Remove if empty
-      if Prop.Values.Text = '' then begin
+      if Prop.Value = '' then begin
         Properties.Remove(Prop);
       end;
@@ -595 +633 @@
     AddNew('X-TIMES_CONTACTED', [], [], STimesContacted, cfXTimesContacted, dtString);
     AddNew('X-LAST_TIME_CONTACTED', [], [], SLastTimeContacted, cfXLastTimeContacted, dtString);
-    AddNew('PHOTO', [], [], SPhoto, cfPhoto, dtString);
+    AddNew('PHOTO', [], [], SPhoto, cfPhoto, dtImage);
     AddNew('X-JABBER', [], [], SJabber, cfXJabber, dtString);
-    AddNew('BDAY', [], [], SDayOfBirth, cfDayOfBirth, dtString);
-    AddNew('ANNIVERSARY', [], [], SAnniversary, cfAnniversary, dtString);
+    AddNew('BDAY', [], [], SDayOfBirth, cfDayOfBirth, dtDate);
+    AddNew('ANNIVERSARY', [], [], SAnniversary, cfAnniversary, dtDate);
     AddNew('REV', [], [], SRevision, cfRevision, dtString);
     AddNew('UID', [], [], SUniqueIdentifier, cfUid, dtString);
@@ -641 +679 @@
   I: Integer;
   J: Integer;
-  Value: string;
   NameText: string;
 begin
@@ -652 +689 @@
       for J := 0 to Properties.Count - 1 do
       with Properties[J] do begin
-        Value := Values.DelimitedText;
         if Pos(LineEnding, Value) > 0 then begin
           NameText := Name;
@@ -719 +755 @@
             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);
@@ -734 +774 @@
             NewProperty.Attributes.Delete(0);
           end;
-          NewProperty.Values.DelimitedText := Value;
+          NewProperty.Value := Value;
           NewProperty.EvaluateAttributes;
         end else Error(SFoundPropertiesBeforeBlockStart, I + 1);

trunk/UCore.pas

@@ -401 +401 @@
       FormContacts.Contacts := TContactsFile(DataFile).Contacts
       else FormContacts.Contacts := nil;
-    FormContacts.ReloadList;
-    FormContacts.UpdateInterface;
   end;
 end;

trunk/UQuotedPrintable.pas

@@ -21 +21 @@
 function DecodeQuotedPrintable(Text: string): string;
 var
-  O, Count, WS: Byte;
+  O, Count, WS: Integer;
   I: integer;
   InBuf: array[0..Pred(MaxLine)] of Byte;