source: tags/1.3.0/UAcronym.pas

Last change on this file was 89, checked in by chronos, 8 years ago
  • Added: Show from which imports acronym meanings comes from.

This would easy correcting wrong acronyms directly in source.

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