source: trunk/UAcronym.pas

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