Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/AbonUnit.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.37 - (show annotations) (download) (as text)
Mon Jan 10 15:41:04 2005 UTC (19 years, 3 months ago) by yoffy
Branch: MAIN
CVS Tags: v1_50_0_581, v1_50_0_580, v1_50_0_587, v1_50_0_586, v1_50_0_572, v1_50_0_590, v1_50_0_585, v1_50_0_582, merged-remodeling, v1_50_0_577, v1_50_0_588, v1_50_0_574, v1_50_0_584, v_step1, v1_50_0_573, v1_50_0_571, v1_50_0_576, v1_50_0_578, v1_50_0_579, root-of-Bb50, root-of-remodel
Branch point for: remodeling, Bb50
Changes since 1.36: +11 -0 lines
File MIME type: text/x-pascal
- スパムフィルタを排除。SPAM_FILTER_ENABLED を定義する事で復帰可能。

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

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26