source: trunk/Acronym.pas

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