source: tags/1.5.0/UAcronym.pas

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