source: trunk/Acronym.pas

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