Changeset 42


Ignore:
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:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormContact.lfm

    r40 r42  
    1818    Top = 8
    1919    Width = 939
    20     ActivePage = TabSheetGeneral
     20    ActivePage = TabSheetOthers
    2121    Anchors = [akTop, akLeft, akRight, akBottom]
    2222    ParentFont = False
    23     TabIndex = 0
     23    TabIndex = 3
    2424    TabOrder = 0
    2525    object TabSheetGeneral: TTabSheet
     
    835835      object MemoNotes: TMemo
    836836        Left = 16
    837         Height = 167
     837        Height = 392
    838838        Top = 48
    839839        Width = 893
  • trunk/Forms/UFormContact.pas

    r40 r42  
    171171    Item.Caption := Contact.Properties[Item.Index].Name;
    172172    Item.SubItems.Add(Attributes.DelimitedText);
    173     Item.SubItems.Add(Contact.Properties[Item.Index].Values.DelimitedText);
     173    Item.SubItems.Add(Contact.Properties[Item.Index].Value);
    174174    Item.Data := Contact.Properties[Item.Index];
    175175  end;
  • trunk/Forms/UFormContacts.pas

    r39 r42  
    133133begin
    134134  if Assigned(Contacts) then Contacts.AssignToList(ListViewSort1.List)
    135     else ListViewSort1.List.Clear;
     135    else begin
     136      ListViewSort1.List.Clear;
     137    end;
    136138  FilterList(ListViewSort1.List);
    137139end;
     
    178180  ReloadList;
    179181  UpdateInterface;
     182  ListViewFilter1.Reset;
    180183end;
    181184
  • trunk/Forms/UFormProperties.pas

    r39 r42  
    8383    Item.Caption := Name;
    8484    Item.SubItems.Add(Attributes.DelimitedText);
    85     Item.SubItems.Add(Values.DelimitedText);
     85    Item.SubItems.Add(Value);
    8686    Item.Data := ListViewSort1.List[Item.Index];
    8787  end;
     
    118118      0: Result := CompareString(TContactProperty(Item1).Name, TContactProperty(Item2).Name);
    119119      1: Result := CompareString(TContactProperty(Item1).Attributes.DelimitedText, TContactProperty(Item2).Attributes.DelimitedText);
    120       2: Result := CompareString(TContactProperty(Item1).Values.DelimitedText, TContactProperty(Item2).Values.DelimitedText);
     120      2: Result := CompareString(TContactProperty(Item1).Value, TContactProperty(Item2).Value);
    121121    end;
    122122    if ListViewSort1.Order = soDown then Result := -Result;
     
    149149             UTF8LowerCase(TContactProperty(List.Items[I]).Attributes.DelimitedText)) > 0 then Inc(FoundCount);
    150150           if Pos(UTF8LowerCase(StringGrid.Cells[2, 0]),
    151              UTF8LowerCase(TContactProperty(List.Items[I]).Values.DelimitedText)) > 0 then Inc(FoundCount);
     151             UTF8LowerCase(TContactProperty(List.Items[I]).Value)) > 0 then Inc(FoundCount);
    152152           if FoundCount <> EnteredCount then List.Delete(I);
    153153         end;
  • trunk/Forms/UFormProperty.pas

    r39 r42  
    8080    EditName.Text := FContactProperty.Name;
    8181    EditAttributes.Text := FContactProperty.Attributes.DelimitedText;
    82     EditValues.Text := FContactProperty.Values.DelimitedText;
     82    EditValues.Text := FContactProperty.Value;
    8383  end else begin
    8484    EditName.Text := '';
     
    9595  FContactProperty.Name := EditName.Text;
    9696  FContactProperty.Attributes.DelimitedText := EditAttributes.Text;
    97   FContactProperty.Values.DelimitedText := EditValues.Text;
     97  FContactProperty.Value := EditValues.Text;
    9898end;
    9999
  • trunk/Packages/Common/UListViewSort.pas

    r22 r42  
    8181    FOnChange: TNotifyEvent;
    8282    FStringGrid1: TStringGrid;
     83    procedure DoOnChange;
    8384    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    8485    procedure GridDoOnResize(Sender: TObject);
     
    9091    function TextEnteredColumn(Index: Integer): Boolean;
    9192    function GetColValue(Index: Integer): string;
     93    procedure Reset;
    9294    property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
    9395  published
     
    152154{ TListViewFilter }
    153155
     156procedure TListViewFilter.DoOnChange;
     157begin
     158  if Assigned(FOnChange) then FOnChange(Self);
     159end;
     160
    154161procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    155162  Shift: TShiftState);
    156163begin
    157   if Assigned(FOnChange) then
    158     FOnChange(Self);
     164  DoOnChange;
    159165end;
    160166
     
    227233    Result := StringGrid.Cells[Index, 0]
    228234    else Result := '';
     235end;
     236
     237procedure TListViewFilter.Reset;
     238var
     239  I: Integer;
     240begin
     241  with StringGrid do
     242  for I := 0 to ColCount - 1 do
     243    Cells[I, 0] := '';
     244  DoOnChange;
    229245end;
    230246
  • trunk/UContact.pas

    r40 r42  
    1313  TErrorEvent = procedure (Text: string; Line: Integer) of object;
    1414
    15   TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage);
     15  TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage, dtStringList);
    1616
    1717  TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTitleBefore,
     
    5353
    5454  TContactProperty = class
     55  private
     56    function GetValueItem(Index: Integer): string;
     57    procedure SetValueItem(Index: Integer; AValue: string);
     58  public
    5559    Name: string;
    5660    Attributes: TStringList;
    57     Values: TStringList;
     61    Value: string;
    5862    Encoding: string;
    5963    Charset: string;
     
    6569    constructor Create;
    6670    destructor Destroy; override;
     71    property ValueItem[Index: Integer]: string read GetValueItem write SetValueItem;
    6772  end;
    6873
     
    264269{ TContactProperty }
    265270
     271function TContactProperty.GetValueItem(Index: Integer): string;
     272var
     273  List: TStringList;
     274begin
     275  List := TStringList.Create;
     276  try
     277    List.Delimiter := ';';
     278    List.NameValueSeparator := '=';
     279    List.StrictDelimiter := True;
     280    List.DelimitedText := Value;
     281    if Index < List.Count then
     282      Result := List.Strings[Index]
     283      else Result := '';
     284  finally
     285    List.Free;
     286  end;
     287end;
     288
     289procedure TContactProperty.SetValueItem(Index: Integer; AValue: string);
     290var
     291  List: TStringList;
     292begin
     293  List := TStringList.Create;
     294  try
     295    List.Delimiter := ';';
     296    List.NameValueSeparator := '=';
     297    List.StrictDelimiter := True;
     298    List.DelimitedText := Value;
     299
     300    // Extend subitems count
     301    while List.Count <= Index do
     302      List.Add('');
     303
     304    List.Strings[Index] := AValue;
     305
     306    // Remove empty items
     307    while (List.Count > 0) and (List.Strings[List.Count - 1] = '') do
     308      List.Delete(List.Count - 1);
     309
     310    Value := List.DelimitedText;
     311  finally
     312    List.Free;
     313  end;
     314end;
     315
    266316procedure TContactProperty.EvaluateAttributes;
    267317var
     
    274324    Encoding := Attributes.Values['ENCODING'];
    275325    if (Encoding = 'QUOTED-PRINTABLE') or (Encoding = 'BASE64') then begin
    276       Values.DelimitedText := GetDecodedValue;
     326      Value := GetDecodedValue;
    277327      Attributes.Delete(Attributes.IndexOfName('ENCODING'));
    278328    end;
     
    292342function TContactProperty.GetDecodedValue: string;
    293343begin
    294   if Encoding = 'BASE64' then
    295     Result := DecodeStringBase64(Values.DelimitedText)
    296   else
    297   if Encoding = 'QUOTED-PRINTABLE' then
    298     Result := DecodeQuotedPrintable(Values.DelimitedText)
     344  if Encoding = 'BASE64' then begin
     345    Result := DecodeStringBase64(Value)
     346  end else
     347  if Encoding = 'QUOTED-PRINTABLE' then begin
     348    Result := DecodeQuotedPrintable(Value)
     349  end
    299350  else Result := '';
    300351end;
     
    330381  Name := Source.Name;
    331382  Attributes.Assign(Source.Attributes);
    332   Values.Assign(Source.Values);
     383  Value := Source.Value;
     384  Encoding := Source.Encoding;
     385  Charset := Source.Charset;
    333386end;
    334387
     
    339392  Attributes.NameValueSeparator := '=';
    340393  Attributes.StrictDelimiter := True;
    341   Values := TStringList.Create;
    342   Values.Delimiter := ';';
    343   Values.NameValueSeparator := '=';
    344   Values.StrictDelimiter := True;
    345394end;
    346395
    347396destructor TContactProperty.Destroy;
    348397begin
    349   FreeAndNil(Values);
    350398  FreeAndNil(Attributes);
    351399  inherited;
     
    448496    Field := Parent.Fields.GetByIndex(Index);
    449497    if Field.ValueIndex <> -1 then begin
    450       if Field.ValueIndex < Prop.Values.Count then
    451         Result := Prop.Values.Strings[Field.ValueIndex]
    452         else Result := '';
    453     end else Result := Prop.Values.DelimitedText;
     498      Result := Prop.ValueItem[Field.ValueIndex]
     499    end else Result := Prop.Value;
    454500  end else Result := '';
    455501end;
     
    473519    if Assigned(Prop) then begin
    474520      if Field.ValueIndex <> -1 then begin
    475         // Extend subitems count
    476         while Prop.Values.Count <= Field.ValueIndex do
    477           Prop.Values.Add('');
    478 
    479         Prop.Values.Strings[Field.ValueIndex] := AValue;
    480       end else Prop.Values.DelimitedText := AValue;
    481 
    482       // Remove empty items
    483       while (Prop.Values.Count > 0) and (Prop.Values.Strings[Prop.Values.Count - 1] = '') do
    484         Prop.Values.Delete(Prop.Values.Count - 1);
     521        Prop.ValueItem[Field.ValueIndex] := AValue;
     522      end else Prop.Value := AValue;
    485523
    486524      // Remove if empty
    487       if Prop.Values.Text = '' then begin
     525      if Prop.Value = '' then begin
    488526        Properties.Remove(Prop);
    489527      end;
     
    595633    AddNew('X-TIMES_CONTACTED', [], [], STimesContacted, cfXTimesContacted, dtString);
    596634    AddNew('X-LAST_TIME_CONTACTED', [], [], SLastTimeContacted, cfXLastTimeContacted, dtString);
    597     AddNew('PHOTO', [], [], SPhoto, cfPhoto, dtString);
     635    AddNew('PHOTO', [], [], SPhoto, cfPhoto, dtImage);
    598636    AddNew('X-JABBER', [], [], SJabber, cfXJabber, dtString);
    599     AddNew('BDAY', [], [], SDayOfBirth, cfDayOfBirth, dtString);
    600     AddNew('ANNIVERSARY', [], [], SAnniversary, cfAnniversary, dtString);
     637    AddNew('BDAY', [], [], SDayOfBirth, cfDayOfBirth, dtDate);
     638    AddNew('ANNIVERSARY', [], [], SAnniversary, cfAnniversary, dtDate);
    601639    AddNew('REV', [], [], SRevision, cfRevision, dtString);
    602640    AddNew('UID', [], [], SUniqueIdentifier, cfUid, dtString);
     
    641679  I: Integer;
    642680  J: Integer;
    643   Value: string;
    644681  NameText: string;
    645682begin
     
    652689      for J := 0 to Properties.Count - 1 do
    653690      with Properties[J] do begin
    654         Value := Values.DelimitedText;
    655691        if Pos(LineEnding, Value) > 0 then begin
    656692          NameText := Name;
     
    719755            if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
    720756              Value := Value + Trim(Lines[I]);
     757            end else
     758            if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
     759              (Lines[I][1] = '=') then begin
     760              Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
    721761            end else begin
    722762              Dec(I);
     
    734774            NewProperty.Attributes.Delete(0);
    735775          end;
    736           NewProperty.Values.DelimitedText := Value;
     776          NewProperty.Value := Value;
    737777          NewProperty.EvaluateAttributes;
    738778        end else Error(SFoundPropertiesBeforeBlockStart, I + 1);
  • trunk/UCore.pas

    r34 r42  
    401401      FormContacts.Contacts := TContactsFile(DataFile).Contacts
    402402      else FormContacts.Contacts := nil;
    403     FormContacts.ReloadList;
    404     FormContacts.UpdateInterface;
    405403  end;
    406404end;
  • trunk/UQuotedPrintable.pas

    r35 r42  
    2121function DecodeQuotedPrintable(Text: string): string;
    2222var
    23   O, Count, WS: Byte;
     23  O, Count, WS: Integer;
    2424  I: integer;
    2525  InBuf: array[0..Pred(MaxLine)] of Byte;
Note: See TracChangeset for help on using the changeset viewer.