source: trunk/Acronym.pas@ 230

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