OSDN Git Service

- 正しくファイル名がセットされないバグを修正。
[gikonavigoeson/gikonavi.git] / AbonUnit.pas
1 unit AbonUnit;
2
3 interface
4 uses
5     Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6
7 type
8         TIndiviAbon = class( TObject )
9         private
10                 FRes: Integer;
11                 FOption: Integer; // 0:\93§\96¾ 1:\92Ê\8fí\82 \82Ú\81[\82ñ
12         public
13                 property Res            : Integer read FRes                     write FRes;
14                 property Option : Integer       read FOption    write FOption;
15         end;
16
17         TIndiviAbonList = class( TList )
18         private
19                 FFilePath       : string;               //!< \83t\83@\83C\83\8b\83p\83X
20                 FLearned        : Integer;      //!< \83X\83p\83\80\8aw\8fK\8dÏ\82Ý\83\8c\83X No
21
22                 function GetItem( index : Integer ) : TIndiviAbon;
23                 procedure SetItem( index : Integer; value : TIndiviAbon );
24
25         public
26                 destructor Destroy; override;
27
28                 property Items[ index : Integer ] : TIndiviAbon
29                         read GetItem write SetItem; default;
30                 procedure Sort; overload;
31                 procedure LoadFromFile( const filePath : string );
32                 procedure Save;
33         end;
34
35   TAbon = class(TObject)
36   private
37                 { Private \90é\8c¾ }
38                 Froot : String;
39     Flistpath : String;
40     FNGwordpath : String;
41     Ftokens : array of array of string;
42                 FAbonRes : TIndiviAbonList;
43                 FAbonString : String;
44         FDeleterlo : Boolean; //&rlo;\82ð\8dí\82é\82© //\92Ç\89Á&lro;\82à\8dí\82é
45     FReplaceul :Boolean ; //<ul>\83^\83O\82ð<br>\83^\83O\82É\92u\8a·\82·\82é\82©
46     FReverse : Boolean ;  //NG\83\8f\81[\83h\82Å\82Ì\82 \82Ú\81`\82ñ\82Ì\8c\8b\89Ê\82ð\94½\93]\82³\82¹\82é\82©
47     FAbonPopupRes : Boolean; //\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8e\9e\82É\82 \82Ú\81[\82ñ\82·\82é\82©
48         FNGwordFileIndex : Integer; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82ªlist\82Ì\89½\8ds\96Ú\82©
49     FNGwordname : String; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82Ì\95\\8e¦\96¼
50     FIndividualFileName : String;       //\8cÂ\95Ê\82 \82Ú\81`\82ñ\82Ì\83t\83@\83C\83\8b\96¼
51     FReturnNGwordLineNum : Boolean;     //NG\83\8f\81[\83h\82Ì\8ds\90\94\82ð\95Ô\82·\81B
52     FSetNGResAnchor : Boolean; //NG\82É\8aY\93\96\82µ\82½\82Æ\82«\82É\96{\95\82É\82»\82Ì\83\8c\83X\82Ö\82Ì\83\8c\83X\83A\83\93\83J\81[\82ð\82Â\82¯\82é\82©\82Ç\82¤\82©
53                 FDeleteSyria: Boolean;  //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô\81i&#1792~&#1871\81j
54     procedure SetTokens(index: integer ; argline:String);
55     function Getlistpath() : String;
56     procedure Setlistpath(const Value : String);
57     function LoadListFile(path :String;listStringList : TStringList) : Boolean;
58     function ReadNGwordslist(line : Integer) : Boolean;
59     function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
60   public
61     { Public \90é\8c¾ }
62     constructor Create; // \83R\83\93\83X\83g\83\89\83N\83^
63     destructor Destroy; override; // \83f\83X\83g\83\89\83N\83^
64     property Deleterlo: Boolean read FDeleterlo write FDeleterlo  default false;
65     property Replaceul: Boolean read FReplaceul write FReplaceul  default false;
66     property Reverse: Boolean read FReverse write FReverse  default false;
67         property AbonString : String read FAbonString write FAbonString;
68     property  AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
69     property listpath : String read Getlistpath write Setlistpath;
70     property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
71     property NGwordname : String read FNGwordname write FNGwordname;
72         property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
73     property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
74     property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
75     procedure Setroot(root :String);
76     function Getroot() : String;
77
78     function Getfullpath(argpath : String) : String;
79     procedure SetNGwordpath(path :String);
80     function GetNGwordpath() : String;
81     function LoadFromNGwordFile(path :String) : Boolean;
82     function ReLoadFromNGwordFile() : Boolean;
83     procedure LoadFromStringList( bufstl : TStringList );
84     function CheckAbonPopupRes(line : String) :Boolean;
85         function FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1\83\89\83C\83\93\82¸\82Â\97p\81B
86         //\82 \82Ú\81`\82ñ\8f\88\97\9d(NG\83\8f\81[\83h\82Å\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O)
87         procedure Execute(var ThreadStrings : TStringList); overload;
88         procedure Execute(var ResString : String; ResNumber : Integer); overload;       //\8eå\82Éplugin\82©\82ç\82ÌDat To HTML \97p
89
90         //! \83X\83p\83\80\83t\83B\83\8b\83^\82Ì\8aw\8fK
91         procedure Learn( resList : TStringList );
92         //\8cÂ\95Ê\82 \82Ú\81`\82ñ\82µ\82å\82è
93         procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
94         procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
95         procedure AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
96         function CheckIndividualAbonList(ResNum : Integer) : Boolean;
97
98         procedure EditNGwords();  //NGword.txt\82ð\8aJ\82­\81B
99         function ShowAllTokens() : String;  //\83f\83o\83b\83O\97p
100         //--
101         procedure GoHome();//List\82Ì\82P\8ds\96Ú\82ð\93Ç\82Þ
102         function GoForward() : Boolean; //List\82Ì\88ê\82Â\8e\9f\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
103         function GoBack() : Boolean; //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
104         //--
105         function TreatSyria(AString: string): string;
106   end;
107 var
108         Abon1 :TAbon;
109 const
110         NGwordListFileName : String = 'NGwords.list';
111
112 implementation
113
114 uses MojuUtils, GikoSystem, GikoBayesian;
115
116 function InvidiAbonListSort( item1, item2 : Pointer ) : Integer;
117 begin
118
119         Result := TIndiviAbon( item1 ).Res - TIndiviAbon( item2 ).Res;
120
121 end;
122
123 destructor TIndiviAbonList.Destroy;
124 var
125         i : Integer;
126 begin
127
128         for i := 0 to Count - 1 do
129                 if inherited Items[ i ] <> nil then
130                         TObject( inherited Items[ i ] ).Free;
131
132         inherited;
133
134 end;
135
136 function TIndiviAbonList.GetItem( index : Integer ) : TIndiviAbon;
137 begin
138
139         Result := TIndiviAbon( inherited Items[ index ] );
140
141 end;
142
143 procedure TIndiviAbonList.SetItem( index : Integer; value : TIndiviAbon );
144 begin
145
146         inherited Items[ index ] := Pointer( value );
147
148 end;
149
150 procedure TIndiviAbonList.Sort;
151 begin
152
153         inherited Sort( InvidiAbonListSort );
154
155 end;
156
157 procedure TIndiviAbonList.LoadFromFile( const filePath : string );
158 var
159         bufStringList   : TStringList;
160         bufLine                         : string;
161         i                                                       : Integer;
162         item                                    : TIndiviAbon;
163 begin
164
165         if not FileExists( filePath ) then begin
166                 FLearned := 0;
167                 Exit;
168         end;
169
170         FFilePath := filePath;
171         bufStringList := TStringList.Create;
172         try
173                 bufStringList.LoadFromFile( filePath );
174                 if bufStringList.Values[ 'Learned' ] <> '' then begin
175                         FLearned := StrToInt( bufStringList.Values[ 'Learned' ] );
176                         bufStringList.Delete( bufStringList.IndexOfName( 'Learned' ) );
177                 end else begin
178                         FLearned := 0;
179                 end;
180
181                 //\8bó\8ds\8dí\8f\9c
182                 for i := bufStringList.Count-1 downto 0 do begin
183                         if bufStringList.Strings[i] = '' then begin
184                                 bufStringList.Delete(i);
185                         end;
186                 end;
187
188                 //\91ã\93ü
189                 for i := 0 to bufStringList.Count - 1 do begin
190                         bufLine                 := Trim(bufStringList.Strings[i]);
191                         item                            := TIndiviAbon.Create;
192                         item.Res                := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
193                         item.option     := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
194                         Add( item );
195                 end;
196         finally
197                 bufStringList.Free;
198         end;
199
200 end;
201
202 procedure TIndiviAbonList.Save;
203 var
204         bufStringList   : TStringList;
205         i                                                       : Integer;
206 begin
207
208         bufStringList := TStringList.Create;
209         try
210                 bufStringList.Values[ 'Learned' ] := IntToStr( FLearned );
211
212                 for i := 0 to Count - 1 do begin
213                         bufStringList.Add(
214                                 IntToStr( Items[ i ].Res ) + '-' + IntToStr( Items[ i ].Option ) );
215                 end;
216
217                 bufStringList.SaveToFile( FFilePath );
218         finally
219                 bufStringList.Free;
220         end;
221
222 end;
223
224 constructor TAbon.Create;
225 begin
226         // \8f\89\8aú\89»
227         FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
228         FAbonRes := TIndiviAbonList.Create;
229
230 end;
231
232 destructor TAbon.Destroy;
233 begin
234         FAbonRes.Free;
235         inherited;
236 end;
237 //root\82ÍExe\config\NGwords\83t\83H\83\8b\83_
238 procedure TAbon.Setroot(root :String);
239 var
240         bufStringList : TStringList;
241 begin
242         bufStringList := TStringList.Create;
243         try
244                 if not DirectoryExists(root) then begin
245                         CreateDir(root);
246                 end;
247                 if root[Length(root)] <> '\' then begin
248                         root := root + '\';
249                 end;
250                 Flistpath := root + NGwordListFileName;
251                 LoadListFile(Flistpath, bufStringList);
252         finally
253                 bufStringList.Free;
254         end;
255         Froot := root;
256 end;
257 function TAbon.Getroot() : String;
258 begin
259         Result := Froot;
260 end;
261 //NGwordpath\82ÍNGword.txt\82Ì\83t\83\8b\83p\83X
262 procedure TAbon.SetNGwordpath(path :String);
263 begin
264         FNGwordpath := Getfullpath(path);
265         LoadFromNGwordFile(FNGwordpath);
266 end;
267 function TAbon.GetNGwordpath() : String;
268 begin
269         Result :=  FNGwordpath;
270 end;
271 //\83t\83\8b\83p\83X\82Å\82È\82¯\82ê\82Î\83t\83\8b\83p\83X\82É\82µ\82Ä\95Ô\82·\81B
272 function TAbon.Getfullpath(argpath : String) : String;
273 begin
274         if AnsiPos(':\',argpath) <> 2 then begin  //\83h\83\89\83C\83u\82©\82ç\82Ì\83t\83\8b\83p\83X\82ª\96³\82¯\82ê\82Î
275                 if Getroot() = '' then begin
276                         Result := '';    //root\83p\83X\82ª\90Ý\92è\82³\82ê\82Ä\82È\82¢\82©\8bó\82É\82·\82é
277                 end else begin
278                         if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin  //\90æ\93ª\82Ì\\82ð\8dí\8f\9c
279                                 Delete(argpath,1,1);
280                         end;
281                         Insert( Getroot(), argpath , 1);//root\83p\83X\82ð\91}\93ü
282                         Result := argpath;
283                 end;
284         end else begin
285                 Result := argpath;
286         end;
287
288 end;
289 //NGword\83t\83@\83C\83\8b\82Ì\93Ç\82Ý\8d\9e\82Ý
290 function TAbon.LoadFromNGwordFile(path :String) : boolean;
291 var
292         bufstl : TStringList;
293 begin
294         path := Getfullpath(path);
295         if path = '' then begin
296                 Result := false;
297         end else begin
298
299                 bufstl := TStringList.Create;
300                 try
301                         if not FileExists(path) then begin
302                                 Result := false;
303                                 try
304                                         bufstl.SaveToFile(path);
305                                 except
306                                 end;
307                         end else begin
308                                 bufstl.LoadFromFile(path);
309                                 LoadFromStringList( bufstl );
310                                 Result := true;
311                         end;
312                 finally
313                         bufstl.Free;
314                 end;
315         end;
316
317 end;
318 //NGword\83\8a\83X\83g\93Ç\82Ý\8d\9e\82Ý
319 procedure TAbon.LoadFromStringList( bufstl : TStringList );
320 var
321         i : integer;
322 begin
323         try
324                 for i := bufstl.Count -1  downto 0 do begin
325                         if bufstl.Strings[i] = '' then begin
326                                 bufstl.Delete(i);
327                         end;
328                 end;
329                 SetLength(Ftokens,bufstl.Count);
330                 for i := 0  to bufstl.Count -1 do begin
331                         SetTokens(i , bufstl.Strings[i]);
332                 end;
333
334         except
335                 Exit;
336         end;
337 end;
338 //NGwordpath\82ª\8aù\82É\90Ý\92è\82³\82ê\82Ä\82¢\82é\82Æ\82«\82Ì\83\8a\83\8d\81[\83h\97p\8aÖ\90\94
339 function TAbon.ReLoadFromNGwordFile() : boolean;
340 begin
341         if GetNGwordpath() ='' then begin
342                 Result := false;
343         end else begin
344                 Result := LoadFromNGwordFile( GetNGwordpath() );
345         end;
346 end;
347 function TAbon.Getlistpath() : String;
348 begin
349         Result := Flistpath;
350 end;
351 procedure TAbon.Setlistpath(const Value : String);
352 begin
353         Flistpath := Getfullpath(Value);
354 end;
355 //\88ê\8ds\82Ì\92\86\82Ì\83g\81[\83N\83\93\82ð\90Ø\82è\95ª\82¯\82Ä\83Z\83b\83g
356 procedure TAbon.SetTokens(index: integer ; argline : String);
357 var
358         ret : Integer;
359         bufstl : TStringList;
360         i : Integer;
361         pos : Integer;
362         buftoken : String;
363 begin
364         pos := 0;
365         bufstl := TStringList.Create;
366         try
367                 if Length(argline) > 0 then begin
368                         pos := AnsiPos(#9,argline);
369                         while pos <> 0 DO begin
370                                 buftoken := Copy(argline,1,pos-1);
371                                 Delete(argline,1,pos);
372                                 if Length(buftoken) > 0 then begin
373                                         bufstl.Append(buftoken);
374                                 end else if ( bufstl.Count = 0 ) then begin
375                                         bufstl.Append('');
376                                 end;
377                                 pos := AnsiPos(#9,argline);
378                         end;
379                         if Length(argline) > 0 then begin
380                                 bufstl.Append(argline);
381                         end;
382                         ret := bufstl.Count;
383                         SetLength(Ftokens[index],ret);
384                         for i := 0 to bufstl.Count - 1  do begin
385                                 Ftokens[index][i] := bufstl.Strings[i];
386                         end;
387                 end;
388         finally
389                 bufstl.Free;
390         end;
391
392 end;
393 //Debug\97p\82¿\82á\82ñ\82ÆNG\83\8f\81[\83h\82ð\8fE\82¦\82Ä\82¢\82é\82©
394 function TAbon.ShowAllTokens() : String;
395 var
396         i : Integer;
397         j : Integer;
398         ret : String;
399 begin
400         for i := 0 to High(Ftokens) do begin
401                 for j := 0 to High(Ftokens[i]) do begin
402                         ret := ret + Ftokens[i][j];
403                 end;
404         end;
405         Result := ret;
406
407
408
409 end;
410 //NG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82½\82çtrue\82ð\95Ô\82µ\81A\82»\82ÌNG\83\8f\81[\83h\82Ì\8ds\90\94\82ðNGwordsLineNum\82É\93ü\82ê\82Ä\95Ô\82·\81B
411 //\82à\82µ\82à\93§\96¾\82 \82Ú\81`\82ñ\82É\82·\82é\82È\82çInbisible\82ðtrue\82É\82µ\82Ä\95Ô\82·
412 function TAbon.FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1\83\89\83C\83\93\82¸\82Â\97p\81B
413 var
414         lines : Integer;
415         cells : Integer;
416         hit : Boolean;
417         bufline : String;
418         start : Integer;
419 begin
420         hit := false;
421         if AnsiPos(FAbonString,line) <> 1 then begin
422                 for lines := 0 to High(Ftokens) do begin
423                         hit := true;
424                         bufline := line;
425                         if Ftokens[lines][0] <> ''  then begin
426                                 Invisible := false;
427                                 start := 0;
428                         end else begin
429                                 Invisible := true;
430                                 start := 1;
431                         end;
432
433                         for cells := start to High(Ftokens[lines]) do begin
434                                 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
435                                         hit := false;
436                                         break;
437                                 end else begin
438                                         Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
439                                 end;
440                         end;
441                         if hit = true then begin
442                                 NGwordsLineNum := lines + 1;
443                                 break;
444                         end;
445                 end;
446         end;
447         Result := hit;
448 end;
449 //\96\96\94ö\82Ì\83u\81[\83\8b\92l\82Ítrue\82¾\82Æ\81ANG\83\8f\81[\83h\82ð\8aÜ\82Þ\82à\82Ì\82¾\82¯\82ð\95Ô\82·\81B
450 procedure TAbon.Execute(var ThreadStrings : TStringList);
451 var
452         i : Integer;
453         NGwordsLine : Integer;
454         bufline : String;
455         invisi : Boolean;
456 begin
457         for i:=0 to ThreadStrings.Count - 1 do begin
458                 NGwordsLine := 0;
459                 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin
460                         if invisi = true then begin
461                                 ThreadStrings.Strings[i] := '';
462                         end else begin
463                                 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
464                                         ThreadStrings.Strings[i] := FAbonString;
465                                 end else if not ReturnNGwordLineNum then begin
466                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
467                                 end else if not SetNGResAnchor then begin
468                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
469                                 end else begin
470                                         ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
471                                 end;
472                         end;
473                 end else begin
474                         bufline := ThreadStrings.Strings[i];
475                         if Deleterlo = true then begin
476                                 bufline := CustomStringReplace(bufline,'&rlo;','');
477                                 bufline := CustomStringReplace(bufline,'&lro;','');
478                         end;
479                         if Replaceul = true then begin
480                                 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
481                                 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
482                         end;
483                         if DeleteSyria = true then
484                                 bufline := TreatSyria(bufline);
485                         ThreadStrings.Strings[i] := bufline;
486                 end;
487         end;
488 end;
489 procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
490 var
491         NGwordsLine : Integer;
492         bufline : String;
493         invisi : Boolean;
494 begin
495         NGwordsLine := 0;
496         if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse  then begin
497                 if invisi = true then begin
498                         ResString := '';
499                 end else begin
500                         if not ReturnNGwordLineNum and not SetNGResAnchor then begin
501                                 ResString := FAbonString;
502                         end else if not ReturnNGwordLineNum then begin
503                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
504                         end else if not SetNGResAnchor then begin
505                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
506                         end else begin
507                                 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
508                         end;
509                 end;
510         end else begin
511                 bufline := ResString;
512                 if Deleterlo = true then begin
513                         bufline := CustomStringReplace( bufline,'&rlo;','' );
514                         bufline := CustomStringReplace( bufline,'&lro;','' );
515                 end;
516                 if Replaceul = true then begin
517                         bufline := CustomStringReplace( bufline,'<ul>','<br>' );
518                         bufline := CustomStringReplace( bufline,'</ul>','<br>' );
519                 end;
520                 if DeleteSyria = true then
521                         bufline := TreatSyria(bufline);
522                 ResString := bufline;
523         end;
524 end;
525
526
527
528 //****************************************************************************//
529 //\8c»\8dÝ\83Z\83b\83g\82³\82ê\82Ä\82¢\82éNGword.txt\82ð\8aJ\82­
530 procedure TAbon.EditNGwords();
531 begin
532         ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
533 end;
534 //\83|\83b\83v\83A\83b\83v\97p\94»\92è\8aÖ\90\94
535 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
536 var
537         i: Integer;
538         v: boolean;
539 begin
540         if AbonPopupRes = true then begin
541                 Result := FindNGwords(line, i ,v);
542         end else begin
543                 Result := false;
544         end;
545 end;
546 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ==============================================
547 //List\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
548 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
549 begin
550     try
551         listStringList.LoadFromFile(path);
552         Result := true;
553     except
554         listStringList.Append('\88ê\94Ê=NGword.txt');
555         listStringList.SaveToFile(path);
556         Result := false;
557     end;
558 end;
559 //List\82Ì\88ê\82Â\8e\9f\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
560 function TAbon.GoForward() : Boolean;
561 begin
562     FNGwordFileIndex := FNGwordFileIndex + 1;
563     Result := ReadNGwordslist(FNGwordFileIndex);
564 end;
565 //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
566 function TAbon.GoBack() : Boolean;
567 begin
568     FNGwordFileIndex := FNGwordFileIndex -1;
569     Result := ReadNGwordslist(FNGwordFileIndex);
570 end;
571 //List\82Ì\82P\8ds\96Ú\82ð\93Ç\82Þ
572 procedure TAbon.GoHome();
573 begin
574     FNGwordFileIndex := 0;
575     ReadNGwordslist(FNGwordFileIndex);
576 end;
577 //List\82Ìline\8ds\96Ú\82ð\93Ç\82Þ
578 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
579 var
580     liststl : TStringList;
581     linebuf : String;
582 begin
583     liststl := TStringList.Create;
584     try
585         if LoadListFile(Flistpath,liststl) = true then begin
586             if line < 0 then begin
587                 line := liststl.Count - 1;
588                 FNGwordFileIndex := liststl.Count - 1;
589             end else if line > liststl.Count - 1 then begin
590                 line := 0;
591                 FNGwordFileIndex := 0;
592             end;
593             linebuf := liststl.Strings[line];
594             FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
595             Delete(linebuf,1,AnsiPos('=',linebuf));
596             SetNGwordpath(linebuf);
597             Result := true;
598         end else begin
599             Result := false;
600         end
601     finally
602         liststl.Free;
603     end;
604
605 end;
606
607 procedure TAbon.Learn( resList : TStringList );
608 var
609         i, j                            : Integer;
610         wordCount       : TWordCount;
611         spamminess      : Extended;
612         indiviAbon      : TIndiviAbon;
613 const
614         SPAM_THRESHOLD = 0.9;
615 begin
616
617         j := 0;
618         wordCount := TWordCount.Create;
619         try
620                 if (FAbonRes.FLearned = 0) and (FAbonRes.Count = 0) then begin
621                         // \8f\89\82ß\82Ä\82Ì\8aw\8fK\82©\82Â\8cÂ\95Ê\82 \82Ú\81`\82ñ\82 \82è\82È\82Ì\82Å\81A\8b\8cver\82©\82ç\82Ì\88Ú\8ds\82É\82Â\82«
622                         // \8cÂ\95Ê\82 \82Ú\81`\82ñ\82ð\8eg\82Á\82½\8aw\8fK
623                         FAbonRes.Sort;
624                         for i := 0 to FAbonRes.Count - 1 do begin
625                                 while (j < resList.Count) and (j + 1 < FAbonRes[ j ].Res) do begin
626                                         wordCount.Clear;
627                                         GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
628                                         GikoSys.Bayesian.Learn( wordCount, False );
629                                         Inc( j );
630                                 end;
631                                 if j < resList.Count then begin
632                                         wordCount.Clear;
633                                         GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
634                                         GikoSys.Bayesian.Learn( wordCount, True );
635                                         Inc( j );
636                                 end;
637                         end;
638
639                         while j < resList.Count do begin
640                                 wordCount.Clear;
641                                 GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
642                                 GikoSys.Bayesian.Learn( wordCount, False );
643                                 Inc( j );
644                         end;
645                 end else begin
646                         // \8b\8cver\82©\82ç\82Ì\88Ú\8ds\82Å\82Í\82È\82¢\82Ì\82Å\83\8c\83X\82ð\91S\82Ä\90\84\98_\82Å\8aw\8fK
647                         // \81¦\90\84\98_\82ª\8aÔ\88á\82Á\82Ä\82¢\82é\8fê\8d\87\82Í\83\86\81[\83U\82ª\82 \82Ú\81`\82ñ\82ð\8fC\90³\82·\82é\8e\96\82Å\8aw\8fK\82³\82ê\82é
648                         for j := FAbonRes.FLearned to resList.Count - 1 do begin
649                                 wordCount.Clear;
650                                 spamminess := GikoSys.Bayesian.Parse( resList[ j ], wordCount );
651                                 if spamminess >= SPAM_THRESHOLD then begin
652                                         // \83X\83p\83\80
653                                         GikoSys.Bayesian.Learn( wordCount, True );
654                                         indiviAbon := TIndiviAbon.Create;
655                                         indiviAbon.Res := j + 1;
656                                         indiviAbon.Option := 1;
657                                         FAbonRes.Add( indiviAbon );
658                                 end else begin
659                                         // \83n\83\80
660                                         GikoSys.Bayesian.Learn( wordCount, False );
661                                 end;
662                         end;
663                 end;
664
665                 FAbonRes.FLearned := resList.Count;
666                 FAbonRes.Save;
667         finally
668                 wordCount.Free;
669         end;
670
671         FAbonRes.Save;
672         GikoSys.Bayesian.Save;
673
674 end;
675
676 //\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ=====\82±\82±\82Ü\82Å=================================
677 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\8eÀ\8ds\8aÖ\90\94
678 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
679 var
680         i : Integer;
681         f : Boolean;
682 begin
683         f := FileExists( SetResNumFile );
684         if f then
685                 f := LoadFromSetResNumFile( SetResNumFile );
686         FAbonRes.FFilePath := SetResNumFile;    // Learn \82Í\82Å\95Û\91\82·\82é\82Ì\82Å
687         Learn( ThreadStrings );
688
689         if FileExists(SetResNumFile) = true then begin
690                 if f then begin
691                         for i := 0 to FAbonRes.Count - 1 do begin
692                                 if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
693                                         if FAbonRes[i].option = 0 then begin
694                                                 ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
695                                         end else begin
696                                                 ThreadStrings.Strings[FAbonRes[i].Res-1] := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
697                                         end;
698                                 end;
699                         end;
700                 end;
701         end else begin
702                 FIndividualFileName := SetResNumFile;
703                 FAbonRes.Free;
704                 FAbonRes := TIndiviAbonList.Create;
705         end;
706 end;
707 procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
708 var
709         i : Integer;
710 begin
711         if FileExists(SetResNumFile) = true then begin
712         if LoadFromSetResNumFile(SetResNumFile) = true then begin
713                                         for i := 0 to FAbonRes.Count - 1 do begin
714                  if FAbonRes[i].Res = ResNumber then begin
715                         if FAbonRes[i].option = 0 then begin
716                         ResString := '';
717                     end else begin
718                         ResString := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
719                     end;
720                     Exit;
721                  end;
722             end;
723         end;
724     end else begin
725                                 FIndividualFileName := SetResNumFile;
726                                 FAbonRes.Free;
727                                 FAbonRes := TIndiviAbonList.Create;
728                 end;
729 end;
730
731 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý\8aÖ\90\94
732 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
733 begin
734
735         FAbonRes.Free;
736         FAbonRes := TIndiviAbonList.Create;
737         FAbonRes.LoadFromFile( SetResNumFile );
738         Result := true;
739
740 end;
741 //\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\82É\92Ç\89Á
742 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
743 var
744         IndividualFile : TStringList;
745         i, j : Integer;
746 begin
747         IndividualFile := TStringList.Create;
748         try
749                 if FileExists(SetResNumFile) then begin
750                         IndividualFile.LoadFromFile(SetResNumFile);
751                         i := -1;
752                         for j := 0 to IndividualFile.Count -1 do begin
753                                 if AnsiPos(IntToStr(ResNum) + '-', IndividualFile[j]) = 1 then begin
754                                         i := j;
755                                         break;
756                                 end;
757                         end;
758                         if i = -1 then
759                                 IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option))
760                         else
761                                 IndividualFile[j] := IntToStr(ResNum) + '-' + IntToStr(option);
762
763                 end else begin
764                         IndividualFile.Add(IntToStr(ResNum) + '-' + IntToStr(option));
765                 end;
766                 IndividualFile.SaveToFile(SetResNumFile);
767         finally
768                 IndividualFile.Free;
769         end;
770 end;
771
772 //\83|\83b\83v\83A\83b\83v\82Ì\94»\92è\97p
773 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
774 var
775         i : Integer;
776 begin
777         if FAbonRes[0].Res <> 0 then begin
778                 for i := 0 to FAbonRes.Count - 1 do begin
779                         if FAbonRes[i].Res = ResNum then begin
780                                 Result := true;
781                                 Exit;
782                         end;
783                 end;
784         end;
785         Result := false;
786
787 end;
788 //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô
789 function TAbon.TreatSyria(AString: string): string;
790 var
791         //count: Integer; //(&#1792~&#1871)
792         pos: Integer;
793         tmp: string;
794 begin
795         pos := AnsiPos('&#18', AString);
796         while pos <> 0  do begin
797                 if StrToIntDef(Copy(AString, pos+4, 2), -1) > 0 then begin
798                         if (AString[pos+6] = ';' )  or (AString[pos+6] = ' ') then begin
799                                 tmp := tmp + Copy(AString, 1, pos - 1);
800                                 Delete(AString, 1, pos+6);
801                         end else if StrToIntDef(AString[pos+6], -1) = -1 then begin
802                                 tmp := tmp + Copy(AString, 1, pos - 1);
803                                 Delete(AString, 1, pos+5);
804                         end else begin
805                                 tmp := tmp + Copy(AString, 1, pos + 5);
806                                 Delete(AString, 1, pos+5);
807                         end;
808                 end else begin
809                         tmp := tmp + Copy(AString, 1, pos + 5);
810                         Delete(AString, 1, pos+5);
811                 end;
812                 pos := AnsiPos('&#18', AString);
813         end;
814         if Length(AString) > 0 then
815                 tmp := tmp + AString;
816         AString := tmp;
817         tmp := '';
818
819         pos := AnsiPos('&#179', AString);
820         while pos <> 0 do begin
821                 if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
822                         if (AString[pos+6] = ';') or (AString[pos+6] = ' ') then begin
823                                 tmp := tmp + Copy(AString, 1, pos - 1);
824                                 Delete(AString, 1, pos+6);
825                         end else if StrToIntDef(AString[pos+6], -1) = -1 then begin
826                                 tmp := tmp + Copy(AString, 1, pos - 1);
827                                 Delete(AString, 1, pos+5);
828                         end else begin
829                                 tmp := tmp + Copy(AString, 1, pos + 5);
830                                 Delete(AString, 1, pos+5);
831                         end;
832                 end else begin
833                         tmp := tmp + Copy(AString, 1, pos + 5);
834                         Delete(AString, 1, pos+5);
835                 end;
836                 pos := AnsiPos('&#179', AString);
837         end;
838         if Length(AString) > 0 then
839                 tmp := tmp + AString;
840         Result := tmp;
841 end;
842
843
844
845 end.
846