Changeset 42 for trunk/UContact.pas

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.

File:

• trunk/UContact.pas (modified) (15 diffs)

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);