Check-in [c745c5e61c]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added support for tags. HTMLDecode yet more robust.
Timelines: family | ancestors | descendants | both | bookmark-dupes
Files: files | file ages | folders
SHA1:c745c5e61cc1bacf87c0c6dbab45aaebdb39ab80
User & Date: tinus 2015-01-12 00:01:46
Context
2015-01-12
00:17
Prevent warnings on custom attributes. check-in: 1cee04dc58 user: tinus tags: bookmark-dupes
00:01
Added support for tags. HTMLDecode yet more robust. check-in: c745c5e61c user: tinus tags: bookmark-dupes
2015-01-11
23:26
Parsing a Firefox bookmarks.html caused an exception because it writes <HR> on the same line as the next item. check-in: 577e961ddb user: tinus tags: bookmark-dupes
Changes

Changes to readbookmarks.pas.

83
84
85
86
87
88
89

90
91
92

93
94
95
96



97
98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
...
139
140
141
142
143
144
145
146
147





148
149
150
151
152
153
154


155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
...
200
201
202
203
204
205
206
207
208



209
210

211
212
213
214
215
216
217
...
265
266
267
268
269
270
271
















272
273
274
275
276
277
278
...
279
280
281
282
283
284
285



286
287
288
289
290
291
292
293
294
295
296
297
298


299
300
301
302
303
304
305
...
404
405
406
407
408
409
410

411
412
413
414
415
416
417




418

419
420
421
422
423
424
425
...
460
461
462
463
464
465
466

467
468
469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487
488
489
490
491
492






493
494
495
496
497

498
499
500

501
502
503
504
505
506
507
...
528
529
530
531
532
533
534


535
536
537
538
539
540
541
...
906
907
908
909
910
911
912
913
914


915
916
917
918
919
920
921
    property IsToolbarFolder: boolean read FToolbar write FToolbar;
  end;

  { TBookmark }

  TBookmark = class(TContentEntry)
  private

    FFeedURL: string;
    FKeyword: string;
    FURL: string;

  protected
    procedure DoSetProperty(const Key, Value: string; var HasBeenSet: boolean); override;
    function  GetHTMLAttributes: string; override;
  public



    procedure SaveToStrings(const Strings: TStrings); override;

    property URL: string      read FURL     write FURL;
    property FeedURL: string  read FFeedURL write FFeedURL;
    property Keyword: string  read FKeyword write FKeyword;

  end;


