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.44 - (show annotations) (download) (as text)
Sun Feb 18 08:09:21 2007 UTC (17 years, 2 months ago) by h677
Branch: MAIN
CVS Tags: v1_56_0_715, v1_56_0_707, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, v1_56_2_724, v1_56_2_722, v1_55_1_697, v1_56_0_714, v1_56_0_712, v1_56_0_713, v1_56_0_721, marged_bRESPOPUP, v1_56_0_706, v1_56_0_709, v1_56_0_708, v1_56_0_699, v1_56_0_698
Branch point for: Bb56, Bb55, bRESPOPUP, bListSU
Changes since 1.43: +1 -0 lines
File MIME type: text/x-pascal
セキュリティソフトの誤反応対策機能を追加

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

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