source: tags/1.4.0/UAcronym.pas

Last change on this file was 159, checked in by chronos, 6 years ago
  • Fixed: Error if categories are removed by user.
File size: 47.0 KB
Line 
1unit UAcronym;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, Contnrs, XMLRead, XMLWrite, DOM, UXMLUtils,
9 SpecializedList, fphttpclient2, Dialogs, odbcconn, sqldb, LazUTF8,
10 fgl;
11
12type
13 TAcronymCategories = class;
14 TAcronymMeanings = class;
15 TAcronymDb = class;
16 TImportSource = class;
17 TImportSources = class;
18 TImportFormats = class;
19
20 { TAcronym }
21
22 TAcronym = class
23 Db: TAcronymDb;
24 Name: string;
25 Meanings: TAcronymMeanings;
26 procedure SaveToNode(Node: TDOMNode);
27 procedure LoadFromNode(Node: TDOMNode);
28 constructor Create;
29 destructor Destroy; override;
30 end;
31
32 { TAcronyms }
33
34 TAcronyms = class(TObjectList)
35 Db: TAcronymDb;
36 procedure SaveToNode(Node: TDOMNode);
37 procedure LoadFromNode(Node: TDOMNode);
38 function SearchByName(Name: string): TAcronym;
39 function AddAcronym(Name: string): TAcronym;
40 end;
41
42 { TAcronymMeaning }
43
44 TAcronymMeaning = class
45 Id: Integer;
46 Name: string;
47 Description: string;
48 Language: string;
49 Acronym: TAcronym;
50 Categories: TAcronymCategories;
51 Sources: TImportSources;
52 procedure MergeCategories(MergedCategories: TAcronymCategories);
53 procedure SaveToNode(Node: TDOMNode);
54 procedure LoadFromNode(Node: TDOMNode);
55 constructor Create;
56 destructor Destroy; override;
57 end;
58
59 { TAcronymMeanings }
60
61 TAcronymMeanings = class(TObjectList)
62 public
63 Acronym: TAcronym;
64 procedure UpdateIds;
65 procedure SaveToNode(Node: TDOMNode);
66 procedure LoadFromNode(Node: TDOMNode);
67 function SearchByName(Name: string): TAcronymMeaning;
68 function AddMeaning(Name: string): TAcronymMeaning;
69 end;
70
71 { TAcronymCategory }
72
73 TAcronymCategory = class
74 Id: Integer;
75 Name: string;
76 AcronymMeanings: TAcronymMeanings;
77 ImportSources: TImportSources;
78 Enabled: Boolean;
79 procedure SaveToNode(Node: TDOMNode);
80 procedure LoadFromNode(Node: TDOMNode);
81 constructor Create;
82 destructor Destroy; override;
83 end;
84
85 { TAcronymCategories }
86
87 TAcronymCategories = class(TObjectList)
88 Db: TAcronymDb;
89 procedure UpdateIds;
90 procedure SaveToNode(Node: TDOMNode);
91 procedure LoadFromNode(Node: TDOMNode);
92 procedure SaveRefToNode(Node: TDOMNode);
93 procedure LoadRefFromNode(Node: TDOMNode);
94 function SearchByName(Name: string): TAcronymCategory;
95 function SearchById(Id: Integer): TAcronymCategory;
96 function AddContext(Name: string): TAcronymCategory;
97 procedure AssignToStrings(Strings: TStrings);
98 procedure AssignFromStrings(Strings: TStrings);
99 procedure AddFromStrings(Strings: TStrings);
100 procedure AssignToList(List: TListObject);
101 function GetString: string;
102 procedure UpdateLinkImportSources(Item: TImportSource);
103 procedure UpdateLinkAcronymMeanings(Item: TAcronymMeaning);
104 function IsAnyEnabled: Boolean;
105 end;
106
107 { TAcronymEntry }
108
109 TAcronymEntry = class
110 Name: string;
111 Meaning: string;
112 Description: string;
113 Categories: TStringList;
114 Sources: TStringList;
115 constructor Create;
116 destructor Destroy; override;
117 end;
118
119 TImportPatternFlag = (ipfSet, ipfNewItem, ipfSkip, ipfRemove, ipfCleanSet);
120 TImportVariable = (ivNone, ivAcronym, ivMeaning, ivDescription, ivCategory);
121
122 { TImportPattern }
123
124 TImportPattern = class
125 StartString: string;
126 EndString: string;
127 Variable: TImportVariable;
128 Flag: TImportPatternFlag;
129 Repetition: Boolean;
130 procedure Assign(Source: TImportPattern);
131 procedure SaveToNode(Node: TDOMNode);
132 procedure LoadFromNode(Node: TDOMNode);
133 end;
134
135 { TImportPatterns }
136
137 TImportPatterns = class(TObjectList)
138 procedure SaveToNode(Node: TDOMNode);
139 procedure LoadFromNode(Node: TDOMNode);
140 end;
141
142 TImportFormatKind = (ifkParseURL, ifkMSAccess, ifkParseFile);
143
144 { TImportFormat }
145
146 TImportFormat = class
147 Id: Integer;
148 Name: string;
149 Kind: TImportFormatKind;
150 Block: TImportPattern;
151 ItemPatterns: TImportPatterns;
152 Formats: TImportFormats;
153 procedure Assign(Source: TImportFormat);
154 procedure SaveToNode(Node: TDOMNode);
155 procedure LoadFromNode(Node: TDOMNode);
156 constructor Create;
157 destructor Destroy; override;
158 end;
159
160 { TImportFormats }
161
162 TImportFormats = class(TObjectList)
163 procedure UpdateIds;
164 procedure SaveToNode(Node: TDOMNode);
165 procedure LoadFromNode(Node: TDOMNode);
166 function SearchByName(Name: string): TImportFormat;
167 function SearchById(Id: Integer): TImportFormat;
168 end;
169
170 { TImportSource }
171
172 TImportSource = class
173 private
174 ResponseStream: TMemoryStream;
175 procedure DoPassword(Sender: TObject; var RepeatRequest : Boolean);
176 procedure TextParse(S: string);
177 public
178 Id: Integer;
179 Enabled: Boolean;
180 Name: string;
181 URL: string;
182 Format: TImportFormat;
183 Sources: TImportSources;
184 ItemCount: Integer;
185 LastImportTime: TDateTime;
186 Categories: TAcronymCategories;
187 UserName: string;
188 Password: string;
189 function DownloadHTTP(URL: string; Stream: TStream): Boolean;
190 procedure Process;
191 procedure ProcessTextParseURL;
192 procedure ProcessTextParseFile;
193 procedure ProcessMSAccess;
194 procedure Assign(Source: TImportSource);
195 procedure SaveToNode(Node: TDOMNode);
196 procedure LoadFromNode(Node: TDOMNode);
197 constructor Create;
198 destructor Destroy; override;
199 end;
200
201 { TImportSources }
202
203 TImportSources = class(TObjectList)
204 AcronymDb: TAcronymDb;
205 procedure UpdateIds;
206 function SearchById(Id: Integer): TImportSource;
207 procedure SaveRefToNode(Node: TDOMNode);
208 procedure LoadRefFromNode(Node: TDOMNode);
209 procedure AssignToStrings(Strings: TStrings);
210 function SearchByName(Name: string): TImportSource;
211 procedure SaveToNode(Node: TDOMNode);
212 procedure LoadFromNode(Node: TDOMNode);
213 procedure AssignToList(List: TListObject);
214 end;
215
216 { TAcronymDb }
217
218 TAcronymDb = class
219 private
220 FUpdateCount: Integer;
221 public
222 FileName: string;
223 Acronyms: TAcronyms;
224 Categories: TAcronymCategories;
225 ImportSources: TImportSources;
226 ImportFormats: TImportFormats;
227 Modified: Boolean;
228 AddedCount: Integer;
229 OnUpdate: TFPGList<TNotifyEvent>;
230 constructor Create;
231 destructor Destroy; override;
232 procedure LoadFromFile(FileName: string);
233 procedure SaveToFile(FileName: string);
234 procedure LoadFromFileCSV(FileName: string);
235 procedure SaveToFileCSV(FileName: string);
236 procedure FilterList(AName: string; Items: TAcronymMeanings);
237 function GetMeaningsCount: Integer;
238 function AddAcronym(AcronymName, MeaningName: string): TAcronymMeaning;
239 procedure RemoveMeaning(Meaning: TAcronymMeaning);
240 procedure RemoveAcronym(AcronymName, MeaningName: string);
241 procedure AssignToList(List: TListObject; EnabledCategoryOnly: Boolean = False);
242 procedure BeginUpdate;
243 procedure EndUpdate;
244 procedure Update;
245 end;
246
247function AcronymComparer(Item1, Item2: Pointer): Integer;
248
249var
250 ImportVariableString: array [TImportVariable] of string;
251 ImportPatternFlagString: array [TImportPatternFlag] of string;
252
253procedure Translate;
254
255implementation
256
257resourcestring
258 SWrongFileFormat = 'Wrong file format';
259 SUnsupportedImportFormat = 'Unsupported import format';
260 SDescription = 'Description';
261 SMeaning = 'Meaning';
262 SAcronym = 'Acronym';
263 SCategory = 'Category';
264 SNone = 'None';
265 SNewItem = 'New item';
266 SSkip = 'Skip';
267 SRemoveOnStart = 'Remove on start';
268 SUnsupportedAuthMethod = 'Unsupported HTTP authorization method';
269 SFileNotFound = 'File %s not found';
270
271
272procedure Translate;
273begin
274 ImportVariableString[ivAcronym] := SAcronym;
275 ImportVariableString[ivNone] := SNone;
276 ImportVariableString[ivMeaning] := SMeaning;
277 ImportVariableString[ivDescription] := SDescription;
278 ImportVariableString[ivCategory] := SCategory;
279 ImportPatternFlagString[ipfSet] := SNone;
280 ImportPatternFlagString[ipfNewItem] := SNewItem;
281 ImportPatternFlagString[ipfSkip] := SSkip;
282 ImportPatternFlagString[ipfRemove] := SRemoveOnStart;
283end;
284
285function AcronymComparer(Item1, Item2: Pointer): Integer;
286begin
287 Result := CompareStr(TAcronym(Item1).Name, TAcronym(Item2).Name);
288end;
289
290function StripHTML(S: string): string;
291var
292 TagBegin, TagEnd, TagLength: Integer;
293begin
294 TagBegin := Pos( '<', S); // search position of first <
295
296 while (TagBegin > 0) do begin // while there is a < in S
297 TagEnd := Pos('>', S); // find the matching >
298 if TagEnd = 0 then TagLength := Length(S) - TagBegin
299 else TagLength := TagEnd - TagBegin + 1;
300 if TagLength > 0 then
301 Delete(S, TagBegin, TagLength) // delete the tag
302 else Delete(S, 1, TagEnd); // delete the tag
303 TagBegin := Pos( '<', S); // search for next <
304 end;
305
306 Result := S; // give the result
307end;
308
309{ TImportSourceMSAccess }
310
311procedure TImportSource.ProcessMSAccess;
312var
313 ODBCConnection1: TODBCConnection;
314 SQLTransaction1: TSQLTransaction;
315 SQLQuery1: TSQLQuery;
316 NewAcronym: TAcronymEntry;
317 AddedAcronym: TAcronymMeaning;
318begin
319 ItemCount := 0;
320 ODBCConnection1 := TODBCCOnnection.Create(nil);
321 SQLQuery1 := TSQLQuery.Create(nil);
322 SQLTransaction1 := TSQLTransaction.Create(nil);
323 try
324 ODBCConnection1.Driver := 'Microsoft Access Driver (*.mdb, *.accdb)';
325 ODBCConnection1.Params.Add('DBQ=' + URL);
326 ODBCConnection1.Params.Add('Locale Identifier=1031');
327 ODBCConnection1.Params.Add('ExtendedAnsiSQL=1');
328 ODBCConnection1.Params.Add('CHARSET=ansi');
329 ODBCConnection1.Connected := True;
330 ODBCConnection1.KeepConnection := True;
331
332 SQLTransaction1.DataBase := ODBCConnection1;
333 SQLTransaction1.Action := caCommit;
334 SQLTransaction1.Active := True;
335
336 SQLQuery1.DataBase := ODBCConnection1;
337 SQLQuery1.UsePrimaryKeyAsKey := False;
338 SQLQuery1.SQL.Text := 'SELECT Acronym,Meaning FROM data1';
339 SQLQuery1.Open;
340
341 NewAcronym := TAcronymEntry.Create;
342 while not SQLQuery1.EOF do begin
343 NewAcronym.Name := Trim(WinCPToUTF8(SQLQuery1.FieldByName('Acronym').AsString));
344 NewAcronym.Meaning := Trim(WinCPToUTF8(SQLQuery1.FieldByName('Meaning').AsString));
345 if (NewAcronym.Name <> '') and (NewAcronym.Meaning <> '') then begin
346 AddedAcronym := Sources.AcronymDb.AddAcronym(NewAcronym.Name, NewAcronym.Meaning);
347 AddedAcronym.MergeCategories(Categories);
348 if AddedAcronym.Sources.IndexOf(Self) = -1 then
349 AddedAcronym.Sources.Add(Self);
350 end;
351 SQLQuery1.Next;
352 Inc(ItemCount);
353 end;
354 NewAcronym.Free;
355 finally
356 SQLQuery1.Free;
357 SQLTransaction1.Free;
358 ODBCConnection1.Free;
359 end;
360end;
361
362{ TImportPatterns }
363
364procedure TImportPatterns.SaveToNode(Node: TDOMNode);
365var
366 I: Integer;
367 NewNode2: TDOMNode;
368begin
369 for I := 0 to Count - 1 do
370 with TImportPattern(Items[I]) do begin
371 NewNode2 := Node.OwnerDocument.CreateElement('Pattern');
372 Node.AppendChild(NewNode2);
373 SaveToNode(NewNode2);
374 end;
375end;
376
377procedure TImportPatterns.LoadFromNode(Node: TDOMNode);
378var
379 Node2: TDOMNode;
380 NewItem: TImportPattern;
381begin
382 Count := 0;
383 Node2 := Node.FirstChild;
384 while Assigned(Node2) and (Node2.NodeName = 'Pattern') do begin
385 NewItem := TImportPattern.Create;
386 NewItem.LoadFromNode(Node2);
387 Add(NewItem);
388 Node2 := Node2.NextSibling;
389 end;
390end;
391
392{ TImportPattern }
393
394procedure TImportPattern.Assign(Source: TImportPattern);
395begin
396 StartString := Source.StartString;
397 EndString := Source.EndString;
398 Variable := Source.Variable;
399 Flag := Source.Flag;
400 Repetition := Source.Repetition;
401end;
402
403procedure TImportPattern.SaveToNode(Node: TDOMNode);
404begin
405 WriteString(Node, 'StartString', StartString);
406 WriteString(Node, 'EndString', EndString);
407 WriteInteger(Node, 'Variable', Integer(Variable));
408 WriteInteger(Node, 'Flag', Integer(Flag));
409 WriteBoolean(Node, 'Repetition', Repetition);
410end;
411
412procedure TImportPattern.LoadFromNode(Node: TDOMNode);
413begin
414 StartString := ReadString(Node, 'StartString', '');
415 EndString := ReadString(Node, 'EndString', '');
416 Variable := TImportVariable(ReadInteger(Node, 'Variable', 0));
417 Flag := TImportPatternFlag(ReadInteger(Node, 'Flag', 0));
418 Repetition := ReadBoolean(Node, 'Repetition', False);
419end;
420
421procedure TImportSource.DoPassword(Sender: TObject; var RepeatRequest: Boolean);
422var
423 H: string;
424begin
425 with TFPHttpClient(Sender) do begin
426 H := GetHeader(ResponseHeaders, 'WWW-Authenticate');
427 if Pos(' ', H) > 0 then H := Copy(H, 1, Pos(' ', H) - 1);
428
429 if H <> 'Basic' then
430 raise Exception.Create(SUnsupportedAuthMethod);
431
432 if (Self.UserName <> '') and (UserName = '') then begin
433 UserName := Self.UserName;
434 Password := Self.Password;
435 ResponseStream.Clear;
436 RepeatRequest := True;
437 end else RepeatRequest := False;
438 end;
439end;
440
441procedure TImportSource.TextParse(S: string);
442var
443 SS: string;
444 NewAcronym: TAcronymEntry;
445 P: Integer;
446 P1, P2: Integer;
447 Q: Integer;
448 I: Integer;
449 T: string;
450 TT: string;
451 LastLength: Integer;
452 AddedAcronym: TAcronymMeaning;
453 NewCategory: TAcronymCategory;
454begin
455 NewAcronym := TAcronymEntry.Create;
456 try
457
458 // Find main block
459 if Format.Block.StartString <> '' then begin
460 P := Pos(Format.Block.StartString, S);
461 if P > 0 then
462 Delete(S, 1, P + Length(Format.Block.StartString) - 1);
463 end;
464 if Format.Block.EndString <> '' then begin
465 P := Pos(Format.Block.EndString, S);
466 if P > 0 then
467 Delete(S, P, Length(S));
468 end;
469
470 // Remove unneeded items
471 repeat
472 LastLength := Length(S);
473 for I := 0 to Format.ItemPatterns.Count - 1 do
474 with TImportPattern(Format.ItemPatterns[I]) do
475 if Flag = ipfRemove then begin
476 P := Pos(StartString, S);
477 if P > 0 then begin
478 SS := Copy(S, P + Length(StartString), Length(S));
479 Q := Pos(EndString, SS);
480 if Q > 0 then begin
481 Delete(S, P, Q + Length(EndString) + Length(StartString) - 1);
482 end;
483 end;
484 end;
485 until Length(S) = LastLength;
486
487 // Find items
488 repeat
489 LastLength := Length(S);
490 I := 0;
491 while I < Format.ItemPatterns.Count do
492 with TImportPattern(Format.ItemPatterns[I]) do begin
493 if Flag <> ipfRemove then begin
494 if Length(StartString) > 0 then begin
495 P := Pos(StartString, S);
496 if P > 0 then Delete(S, 1, P + Length(StartString) - 1);
497 end;
498
499 if ((Length(StartString) > 0) and (P > 0)) or (Length(StartString) = 0) then begin
500 P := Pos(EndString, S);
501 T := Copy(S, 1, P - 1);
502 if Flag <> ipfSkip then begin
503 T := StripHTML(T);
504 T := StringReplace(T, '&quot;', '"', [rfReplaceAll]);
505 T := StringReplace(T, '&trade;', 'TM', [rfReplaceAll]);
506 T := StringReplace(T, '&amp;', '&', [rfReplaceAll]);
507 T := StringReplace(T, '&#160;', ' ', [rfReplaceAll]); // Non-breaking space
508 T := StringReplace(T, #$C2#$A0, ' ', [rfReplaceAll]); // Non-breaking space
509 T := StringReplace(T, '&lt;', '<', [rfReplaceAll]);
510 T := StringReplace(T, '&gt;', '>', [rfReplaceAll]);
511 T := Trim(T);
512 case Variable of
513 ivAcronym: NewAcronym.Name := T;
514 ivMeaning: NewAcronym.Meaning := T;
515 ivDescription: NewAcronym.Description := T;
516 ivCategory: begin
517 NewAcronym.Categories.Clear;
518 while T <> '' do begin
519 if Pos(',', T) > 0 then begin
520 TT := Copy(T, 1, Pos(',', T) - 1);
521 Delete(T, 1, Length(TT) + 1);
522 end else begin
523 TT := T;
524 T := '';
525 end;
526 TT := Trim(TT);
527 NewCategory := Sources.AcronymDb.Categories.SearchByName(TT);
528 if not Assigned(NewCategory) then begin
529 NewCategory := TAcronymCategory.Create;
530 NewCategory.Name := TT;
531 Sources.AcronymDb.Categories.Add(NewCategory);
532 end;
533 NewAcronym.Categories.AddObject(TT, NewCategory);
534 end;
535 end;
536 end;
537 end;
538 Delete(S, 1, P + Length(EndString) - 1);
539
540 if (Flag = ipfNewItem) and (NewAcronym.Name <> '') and
541 (NewAcronym.Meaning <> '') then begin
542 AddedAcronym := Sources.AcronymDb.AddAcronym(NewAcronym.Name, NewAcronym.Meaning);
543 AddedAcronym.Description := NewAcronym.Description;
544 AddedAcronym.MergeCategories(Categories);
545 AddedAcronym.Categories.AddFromStrings(NewAcronym.Categories);
546 AddedAcronym.Categories.UpdateLinkAcronymMeanings(AddedAcronym);
547 if AddedAcronym.Sources.IndexOf(Self) = -1 then
548 AddedAcronym.Sources.Add(Self);
549
550 Inc(ItemCount);
551 end;
552
553 if Repetition then begin
554 if Length(StartString) > 0 then begin
555 P1 := Pos(StartString, S);
556 if P1 > 0 then begin
557 P2 := Pos(TImportPattern(Format.ItemPatterns[(I + 1) mod Format.ItemPatterns.Count]).StartString, S);
558 if (P2 > 0) and (P1 < P2) then Continue;
559 end;
560 end;
561 end;
562 end;
563 end;
564 Inc(I);
565 end;
566 until Length(S) = LastLength;
567 finally
568 NewAcronym.Free;
569 end;
570end;
571
572
573function TImportSource.DownloadHTTP(URL: string; Stream: TStream): Boolean;
574var
575 HTTPClient: TFPHTTPClient;
576 FormData: TStringList;
577begin
578 Result := False;
579 HTTPClient := TFPHttpClient.Create(nil);
580 HTTPClient.AllowRedirect := True;
581 HTTPClient.OnPassword := DoPassword;
582 FormData := TStringList.Create;
583 try
584 HTTPClient.Get(URL, Stream);
585 Result := True;
586 finally
587 FormData.Free;
588 HTTPClient.Free;
589 end;
590end;
591
592procedure TImportSources.AssignToList(List: TListObject);
593var
594 I: Integer;
595begin
596 List.Clear;
597 for I := 0 to Count - 1 do
598 List.Add(TImportSource(Items[I]))
599end;
600
601procedure TImportSource.Process;
602begin
603 ItemCount := 0;
604 case Format.Kind of
605 ifkParseURL: ProcessTextParseURL;
606 ifkMSAccess: ProcessMSAccess;
607 ifkParseFile: ProcessTextParseFile;
608 else raise Exception.Create(SUnsupportedImportFormat);
609 end;
610 LastImportTime := Now;
611end;
612
613
614{ TImportFormat }
615
616procedure TImportFormat.Assign(Source: TImportFormat);
617var
618 I: Integer;
619begin
620 Kind := Source.Kind;
621 Name := Source.Name;
622 Block.StartString := Source.Block.StartString;
623 Block.EndString := Source.Block.EndString;
624 while ItemPatterns.Count < Source.ItemPatterns.Count do
625 ItemPatterns.Add(TImportPattern.Create);
626 if ItemPatterns.Count > Source.ItemPatterns.Count then
627 ItemPatterns.Count := Source.ItemPatterns.Count;
628 for I := 0 to ItemPatterns.Count - 1 do begin
629 TImportPattern(ItemPatterns[I]).Assign(TImportPattern(Source.ItemPatterns[I]));
630 end;
631end;
632
633procedure TImportFormat.SaveToNode(Node: TDOMNode);
634var
635 NewNode: TDOMNode;
636begin
637 WriteInteger(Node, 'Id', Id);
638 WriteString(Node, 'Name', Name);
639 WriteInteger(Node, 'Kind', Integer(Kind));
640 WriteString(Node, 'BlockStartString', Block.StartString);
641 WriteString(Node, 'BlockEndString', Block.EndString);
642
643 NewNode := Node.OwnerDocument.CreateElement('Patterns');
644 Node.AppendChild(NewNode);
645 ItemPatterns.SaveToNode(NewNode);
646end;
647
648procedure TImportFormat.LoadFromNode(Node: TDOMNode);
649var
650 NewNode: TDOMNode;
651begin
652 Id := ReadInteger(Node, 'Id', 0);
653 Name := ReadString(Node, 'Name', '');
654 Kind := TImportFormatKind(ReadInteger(Node, 'Kind', 0));
655 Block.StartString := ReadString(Node, 'BlockStartString', '');
656 Block.EndString := ReadString(Node, 'BlockEndString', '');
657
658 NewNode := Node.FindNode('Patterns');
659 if Assigned(NewNode) then
660 ItemPatterns.LoadFromNode(NewNode);
661end;
662
663constructor TImportFormat.Create;
664begin
665 Block := TImportPattern.Create;
666 ItemPatterns := TImportPatterns.Create;
667end;
668
669destructor TImportFormat.Destroy;
670begin
671 Block.Free;
672 ItemPatterns.Free;
673 inherited Destroy;
674end;
675
676{ TImportSources }
677
678procedure TImportSources.UpdateIds;
679var
680 LastId: Integer;
681 I: Integer;
682begin
683 // Get highest used ID
684 LastId := 0;
685 for I := 0 to Count - 1 do begin
686 if TImportSource(Items[I]).Id > LastId then LastId := TImportSource(Items[I]).Id;
687 end;
688 // Add ID to new items without ID
689 for I := 0 to Count - 1 do begin
690 if TImportSource(Items[I]).Id = 0 then begin
691 Inc(LastId);
692 TImportSource(Items[I]).Id := LastId;
693 end;
694 end;
695end;
696
697function TImportSources.SearchById(Id: Integer): TImportSource;
698var
699 I: Integer;
700begin
701 I := 0;
702 while (I < Count) and (TImportSource(Items[I]).Id <> Id) do Inc(I);
703 if I < Count then Result := TImportSource(Items[I])
704 else Result := nil;
705end;
706
707procedure TImportSources.SaveRefToNode(Node: TDOMNode);
708var
709 I: Integer;
710 NewNode: TDOMNode;
711begin
712 for I := 0 to Count - 1 do begin
713 NewNode := Node.OwnerDocument.CreateElement('Ref');
714 Node.AppendChild(NewNode);
715 NewNode.TextContent := WideString(IntToStr(TImportSource(Items[I]).Id));
716 end;
717end;
718
719procedure TImportSources.LoadRefFromNode(Node: TDOMNode);
720var
721 Node2: TDOMNode;
722 Id: Integer;
723 Source: TImportSource;
724begin
725 Node2 := Node.FirstChild;
726 while Assigned(Node2) and (Node2.NodeName = 'Ref') do begin
727 if TryStrToInt(string(Node2.TextContent), Id) then begin
728 Source := AcronymDb.ImportSources.SearchById(Id);
729 if Assigned(Source) then begin
730 Add(Source);
731 end;
732 end;
733 Node2 := Node2.NextSibling;
734 end;
735end;
736
737procedure TImportSources.AssignToStrings(Strings: TStrings);
738var
739 I: Integer;
740begin
741 Strings.Clear;
742 for I := 0 to Count - 1 do
743 Strings.AddObject(TImportSource(Items[I]).Name, Items[I]);
744end;
745
746function TImportSources.SearchByName(Name: string): TImportSource;
747var
748 I: Integer;
749begin
750 I := 0;
751 while (I < Count) and (TImportSource(Items[I]).Name <> Name) do Inc(I);
752 if I < Count then Result := TImportSource(Items[I])
753 else Result := nil;
754end;
755
756procedure TImportSources.SaveToNode(Node: TDOMNode);
757var
758 I: Integer;
759 NewNode2: TDOMNode;
760begin
761 UpdateIds;
762 for I := 0 to Count - 1 do
763 with TImportSource(Items[I]) do begin
764 NewNode2 := Node.OwnerDocument.CreateElement('ImportSource');
765 Node.AppendChild(NewNode2);
766 SaveToNode(NewNode2);
767 end;
768end;
769
770procedure TImportSources.LoadFromNode(Node: TDOMNode);
771var
772 Node2: TDOMNode;
773 NewItem: TImportSource;
774begin
775 Count := 0;
776 Node2 := Node.FirstChild;
777 while Assigned(Node2) and (Node2.NodeName = 'ImportSource') do begin
778 NewItem := TImportSource.Create;
779 NewItem.Sources := Self;
780 NewItem.LoadFromNode(Node2);
781 Add(NewItem);
782 Node2 := Node2.NextSibling;
783 end;
784 UpdateIds;
785end;
786
787{ TImportFormats }
788
789function TImportFormats.SearchByName(Name: string): TImportFormat;
790var
791 I: Integer;
792begin
793 I := 0;
794 while (I < Count) and (TImportFormat(Items[I]).Name <> Name) do Inc(I);
795 if I < Count then Result := TImportFormat(Items[I])
796 else Result := nil;
797end;
798
799procedure TImportFormats.UpdateIds;
800var
801 LastId: Integer;
802 I: Integer;
803begin
804 // Get highest used ID
805 LastId := 0;
806 for I := 0 to Count - 1 do begin
807 if TImportFormat(Items[I]).Id > LastId then LastId := TImportFormat(Items[I]).Id;
808 end;
809 // Add ID to new items without ID
810 for I := 0 to Count - 1 do begin
811 if TImportFormat(Items[I]).Id = 0 then begin
812 Inc(LastId);
813 TImportFormat(Items[I]).Id := LastId;
814 end;
815 end;
816end;
817
818procedure TImportFormats.SaveToNode(Node: TDOMNode);
819var
820 I: Integer;
821 NewNode2: TDOMNode;
822begin
823 UpdateIds;
824 for I := 0 to Count - 1 do
825 with TImportFormat(Items[I]) do begin
826 NewNode2 := Node.OwnerDocument.CreateElement('ImportFormat');
827 Node.AppendChild(NewNode2);
828 SaveToNode(NewNode2);
829 end;
830end;
831
832procedure TImportFormats.LoadFromNode(Node: TDOMNode);
833var
834 Node2: TDOMNode;
835 NewItem: TImportFormat;
836begin
837 Count := 0;
838 Node2 := Node.FirstChild;
839 while Assigned(Node2) and (Node2.NodeName = 'ImportFormat') do begin
840 NewItem := TImportFormat.Create;
841 NewItem.LoadFromNode(Node2);
842 Add(NewItem);
843 Node2 := Node2.NextSibling;
844 end;
845 UpdateIds;
846end;
847
848function TImportFormats.SearchById(Id: Integer): TImportFormat;
849var
850 I: Integer;
851begin
852 I := 0;
853 while (I < Count) and (TImportFormat(Items[I]).Id <> Id) do Inc(I);
854 if I < Count then Result := TImportFormat(Items[I])
855 else Result := nil;
856end;
857
858{ TImportSource }
859
860procedure TImportSource.ProcessTextParseURL;
861var
862 S: string;
863begin
864 ResponseStream.Clear;
865 if DownloadHTTP(URL, ResponseStream) then begin
866 ResponseStream.Position := 0;
867 SetLength(S, ResponseStream.Size);
868 ResponseStream.Read(S[1], Length(S));
869
870 TextParse(S);
871 end;
872end;
873
874procedure TImportSource.ProcessTextParseFile;
875var
876 S: TStringList;
877begin
878 if FileExists(URL) then begin
879 S := TStringList.Create;
880 try
881 S.LoadFromFile(URL);
882 TextParse(S.Text);
883 finally
884 S.Free;
885 end;
886 end else ShowMessage(SysUtils.Format(SFileNotFound, [URL]));
887end;
888
889procedure TImportSource.Assign(Source: TImportSource);
890begin
891 Enabled := Source.Enabled;
892 Name := Source.Name;
893 URL := Source.URL;
894 Format := Source.Format;
895 ItemCount := Source.ItemCount;
896 Categories.Assign(Source.Categories);
897 UserName := Source.UserName;
898 Password := Source.Password;
899 LastImportTime := Source.LastImportTime;
900end;
901
902procedure TImportSource.SaveToNode(Node: TDOMNode);
903var
904 NewNode: TDOMNode;
905begin
906 WriteString(Node, 'Name', Name);
907 WriteString(Node, 'URL', URL);
908 if Assigned(Format) then WriteInteger(Node, 'ImportFormat', Format.Id)
909 else WriteInteger(Node, 'ImportFormat', -1);
910 WriteBoolean(Node, 'Enabled', Enabled);
911 WriteInteger(Node, 'ItemCount', ItemCount);
912 WriteDateTime(Node, 'LastImportTime', LastImportTime);
913 WriteString(Node, 'UserName', UserName);
914
915 NewNode := Node.OwnerDocument.CreateElement('Categories');
916 Node.AppendChild(NewNode);
917 Categories.SaveRefToNode(NewNode);
918end;
919
920procedure TImportSource.LoadFromNode(Node: TDOMNode);
921var
922 Node2: TDOMNode;
923 I: Integer;
924begin
925 Name := ReadString(Node, 'Name', '');
926 URL := ReadString(Node, 'URL', '');
927 Format := Sources.AcronymDb.ImportFormats.SearchById(ReadInteger(Node, 'ImportFormat', -1));
928 Enabled := ReadBoolean(Node, 'Enabled', True);
929 ItemCount := ReadInteger(Node, 'ItemCount', 0);
930 UserName := ReadString(Node, 'UserName', '');
931 LastImportTime := ReadDateTime(Node, 'LastImportTime', 0);
932
933 Categories.Db := Sources.AcronymDb;
934 Node2 := Node.FindNode('Categories');
935 if Assigned(Node2) then
936 Categories.LoadRefFromNode(Node2);
937
938 // Add reverse references
939 for I := 0 to Categories.Count - 1 do
940 TAcronymCategory(Categories[I]).ImportSources.Add(Self);
941end;
942
943constructor TImportSource.Create;
944begin
945 Format := nil;
946 Enabled := True;
947 Categories := TAcronymCategories.Create;
948 Categories.OwnsObjects := False;
949 ResponseStream := TMemoryStream.Create;
950end;
951
952destructor TImportSource.Destroy;
953var
954 I: Integer;
955begin
956 for I := 0 to Categories.Count - 1 do
957 TAcronymCategory(Categories[I]).ImportSources.Remove(Self);
958 FreeAndNil(Categories);
959 FreeAndNil(ResponseStream);
960 inherited Destroy;
961end;
962
963{ TAcronymEntry }
964
965constructor TAcronymEntry.Create;
966begin
967 Categories := TStringList.Create;
968 Sources := TStringList.Create;
969 Name := '';
970 Meaning := '';
971 Description := '';
972end;
973
974destructor TAcronymEntry.Destroy;
975begin
976 FreeAndNil(Categories);
977 FreeAndNil(Sources);
978 inherited Destroy;
979end;
980
981{ TAcronymMeanings }
982
983procedure TAcronymMeanings.UpdateIds;
984var
985 LastId: Integer;
986 I: Integer;
987begin
988 // Get highest used ID
989 LastId := 0;
990 for I := 0 to Count - 1 do begin
991 if TAcronymMeaning(Items[I]).Id > LastId then LastId := TAcronymMeaning(Items[I]).Id;
992 end;
993 // Add ID to new items without ID
994 for I := 0 to Count - 1 do begin
995 if TAcronymMeaning(Items[I]).Id = 0 then begin
996 Inc(LastId);
997 TAcronymMeaning(Items[I]).Id := LastId;
998 end;
999 end;
1000end;
1001
1002procedure TAcronymMeanings.SaveToNode(Node: TDOMNode);
1003var
1004 I: Integer;
1005 NewNode2: TDOMNode;
1006begin
1007 UpdateIds;
1008 for I := 0 to Count - 1 do
1009 with TAcronymMeaning(Items[I]) do begin
1010 NewNode2 := Node.OwnerDocument.CreateElement('Meaning');
1011 Node.AppendChild(NewNode2);
1012 SaveToNode(NewNode2);
1013 end;
1014end;
1015
1016procedure TAcronymMeanings.LoadFromNode(Node: TDOMNode);
1017var
1018 Node2: TDOMNode;
1019 NewItem: TAcronymMeaning;
1020begin
1021 Count := 0;
1022 Node2 := Node.FirstChild;
1023 while Assigned(Node2) and (Node2.NodeName = 'Meaning') do begin
1024 NewItem := TAcronymMeaning.Create;
1025 NewItem.Acronym := Acronym;
1026 NewItem.LoadFromNode(Node2);
1027 Add(NewItem);
1028 Node2 := Node2.NextSibling;
1029 end;
1030 UpdateIds;
1031end;
1032
1033function TAcronymMeanings.SearchByName(Name: string): TAcronymMeaning;
1034var
1035 I: Integer;
1036begin
1037 I := 0;
1038 while (I < Count) and (TAcronymMeaning(Items[I]).Name <> Name) do Inc(I);
1039 if I < Count then Result := TAcronymMeaning(Items[I])
1040 else Result := nil;
1041end;
1042
1043function TAcronymMeanings.AddMeaning(Name: string): TAcronymMeaning;
1044begin
1045 Result := TAcronymMeaning.Create;
1046 Result.Name := Name;
1047 Add(Result);
1048end;
1049
1050{ TAcronymMeaning }
1051
1052procedure TAcronymMeaning.MergeCategories(MergedCategories: TAcronymCategories);
1053var
1054 I: Integer;
1055begin
1056 for I := 0 to MergedCategories.Count - 1 do
1057 if Categories.IndexOf(MergedCategories[I]) = -1 then begin
1058 Categories.Add(MergedCategories[I]);
1059 TAcronymCategory(MergedCategories[I]).AcronymMeanings.Add(Self);
1060 end;
1061end;
1062
1063procedure TAcronymMeaning.SaveToNode(Node: TDOMNode);
1064var
1065 NewNode: TDOMNode;
1066begin
1067 WriteString(Node, 'Name', Name);
1068 WriteString(Node, 'Description', Description);
1069 WriteString(Node, 'Language', Language);
1070
1071 NewNode := Node.OwnerDocument.CreateElement('Categories');
1072 Node.AppendChild(NewNode);
1073 Categories.SaveRefToNode(NewNode);
1074
1075 NewNode := Node.OwnerDocument.CreateElement('Sources');
1076 Node.AppendChild(NewNode);
1077 Sources.SaveRefToNode(NewNode);
1078end;
1079
1080procedure TAcronymMeaning.LoadFromNode(Node: TDOMNode);
1081var
1082 Node2: TDOMNode;
1083 I: Integer;
1084begin
1085 Name := ReadString(Node, 'Name', '');
1086 Description := ReadString(Node, 'Description', '');
1087 Language := ReadString(Node, 'Language', '');
1088
1089 Categories.Db := Acronym.Db;
1090 Node2 := Node.FindNode('Categories');
1091 if Assigned(Node2) then begin
1092 Categories.LoadRefFromNode(Node2);
1093
1094 // Add reverse references
1095 for I := 0 to Categories.Count - 1 do
1096 TAcronymCategory(Categories[I]).AcronymMeanings.Add(Self);
1097 end;
1098
1099 Sources.AcronymDb := Acronym.Db;
1100 Node2 := Node.FindNode('Sources');
1101 if Assigned(Node2) then begin
1102 Sources.LoadRefFromNode(Node2);
1103 end;
1104end;
1105
1106constructor TAcronymMeaning.Create;
1107begin
1108 Categories := TAcronymCategories.Create(False);
1109 Sources := TImportSources.Create(False);
1110end;
1111
1112destructor TAcronymMeaning.Destroy;
1113var
1114 I: Integer;
1115begin
1116 for I := 0 to Categories.Count - 1 do
1117 TAcronymCategory(Categories[I]).AcronymMeanings.Remove(Self);
1118 FreeAndNil(Categories);
1119 FreeAndNil(Sources);
1120 inherited Destroy;
1121end;
1122
1123{ TAcronyms }
1124
1125procedure TAcronyms.SaveToNode(Node: TDOMNode);
1126var
1127 I: Integer;
1128 NewNode2: TDOMNode;
1129begin
1130 for I := 0 to Count - 1 do
1131 with TAcronym(Items[I]) do begin
1132 NewNode2 := Node.OwnerDocument.CreateElement('Acronym');
1133 Node.AppendChild(NewNode2);
1134 SaveToNode(NewNode2);
1135 end;
1136end;
1137
1138procedure TAcronyms.LoadFromNode(Node: TDOMNode);
1139var
1140 Node2: TDOMNode;
1141 NewItem: TAcronym;
1142begin
1143 Count := 0;
1144 Node2 := Node.FirstChild;
1145 while Assigned(Node2) and (Node2.NodeName = 'Acronym') do begin
1146 NewItem := TAcronym.Create;
1147 NewItem.Db := Db;
1148 NewItem.LoadFromNode(Node2);
1149 Add(NewItem);
1150 Node2 := Node2.NextSibling;
1151 end;
1152end;
1153
1154function TAcronyms.SearchByName(Name: string): TAcronym;
1155var
1156 I: Integer;
1157begin
1158 I := 0;
1159 while (I < Count) and (TAcronym(Items[I]).Name <> Name) do Inc(I);
1160 if I < Count then Result := TAcronym(Items[I])
1161 else Result := nil;
1162end;
1163
1164function TAcronyms.AddAcronym(Name: string): TAcronym;
1165begin
1166 Result := TAcronym.Create;
1167 Result.Name := Name;
1168 Add(Result);
1169end;
1170
1171{ TAcronymCategories }
1172
1173procedure TAcronymCategories.UpdateIds;
1174var
1175 LastId: Integer;
1176 I: Integer;
1177begin
1178 // Get highest used ID
1179 LastId := 0;
1180 for I := 0 to Count - 1 do begin
1181 if TAcronymCategory(Items[I]).Id > LastId then LastId := TAcronymCategory(Items[I]).Id;
1182 end;
1183 // Add ID to new items without ID
1184 for I := 0 to Count - 1 do begin
1185 if TAcronymCategory(Items[I]).Id = 0 then begin
1186 Inc(LastId);
1187 TAcronymCategory(Items[I]).Id := LastId;
1188 end;
1189 end;
1190end;
1191
1192procedure TAcronymCategories.SaveToNode(Node: TDOMNode);
1193var
1194 I: Integer;
1195 NewNode2: TDOMNode;
1196begin
1197 UpdateIds;
1198 for I := 0 to Count - 1 do
1199 with TAcronymCategory(Items[I]) do begin
1200 NewNode2 := Node.OwnerDocument.CreateElement('Category');
1201 Node.AppendChild(NewNode2);
1202 SaveToNode(NewNode2);
1203 end;
1204end;
1205
1206procedure TAcronymCategories.LoadFromNode(Node: TDOMNode);
1207var
1208 Node2: TDOMNode;
1209 NewItem: TAcronymCategory;
1210begin
1211 Count := 0;
1212 Node2 := Node.FirstChild;
1213 while Assigned(Node2) and (Node2.NodeName = 'Category') do begin
1214 NewItem := TAcronymCategory.Create;
1215 NewItem.LoadFromNode(Node2);
1216 Add(NewItem);
1217 Node2 := Node2.NextSibling;
1218 end;
1219 UpdateIds;
1220end;
1221
1222procedure TAcronymCategories.SaveRefToNode(Node: TDOMNode);
1223var
1224 I: Integer;
1225 NewNode: TDOMNode;
1226begin
1227 for I := 0 to Count - 1 do begin
1228 NewNode := Node.OwnerDocument.CreateElement('Ref');
1229 Node.AppendChild(NewNode);
1230 NewNode.TextContent := WideString(IntToStr(TAcronymCategory(Items[I]).Id));
1231 end;
1232end;
1233
1234procedure TAcronymCategories.LoadRefFromNode(Node: TDOMNode);
1235var
1236 Node2: TDOMNode;
1237 Id: Integer;
1238 Category: TAcronymCategory;
1239begin
1240 Node2 := Node.FirstChild;
1241 while Assigned(Node2) and (Node2.NodeName = 'Ref') do begin
1242 if TryStrToInt(string(Node2.TextContent), Id) then begin
1243 Category := Db.Categories.SearchById(Id);
1244 if Assigned(Category) then begin
1245 Add(Category);
1246 end;
1247 end;
1248 Node2 := Node2.NextSibling;
1249 end;
1250
1251 // Old way to store ref Id, remove in future
1252 Node2 := Node.FirstChild;
1253 while Assigned(Node2) and (Node2.NodeName = 'Category') do begin
1254 Id := ReadInteger(Node2, 'Id', 0);
1255 Category := Db.Categories.SearchById(Id);
1256 if Assigned(Category) then begin
1257 Add(Category);
1258 end;
1259 Node2 := Node2.NextSibling;
1260 end;
1261end;
1262
1263function TAcronymCategories.SearchByName(Name: string): TAcronymCategory;
1264var
1265 I: Integer;
1266begin
1267 I := 0;
1268 while (I < Count) and (TAcronymCategory(Items[I]).Name <> Name) do Inc(I);
1269 if I < Count then Result := TAcronymCategory(Items[I])
1270 else Result := nil;
1271end;
1272
1273function TAcronymCategories.SearchById(Id: Integer): TAcronymCategory;
1274var
1275 I: Integer;
1276begin
1277 I := 0;
1278 while (I < Count) and (TAcronymCategory(Items[I]).Id <> Id) do Inc(I);
1279 if I < Count then Result := TAcronymCategory(Items[I])
1280 else Result := nil;
1281end;
1282
1283function TAcronymCategories.AddContext(Name: string): TAcronymCategory;
1284begin
1285 Result := TAcronymCategory.Create;
1286 Result.Name := Name;
1287 Add(Result);
1288end;
1289
1290procedure TAcronymCategories.AssignToStrings(Strings: TStrings);
1291var
1292 I: Integer;
1293begin
1294 Strings.Clear;
1295 for I := 0 to Count - 1 do
1296 Strings.AddObject(TAcronymCategory(Items[I]).Name, Items[I]);
1297end;
1298
1299procedure TAcronymCategories.AssignFromStrings(Strings: TStrings);
1300begin
1301 Clear;
1302 AddFromStrings(Strings);
1303end;
1304
1305procedure TAcronymCategories.AddFromStrings(Strings: TStrings);
1306var
1307 I: Integer;
1308begin
1309 for I := 0 to Strings.Count - 1 do begin
1310 Add(TAcronymCategory(Strings.Objects[I]));
1311 end;
1312end;
1313
1314procedure TAcronymCategories.AssignToList(List: TListObject);
1315var
1316 I: Integer;
1317begin
1318 List.Clear;
1319 for I := 0 to Count - 1 do
1320 List.Add(TAcronymCategory(Items[I]))
1321end;
1322
1323function TAcronymCategories.GetString: string;
1324var
1325 I: Integer;
1326begin
1327 Result := '';
1328 for I := 0 to Count - 1 do
1329 Result := Result + TAcronymCategory(Items[I]).Name + ',';
1330 System.Delete(Result, Length(Result), 1);
1331end;
1332
1333procedure TAcronymCategories.UpdateLinkImportSources(Item: TImportSource);
1334var
1335 I: Integer;
1336begin
1337 for I := 0 to Count - 1 do
1338 if TAcronymCategory(Items[I]).ImportSources.IndexOf(Item) = -1 then
1339 TAcronymCategory(Items[I]).ImportSources.Add(Item);
1340end;
1341
1342procedure TAcronymCategories.UpdateLinkAcronymMeanings(Item: TAcronymMeaning);
1343var
1344 I: Integer;
1345begin
1346 for I := 0 to Count - 1 do
1347 if TAcronymCategory(Items[I]).AcronymMeanings.IndexOf(Item) = -1 then
1348 TAcronymCategory(Items[I]).AcronymMeanings.Add(Item);
1349end;
1350
1351function TAcronymCategories.IsAnyEnabled: Boolean;
1352var
1353 I: Integer;
1354begin
1355 Result := False;
1356 for I := 0 to Count - 1 do
1357 if TAcronymCategory(Items[I]).Enabled then begin
1358 Result := True;
1359 Break;
1360 end;
1361end;
1362
1363{ TAcronym }
1364
1365procedure TAcronym.SaveToNode(Node: TDOMNode);
1366var
1367 NewNode: TDOMNode;
1368begin
1369 WriteString(Node, 'Name', Name);
1370
1371 NewNode := Node.OwnerDocument.CreateElement('Meanings');
1372 Node.AppendChild(NewNode);
1373 Meanings.SaveToNode(NewNode);
1374end;
1375
1376procedure TAcronym.LoadFromNode(Node: TDOMNode);
1377var
1378 NewNode: TDOMNode;
1379begin
1380 Name := ReadString(Node, 'Name', '');
1381
1382 NewNode := Node.FindNode('Meanings');
1383 if Assigned(NewNode) then
1384 Meanings.LoadFromNode(NewNode);
1385end;
1386
1387constructor TAcronym.Create;
1388begin
1389 Meanings := TAcronymMeanings.Create;
1390 Meanings.Acronym := Self;
1391end;
1392
1393destructor TAcronym.Destroy;
1394begin
1395 FreeAndNil(Meanings);
1396 inherited Destroy;
1397end;
1398
1399{ TAcronymCategory }
1400
1401procedure TAcronymCategory.SaveToNode(Node: TDOMNode);
1402begin
1403 WriteString(Node, 'Name', Name);
1404 WriteInteger(Node, 'Id', Id);
1405 WriteBoolean(Node, 'Enabled', Enabled);
1406end;
1407
1408procedure TAcronymCategory.LoadFromNode(Node: TDOMNode);
1409begin
1410 Name := ReadString(Node, 'Name', '');
1411 Id := ReadInteger(Node, 'Id', 0);
1412 Enabled := ReadBoolean(Node, 'Enabled', True);
1413end;
1414
1415constructor TAcronymCategory.Create;
1416begin
1417 Id := 0;
1418 Name := '';
1419 Enabled := True;
1420 AcronymMeanings := TAcronymMeanings.Create(False);
1421 ImportSources := TImportSources.Create(False);
1422end;
1423
1424destructor TAcronymCategory.Destroy;
1425var
1426 I: Integer;
1427begin
1428 for I := 0 to AcronymMeanings.Count - 1 do
1429 TAcronymMeaning(AcronymMeanings[I]).Categories.Remove(Self);
1430 FreeAndNil(AcronymMeanings);
1431 for I := 0 to ImportSources.Count - 1 do
1432 TImportSource(ImportSources[I]).Categories.Remove(Self);
1433 FreeAndNil(ImportSources);
1434 inherited Destroy;
1435end;
1436
1437{ TAcronymDb }
1438
1439constructor TAcronymDb.Create;
1440begin
1441 Acronyms := TAcronyms.Create;
1442 Acronyms.Db := Self;
1443 Categories := TAcronymCategories.Create;
1444 Categories.Db := Self;
1445 ImportSources := TImportSources.Create;
1446 ImportSources.AcronymDb := Self;
1447 ImportFormats := TImportFormats.Create;
1448 FUpdateCount := 0;
1449 OnUpdate := TFPGList<TNotifyEvent>.Create;
1450end;
1451
1452destructor TAcronymDb.Destroy;
1453begin
1454 FreeAndNil(OnUpdate);
1455 FreeAndNil(ImportFormats);
1456 FreeAndNil(ImportSources);
1457 FreeAndNil(Acronyms);
1458 FreeAndNil(Categories);
1459 inherited Destroy;
1460end;
1461
1462procedure TAcronymDb.LoadFromFile(FileName: string);
1463var
1464 NewNode: TDOMNode;
1465 Doc: TXMLDocument;
1466 RootNode: TDOMNode;
1467begin
1468 if ExtractFileExt(FileName) = '.csv' then begin
1469 LoadFromFileCSV(FileName);
1470 Exit;
1471 end;
1472 Self.FileName := FileName;
1473 ReadXMLFile(Doc, FileName);
1474 with Doc do try
1475 if Doc.DocumentElement.NodeName <> 'AcronymDecoderProject' then
1476 raise Exception.Create(SWrongFileFormat);
1477 RootNode := Doc.DocumentElement;
1478 with RootNode do begin
1479 NewNode := FindNode('Categories');
1480 if Assigned(NewNode) then
1481 Categories.LoadFromNode(NewNode);
1482
1483 NewNode := FindNode('ImportFormats');
1484 if Assigned(NewNode) then
1485 ImportFormats.LoadFromNode(NewNode);
1486
1487 NewNode := FindNode('ImportSources');
1488 if Assigned(NewNode) then
1489 ImportSources.LoadFromNode(NewNode);
1490
1491 // Load acronyms after categories and import formats and sources because of references
1492 NewNode := FindNode('Acronyms');
1493 if Assigned(NewNode) then
1494 Acronyms.LoadFromNode(NewNode);
1495 end;
1496 finally
1497 Doc.Free;
1498 end;
1499end;
1500
1501procedure TAcronymDb.SaveToFile(FileName: string);
1502var
1503 NewNode: TDOMNode;
1504 Doc: TXMLDocument;
1505 RootNode: TDOMNode;
1506begin
1507 if ExtractFileExt(FileName) = '.csv' then begin
1508 SaveToFileCSV(FileName);
1509 Exit;
1510 end;
1511 Self.FileName := FileName;
1512 Doc := TXMLDocument.Create;
1513 with Doc do try
1514 RootNode := CreateElement('AcronymDecoderProject');
1515 AppendChild(RootNode);
1516 with RootNode do begin
1517 NewNode := OwnerDocument.CreateElement('Categories');
1518 AppendChild(NewNode);
1519 Categories.SaveToNode(NewNode);
1520
1521 NewNode := OwnerDocument.CreateElement('ImportFormats');
1522 AppendChild(NewNode);
1523 ImportFormats.SaveToNode(NewNode);
1524
1525 NewNode := OwnerDocument.CreateElement('ImportSources');
1526 AppendChild(NewNode);
1527 ImportSources.SaveToNode(NewNode);
1528
1529 // Save acronyms after categories, import formats and sources because of references
1530 NewNode := OwnerDocument.CreateElement('Acronyms');
1531 AppendChild(NewNode);
1532 Acronyms.SaveToNode(NewNode);
1533 end;
1534 ForceDirectories(ExtractFileDir(FileName));
1535 WriteXMLFile(Doc, FileName);
1536 finally
1537 Doc.Free;
1538 end;
1539 Modified := False;
1540end;
1541
1542procedure TAcronymDb.LoadFromFileCSV(FileName: string);
1543var
1544 F: TStringList;
1545 Line: TStringList;
1546 CategoryStrings: TStringList;
1547 NewAcronym: TAcronym;
1548 NewMeaning: TAcronymMeaning;
1549 I: Integer;
1550 J: Integer;
1551 AcronymCategory: TAcronymCategory;
1552begin
1553 Self.FileName := FileName;
1554 Acronyms.Clear;
1555 F := TStringList.Create;
1556 Line := TStringList.Create;
1557 Line.StrictDelimiter := True;
1558 CategoryStrings := TStringList.Create;
1559 CategoryStrings.Delimiter := ';';
1560 try
1561 F.LoadFromFile(FileName);
1562 for I := 0 to F.Count - 1 do begin
1563 Line.CommaText := F[I];
1564 NewAcronym := Acronyms.SearchByName(Line[0]);
1565 if not Assigned(NewAcronym) then begin
1566 NewAcronym := TAcronym.Create;
1567 NewAcronym.Name := Line[0];
1568 Acronyms.Add(NewAcronym);
1569 end;
1570 NewMeaning := NewAcronym.Meanings.SearchByName(Line[1]);
1571 if not Assigned(NewMeaning) then begin
1572 NewMeaning := TAcronymMeaning.Create;
1573 NewMeaning.Name := Line[1];
1574 NewMeaning.Acronym := NewAcronym;
1575 NewAcronym.Meanings.Add(NewMeaning);
1576 end;
1577 CategoryStrings.DelimitedText := Line[2];
1578 for J := 0 to CategoryStrings.Count - 1 do begin
1579 AcronymCategory := Categories.SearchByName(CategoryStrings[J]);
1580 if not Assigned(AcronymCategory) then begin
1581 AcronymCategory := TAcronymCategory.Create;
1582 AcronymCategory.Name := CategoryStrings[J];
1583 Categories.Add(AcronymCategory);
1584 end;
1585 NewMeaning.Categories.Add(AcronymCategory);
1586 AcronymCategory.AcronymMeanings.Add(NewMeaning);
1587 end;
1588 end;
1589 finally
1590 F.Free;
1591 Line.Free;
1592 CategoryStrings.Free;
1593 end;
1594 Modified := False;
1595end;
1596
1597procedure TAcronymDb.SaveToFileCSV(FileName: string);
1598var
1599 I: Integer;
1600 J: Integer;
1601 K: Integer;
1602 F: TStringList;
1603 Line: TStringList;
1604 Context: TStringList;
1605begin
1606 Self.FileName := FileName;
1607 F := TStringList.Create;
1608 Line := TStringList.Create;
1609 Line.StrictDelimiter := True;
1610 Context := TStringList.Create;
1611 Context.Delimiter := ';';
1612 try
1613 Line.Clear;
1614 for I := 0 to Acronyms.Count - 1 do
1615 with TAcronym(Acronyms[I]) do begin
1616 for K := 0 to Meanings.Count - 1 do
1617 with TAcronymMeaning(Meanings[K]) do begin
1618 Line.Clear;
1619 Line.Add(Acronym.Name);
1620 Line.Add(Name);
1621 Context.Clear;
1622 for J := 0 to Categories.Count - 1 do
1623 Context.Add(TAcronymCategory(Categories[J]).Name);
1624 Line.Add(Context.DelimitedText);
1625 F.Add(Line.CommaText);
1626 end;
1627 end;
1628 F.SaveToFile(FileName);
1629 finally
1630 F.Free;
1631 Line.Free;
1632 Context.Free;
1633 end;
1634 Modified := False;
1635end;
1636
1637procedure TAcronymDb.FilterList(AName: string; Items: TAcronymMeanings);
1638var
1639 I: Integer;
1640 J: Integer;
1641begin
1642 AName := LowerCase(AName);
1643 Items.Clear;
1644 for I := 0 to Acronyms.Count - 1 do
1645 with TAcronym(Acronyms[I]) do begin
1646 for J := 0 to Meanings.Count - 1 do
1647 with TAcronymMeaning(Meanings[J]) do begin
1648 if (AName = '') or (Pos(AName, LowerCase(TAcronym(Acronyms[I]).Name)) > 0)
1649 or (Pos(AName, LowerCase(Name)) > 0) then Items.Add(TAcronymMeaning(Meanings[J]))
1650 end;
1651 end;
1652end;
1653
1654function TAcronymDb.GetMeaningsCount: Integer;
1655var
1656 I: Integer;
1657begin
1658 Result := 0;
1659 for I := 0 to Acronyms.Count - 1 do
1660 Result := Result + TAcronym(Acronyms[I]).Meanings.Count;
1661end;
1662
1663function TAcronymDb.AddAcronym(AcronymName, MeaningName: string): TAcronymMeaning;
1664var
1665 Acronym: TAcronym;
1666 Meaning: TAcronymMeaning;
1667begin
1668 Acronym := Acronyms.SearchByName(AcronymName);
1669 if not Assigned(Acronym) then begin
1670 Acronym := TAcronym.Create;
1671 Acronym.Name := AcronymName;
1672 Acronyms.Add(Acronym);
1673 end;
1674 Meaning := Acronym.Meanings.SearchByName(MeaningName);
1675 if not Assigned(Meaning) then begin
1676 Meaning := TAcronymMeaning.Create;
1677 Meaning.Name := MeaningName;
1678 Meaning.Acronym := Acronym;
1679 Acronym.Meanings.Add(Meaning);
1680 Inc(AddedCount);
1681 end;
1682 Result := Meaning;
1683 Modified := True;
1684end;
1685
1686procedure TAcronymDb.RemoveMeaning(Meaning: TAcronymMeaning);
1687var
1688 Acronym: TAcronym;
1689begin
1690 Acronym := Meaning.Acronym;
1691 Acronym.Meanings.Remove(Meaning);
1692 if Acronym.Meanings.Count = 0 then
1693 Acronyms.Remove(Acronym);
1694 Modified := True;
1695end;
1696
1697procedure TAcronymDb.RemoveAcronym(AcronymName, MeaningName: string);
1698var
1699 Acronym: TAcronym;
1700 Meaning: TAcronymMeaning;
1701begin
1702 Acronym := Acronyms.SearchByName(AcronymName);
1703 if Assigned(Acronym) then begin
1704 Meaning := Acronym.Meanings.SearchByName(MeaningName);
1705 if Assigned(Meaning) then RemoveMeaning(Meaning);
1706 end;
1707end;
1708
1709procedure TAcronymDb.AssignToList(List: TListObject; EnabledCategoryOnly: Boolean = False);
1710var
1711 I: Integer;
1712 J: Integer;
1713begin
1714 List.Clear;
1715 for I := 0 to Acronyms.Count - 1 do
1716 with TAcronym(Acronyms[I]) do begin
1717 for J := 0 to Meanings.Count - 1 do
1718 with TAcronymMeaning(Meanings[J]) do
1719 if not EnabledCategoryOnly or (EnabledCategoryOnly and Categories.IsAnyEnabled) then begin
1720 List.Add(TAcronymMeaning(Meanings[J]));
1721 end;
1722 end;
1723end;
1724
1725procedure TAcronymDb.BeginUpdate;
1726begin
1727 Inc(FUpdateCount);
1728end;
1729
1730procedure TAcronymDb.EndUpdate;
1731begin
1732 if FUpdateCount > 0 then Dec(FUpdateCount);
1733 if FupdateCount = 0 then Update;
1734end;
1735
1736procedure TAcronymDb.Update;
1737var
1738 I: Integer;
1739begin
1740 for I := 0 to OnUpdate.Count - 1 do
1741 OnUpdate[I](Self);
1742end;
1743
1744end.
1745
Note: See TracBrowser for help on using the repository browser.