const // for use both in HTMLDecode and HTMLEncode
  cEntities: array[0..9] of string = ('amp', '&', 'lt', '<', 'gt', '>', 'quot', '"', 'apos', '''');

function HTMLDecode(const HTML: string): string;
var
  i: integer;
  c: char;
  InEntity: boolean;
  Entity: string;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  procedure ProcessEntity;
  var
    ei: integer;
    CharCode: integer;
    Found: boolean;
  begin
    Found := False;
    if Length(Entity) > 1 then begin
................................................................................
            end;
          end;
        end {for};
      end;
    end;
    if Found then
      Result := Result + Entity
    else
      Result := Result + '&' + Entity + ';';





  end {ProcessEntity};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
begin
  Result := '';
  Entity := '';
  InEntity := False;
  for i := 1 to Length(HTML) do begin


    c := HTML[i];
    if InEntity then begin
      if c = '&' then begin
        ProcessEntity;
        InEntity := True;
        Entity := '';
      end else if c = ';' then begin
        ProcessEntity;
        InEntity := False;
        Entity := '';
      end else begin
        Entity := Entity + c;
      end;
    end else begin
      if c = '&' then begin
        InEntity := True;
        Entity := '';
      end else begin
        Result := Result + c;
      end;
    end;
  end;
  if InEntity then
    ProcessEntity;
end {HTMLDecode};

type
  THTMLEncodingContext = (hecText, hecAttribute);

function HTMLEncode(const Text: string; const Context: THTMLEncodingContext = hecText): string;
var
  i: integer;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  procedure ReplaceEntity;
  var
................................................................................
    Result[i] := '&';
  end {ReplaceEntity};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
begin
  Result := Text;
  for i := Length(Result) downto 1 do begin
    case Result[i] of
      '&', '<', '>', #0:
        ReplaceEntity;



      '"':
        if Context = hecAttribute then

          ReplaceEntity;
    end {case};
  end;
end {HTMLEncode};


{ TDivider }
................................................................................
  // Then, check if Self is not already in the new parent; if not, add Self
  if Assigned(FParent) and (FParent.Entries.IndexOf(Self) = -1) then
    FParent.Entries.Add(Self);
end {TEntry.SetParent};


{ TBookmark }

















procedure TBookmark.DoSetProperty(const Key, Value: string; var HasBeenSet: boolean);
begin
  inherited DoSetProperty(Key, Value, HasBeenSet);

  if SameText(Key, 'HREF') then begin
    FURL := Value;
................................................................................
    HasBeenSet := True;
  end else if SameText(Key, 'FEEDURL') then begin
    FFeedURL := Value;
    HasBeenSet := True;
  end else if SameText(Key, 'SHORTCUTURL') then begin
    FKeyword := Value;
    HasBeenSet := True;



  end;
end {TBookmark.DoSetProperty};

function TBookmark.GetHTMLAttributes: string;
begin
  Result := '';
  if FURL <> '' then
    Result := Result + ' HREF="' + HTMLEncode(FURL, hecAttribute) + '"';
  if FFeedURL <> '' then
    Result := Result + ' FEEDURL="' + HTMLEncode(FFeedURL, hecAttribute) + '"';
  if FKeyword <> '' then
    Result := Result + ' SHORTCUTURL="' + HTMLEncode(FKeyword, hecAttribute) + '"';
  Result := Result + inherited GetHTMLAttributes;


end {TBookmark.GetHTMLAttributes};

procedure TBookmark.SaveToStrings(const Strings: TStrings);
begin
  Strings.Add(StringOfChar(' ', 4 * Level) + '<DT><A' + GetHTMLAttributes + '>'
            + HTMLEncode(Name)
            + '</A>');
................................................................................
    Matches := rxAttr.ExecNext;
  end;
end {TContentEntry.ReadProperties};

function TContentEntry.GetHTMLAttributes: string;
var
  i: integer;

begin
  Result := '';
  if FAdded > 0 then
    Result := Result + ' ADD_DATE="' + IntToStr(Round((FAdded - EncodeDate(1970, 1, 1)) * SecsPerDay)) + '"';
  if FModified > 0 then
    Result := Result + ' LAST_MODIFIED="' + IntToStr(Round((FModified - EncodeDate(1970, 1, 1)) * SecsPerDay)) + '"';
  for i := 0 to FAttributes.Count - 1 do




    Result := Result + ' ' + HTMLEncode(FAttributes.Names[i]) + '="' + HTMLEncode(FAttributes.ValueFromIndex[i], hecAttribute) + '"';

end {TContentEntry.GetHTMLAttributes};

procedure TContentEntry.DoSetProperty(const Key, Value: string; var HasBeenSet: boolean);
var
  Seconds: Integer;
begin
  if SameText(Key, 'ADD_DATE') then begin
................................................................................
    FNames: TStringArray;
    FAdded: TDateTime;
    FLastModified: TDateTime;
    FMinLevel: cardinal;
    FMaxLevel: cardinal;
    FDescriptions: TStringArray;
    FAttributes: TStringList;


    function AddStringIfUnique(const NewString: string; var Strings: TStringArray): boolean;
  public
    constructor Create(const Initial: TBookmark);
    destructor  Destroy; override;
    function Add(const Bookmark: TBookmark): integer;
    property Names: TStringArray        read FNames;
    property Added: TDateTime           read FAdded;
    property LastModified: TDateTime    read FLastModified;
    property Descriptions: TStringArray read FDescriptions;
    property MinLevel: cardinal         read FMinLevel;
    property MaxLevel: cardinal         read FMaxLevel;
    property Attributes: TStringList    read FAttributes;

  end;

constructor TDuplicateSet.Create(const Initial: TBookmark);
begin
  inherited Create(False);
  FAdded := 0;
  FLastModified := 0;
  SetLength(FNames, 1);
  FNames[0] := Initial.Name;
  SetLength(FDescriptions, 0);
  FMinLevel := High(FMinLevel);
  FMaxLevel := Low(FMaxLevel);
  FAttributes := TStringList.Create;






  Add(Initial);
end {TDuplicateSet.Create};

destructor TDuplicateSet.Destroy;
begin

  FAttributes.Free;
  inherited Destroy;
end;


function TDuplicateSet.Add(const Bookmark: TBookmark): integer;
var
  D: TDateTime;
  L: integer;
  IsNewer: boolean;
  i: integer;
................................................................................
    FLastModified := D;

  L := Bookmark.Level;
  if L < FMinLevel then
    FMinLevel := L;
  if L > FMaxLevel then
    FMaxLevel := L;


end {TDuplicateSet.Add};

function TDuplicateSet.AddStringIfUnique(const NewString: string; var Strings: TStringArray): boolean;
var
  i: integer;
  Found: boolean;
begin
................................................................................
          Names[ni - bi] := Dupes.Names[ni];
      end;
      if bi > 0 then
        SetLength(Names, Length(Names) - bi);
      Bookmark.Description := IfThen(Bookmark.Description <> '', Bookmark.Description + sLineBreak, '')
                            + 'Alternative name' + IfThen(Length(Names) = 1, ': ', 's:' + sLineBreak)
                            + Join(Names);
      Bookmark.Attributes.Assign(Dupes.Attributes);
    end;



    // Instead of deleting them right now, move them to the result set of entries. The calling party can then free them.
    for bi := Dupes.Count - 1 downto 0 do begin
      if Dupes[bi] <> Bookmark then begin
        Result.Add(Dupes[bi]);
      end;
    end;







>


<
>




>
>
>


|
|
|
>













|







 







|
|
>
>
>
>
>







>
>



|

<

|
<
<













|



|







 







|

>
>
>

<
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>







|

|



>
>







 







>






|
>
>
>
>
|
>







 







>













>













>
>
>
>
>
>





>


<
>







 







>
>







 







<

>
>







83
84
85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171

172
173


174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
...
209
210
211
212
213
214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229
...
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
...
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547

548
549
550
551
552
553
554
555
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
...
956
957
958
959
960
961
962

963
964
965
966
967
968
969
970
971
972
    property IsToolbarFolder: boolean read FToolbar write FToolbar;
  end;

  { TBookmark }

  TBookmark = class(TContentEntry)
  private
    FURL: string;
    FFeedURL: string;
    FKeyword: string;

    FTags: TStringList;
  protected
    procedure DoSetProperty(const Key, Value: string; var HasBeenSet: boolean); override;
    function  GetHTMLAttributes: string; override;
  public
    constructor Create(const AParent: TFolder; const LineNumber: cardinal); override;
    destructor  Destroy; override;

    procedure SaveToStrings(const Strings: TStrings); override;

    property URL: string        read FURL     write FURL;
    property FeedURL: string    read FFeedURL write FFeedURL;
    property Keyword: string    read FKeyword write FKeyword;
    property Tags: TStringList  read FTags;
  end;


const // for use both in HTMLDecode and HTMLEncode
  cEntities: array[0..9] of string = ('amp', '&', 'lt', '<', 'gt', '>', 'quot', '"', 'apos', '''');

function HTMLDecode(const HTML: string): string;
var
  i: integer;
  c: char;
  InEntity: boolean;
  Entity: string;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  procedure ProcessEntity(const FoundSemicolon: boolean);
  var
    ei: integer;
    CharCode: integer;
    Found: boolean;
  begin
    Found := False;
    if Length(Entity) > 1 then begin
................................................................................
            end;
          end;
        end {for};
      end;
    end;
    if Found then
      Result := Result + Entity
    else begin
      Result := Result + '&' + Entity;
      if FoundSemicolon then
        Result := Result + ';';
    end;
    InEntity := False;
    Entity := '';
  end {ProcessEntity};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
begin
  Result := '';
  Entity := '';
  InEntity := False;
  for i := 1 to Length(HTML) do begin
    if InEntity and (Length(Entity) > 6) then
      ProcessEntity(False);
    c := HTML[i];
    if InEntity then begin
      if c = '&' then begin
        ProcessEntity(False);
        InEntity := True;

      end else if c = ';' then begin
        ProcessEntity(True);


      end else begin
        Entity := Entity + c;
      end;
    end else begin
      if c = '&' then begin
        InEntity := True;
        Entity := '';
      end else begin
        Result := Result + c;
      end;
    end;
  end;
  if InEntity then
    ProcessEntity(False);
end {HTMLDecode};

type
  THTMLEncodingContext = (hecText, hecAttribute, hecURI);

function HTMLEncode(const Text: string; const Context: THTMLEncodingContext = hecText): string;
var
  i: integer;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  procedure ReplaceEntity;
  var
................................................................................
    Result[i] := '&';
  end {ReplaceEntity};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
begin
  Result := Text;
  for i := Length(Result) downto 1 do begin
    case Result[i] of
      '<', '>', #0:
        ReplaceEntity;
      '&':
        if Context <> hecURI then
          ReplaceEntity;
      '"':

        if Context in [hecAttribute, hecURI] then
          ReplaceEntity;
    end {case};
  end;
end {HTMLEncode};


{ TDivider }
................................................................................
  // Then, check if Self is not already in the new parent; if not, add Self
  if Assigned(FParent) and (FParent.Entries.IndexOf(Self) = -1) then
    FParent.Entries.Add(Self);
end {TEntry.SetParent};


{ TBookmark }

constructor TBookmark.Create(const AParent: TFolder; const LineNumber: cardinal);
begin
  inherited Create(AParent, LineNumber);
  FTags := TStringList.Create;
  FTags.Delimiter := ',';
  FTags.StrictDelimiter := True;
  FTags.Sorted := True;
  FTags.Duplicates := dupIgnore;
end {TBookmark.Create};

destructor TBookmark.Destroy;
begin
  FTags.Free;
  inherited Destroy;
end {TBookmark.Destroy};

procedure TBookmark.DoSetProperty(const Key, Value: string; var HasBeenSet: boolean);
begin
  inherited DoSetProperty(Key, Value, HasBeenSet);

  if SameText(Key, 'HREF') then begin
    FURL := Value;
................................................................................
    HasBeenSet := True;
  end else if SameText(Key, 'FEEDURL') then begin
    FFeedURL := Value;
    HasBeenSet := True;
  end else if SameText(Key, 'SHORTCUTURL') then begin
    FKeyword := Value;
    HasBeenSet := True;
  end else if SameText(Key, 'TAGS') then begin
    FTags.DelimitedText := Value;
    HasBeenSet := True;
  end;
end {TBookmark.DoSetProperty};

function TBookmark.GetHTMLAttributes: string;
begin
  Result := '';
  if FURL <> '' then
    Result := Result + ' HREF="' + HTMLEncode(FURL, hecURI) + '"';
  if FFeedURL <> '' then
    Result := Result + ' FEEDURL="' + HTMLEncode(FFeedURL, hecURI) + '"';
  if FKeyword <> '' then
    Result := Result + ' SHORTCUTURL="' + HTMLEncode(FKeyword, hecAttribute) + '"';
  Result := Result + inherited GetHTMLAttributes;
  if FTags.Count > 0 then
    Result := Result + ' TAGS="' + HTMLEncode(FTags.DelimitedText, hecAttribute) + '"';
end {TBookmark.GetHTMLAttributes};

procedure TBookmark.SaveToStrings(const Strings: TStrings);
begin
  Strings.Add(StringOfChar(' ', 4 * Level) + '<DT><A' + GetHTMLAttributes + '>'
            + HTMLEncode(Name)
            + '</A>');
................................................................................
    Matches := rxAttr.ExecNext;
  end;
end {TContentEntry.ReadProperties};

function TContentEntry.GetHTMLAttributes: string;
var
  i: integer;
  hec: THTMLEncodingContext;
begin
  Result := '';
  if FAdded > 0 then
    Result := Result + ' ADD_DATE="' + IntToStr(Round((FAdded - EncodeDate(1970, 1, 1)) * SecsPerDay)) + '"';
  if FModified > 0 then
    Result := Result + ' LAST_MODIFIED="' + IntToStr(Round((FModified - EncodeDate(1970, 1, 1)) * SecsPerDay)) + '"';
  for i := 0 to FAttributes.Count - 1 do begin
    if AnsiContainsText(FAttributes.Names[i], 'URL') or AnsiContainsText(FAttributes.Names[i], 'HREF') or AnsiContainsText(FAttributes.Names[i], 'SRC') then
      hec := hecURI
    else
      hec := hecAttribute;
    Result := Result + ' ' + HTMLEncode(FAttributes.Names[i]) + '="' + HTMLEncode(FAttributes.ValueFromIndex[i], hec) + '"';
  end;
end {TContentEntry.GetHTMLAttributes};

procedure TContentEntry.DoSetProperty(const Key, Value: string; var HasBeenSet: boolean);
var
  Seconds: Integer;
begin
  if SameText(Key, 'ADD_DATE') then begin
................................................................................
    FNames: TStringArray;
    FAdded: TDateTime;
    FLastModified: TDateTime;
    FMinLevel: cardinal;
    FMaxLevel: cardinal;
    FDescriptions: TStringArray;
    FAttributes: TStringList;
    FTags: TStringList;

    function AddStringIfUnique(const NewString: string; var Strings: TStringArray): boolean;
  public
    constructor Create(const Initial: TBookmark);
    destructor  Destroy; override;
    function Add(const Bookmark: TBookmark): integer;
    property Names: TStringArray        read FNames;
    property Added: TDateTime           read FAdded;
    property LastModified: TDateTime    read FLastModified;
    property Descriptions: TStringArray read FDescriptions;
    property MinLevel: cardinal         read FMinLevel;
    property MaxLevel: cardinal         read FMaxLevel;
    property Attributes: TStringList    read FAttributes;
    property Tags: TStringList          read FTags;
  end;

constructor TDuplicateSet.Create(const Initial: TBookmark);
begin
  inherited Create(False);
  FAdded := 0;
  FLastModified := 0;
  SetLength(FNames, 1);
  FNames[0] := Initial.Name;
  SetLength(FDescriptions, 0);
  FMinLevel := High(FMinLevel);
  FMaxLevel := Low(FMaxLevel);
  FAttributes := TStringList.Create;
  FAttributes.NameValueSeparator := '=';
  FTags := TStringList.Create;
  FTags.Delimiter := ',';
  FTags.StrictDelimiter := True;
  FTags.Sorted := True;
  FTags.Duplicates := dupIgnore;
  Add(Initial);
end {TDuplicateSet.Create};

destructor TDuplicateSet.Destroy;
begin
  FTags.Free;
  FAttributes.Free;
  inherited Destroy;

end {TDuplicateSet.Destroy};

function TDuplicateSet.Add(const Bookmark: TBookmark): integer;
var
  D: TDateTime;
  L: integer;
  IsNewer: boolean;
  i: integer;
................................................................................
    FLastModified := D;

  L := Bookmark.Level;
  if L < FMinLevel then
    FMinLevel := L;
  if L > FMaxLevel then
    FMaxLevel := L;

  FTags.AddStrings(Bookmark.Tags);
end {TDuplicateSet.Add};

function TDuplicateSet.AddStringIfUnique(const NewString: string; var Strings: TStringArray): boolean;
var
  i: integer;
  Found: boolean;
begin
................................................................................
          Names[ni - bi] := Dupes.Names[ni];
      end;
      if bi > 0 then
        SetLength(Names, Length(Names) - bi);
      Bookmark.Description := IfThen(Bookmark.Description <> '', Bookmark.Description + sLineBreak, '')
                            + 'Alternative name' + IfThen(Length(Names) = 1, ': ', 's:' + sLineBreak)
                            + Join(Names);

    end;
    Bookmark.Attributes.Assign(Dupes.Attributes);
    Bookmark.Tags.AddStrings(Dupes.Tags);

    // Instead of deleting them right now, move them to the result set of entries. The calling party can then free them.
    for bi := Dupes.Count - 1 downto 0 do begin
      if Dupes[bi] <> Bookmark then begin
        Result.Add(Dupes[bi]);
      end;
    end;